mirror of
https://github.com/fhem/fhem-mirror.git
synced 2024-06-17 05:40:11 +00:00
78186d98f5
git-svn-id: https://svn.fhem.de/fhem/trunk/fhem@19666 2b470e98-0d58-463d-a4d8-8e2adae1ed80
106 lines
2.7 KiB
Perl
106 lines
2.7 KiB
Perl
###############################################################################
|
|
#
|
|
# Developed with Kate
|
|
#
|
|
# Copyright: Norbert Truchsess
|
|
# All rights reserved
|
|
#
|
|
# Contributors:
|
|
# - Marko Oldenburg (CoolTux)
|
|
#
|
|
# This script is free software; you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 2 of the License,or
|
|
# any later version.
|
|
#
|
|
# The GNU General Public License can be found at
|
|
# http://www.gnu.org/copyleft/gpl.html.
|
|
# A copy is found in the textfile GPL.txt and important notices to the license
|
|
# from the author is found in LICENSE.txt distributed with these scripts.
|
|
#
|
|
# This script is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
#
|
|
# $Id$
|
|
#
|
|
###############################################################################
|
|
|
|
package GPUtils;
|
|
use Exporter qw( import );
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
our %EXPORT_TAGS = (all => [qw(GP_Define GP_Catch GP_ForallClients GP_Import GP_Export)]);
|
|
Exporter::export_ok_tags('all');
|
|
|
|
#add FHEM/lib to @INC if it's not allready included. Should rather be in fhem.pl than here though...
|
|
BEGIN {
|
|
if (!grep(/FHEM\/lib$/,@INC)) {
|
|
foreach my $inc (grep(/FHEM$/,@INC)) {
|
|
push @INC,$inc."/lib";
|
|
};
|
|
};
|
|
};
|
|
|
|
sub GP_Define($$) {
|
|
my ($hash, $def) = @_;
|
|
my @a = split("[ \t]+", $def);
|
|
my $module = $main::modules{$hash->{TYPE}};
|
|
return $module->{NumArgs}." arguments expected" if ((defined $module->{NumArgs}) and ($module->{NumArgs} ne scalar(@a)-2));
|
|
$hash->{STATE} = 'defined';
|
|
if ($main::init_done) {
|
|
eval { &{$module->{InitFn}}( $hash, [ @a[ 2 .. scalar(@a) - 1 ] ] ); };
|
|
return GP_Catch($@) if $@;
|
|
}
|
|
return undef;
|
|
}
|
|
|
|
sub GP_Catch($) {
|
|
my $exception = shift;
|
|
if ($exception) {
|
|
$exception =~ /^(.*)( at.*FHEM.*)$/;
|
|
return $1;
|
|
}
|
|
return undef;
|
|
}
|
|
|
|
sub GP_ForallClients($$@)
|
|
{
|
|
my ($hash,$fn,@args) = @_;
|
|
foreach my $d ( sort keys %main::defs ) {
|
|
if ( defined( $main::defs{$d} )
|
|
&& defined( $main::defs{$d}{IODev} )
|
|
&& $main::defs{$d}{IODev} == $hash ) {
|
|
&$fn($main::defs{$d},@args);
|
|
}
|
|
}
|
|
return undef;
|
|
}
|
|
|
|
sub GP_Import(@)
|
|
{
|
|
no strict qw/refs/; ## no critic
|
|
my $pkg = caller(0);
|
|
foreach (@_) {
|
|
*{$pkg.'::'.$_} = *{'main::'.$_};
|
|
}
|
|
}
|
|
|
|
sub GP_Export(@)
|
|
{
|
|
no strict qw/refs/; ## no critic
|
|
my $pkg = caller(0);
|
|
my $main = $pkg;
|
|
$main =~ s/^(?:.+::)?([^:]+)$/main::$1\_/g;
|
|
foreach (@_) {
|
|
*{ $main . $_ } = *{ $pkg . '::' . $_ };
|
|
}
|
|
}
|
|
|
|
1;
|
|
|