package HexChat::Embed; use strict; use warnings; use Data::Dumper; # list of loaded scripts keyed by their package names # The package names are generated from the filename of the script using # the file2pkg() function. # The values of this hash are hash references with the following keys: # filename # The full path to the script. # gui_entry # This is hexchat_plugin pointer that is used to remove the script from # Plugins and Scripts window when a script is unloaded. This has also # been converted with the PTR2IV() macro. # hooks # This is an array of hooks that are associated with this script. # These are pointers that have been converted with the PTR2IV() macro. # inner_packages # Other packages that are defined in a script. This is not recommended # partly because these will also get removed when a script is unloaded. # loaded_at # A timestamp of when the script was loaded. The value is whatever # Time::HiRes::time() returns. This is used to retain load order when # using the RELOADALL command. # shutdown # This is either a code ref or undef. It will be executed just before a # script is unloaded. our %scripts; # This is a mapping of "inner package" => "containing script package" our %owner_package; # used to keep track of which package a hook belongs to, if the normal way of # checking which script is calling a hook function fails this will be used # instead. When a hook is created this will be copied to the HookData structure # and when a callback is invoked this it will be used to set this value. our $current_package; sub load { my $file = expand_homedir( shift @_ ); my $package = file2pkg( $file ); if( exists $scripts{$package} ) { my $pkg_info = pkg_info( $package ); my $filename = File::Basename::basename( $pkg_info->{filename} ); HexChat::printf( qq{'%s' already loaded from '%s'.\n}, $filename, $pkg_info->{filename} ); HexChat::print( 'If this is a different script then it rename and try '. 'loading it again.' ); return 2; } if( open my $source_handle, $file ) { my $source = do {local $/; <$source_handle>}; close $source_handle; # we shouldn't care about things after __END__ $source =~ s/^__END__.*//ms; # this must come before the eval or the filename will not be found in # HexChat::register $scripts{$package}{filename} = $file; $scripts{$package}{loaded_at} = Time::HiRes::time(); # this must be done before the error check so the unload will remove # any inner packages defined by the script. if a script fails to load # then any inner packages need to be removed as well. my @inner_packages = $source =~ m/^\s*package \s+ ((?:[^\W:]+(?:::)?)+)\s*? # package name # strict version number (?:\d+(?:[.]\d+) # positive integer or decimal-fraction |v\d+(?:[.]\d+){2,})? # dotted-decimal v-string [{;] /mgx; # check if any inner package defined in the to be loaded script has # already been defined by another script my @conflicts; for my $inner ( @inner_packages ) { if( exists $owner_package{ $inner } ) { push @conflicts, $inner; } } # report conflicts and bail out if( @conflicts ) { my $error_message = "'$file' won't be loaded due to conflicting inner packages:\n"; for my $conflict_package ( @conflicts ) { $error_message .= " $conflict_package already defined in " . pkg_info($owner_package{ $conflict_package })->{filename}."\n"; } HexChat::print( $error_message ); return 2; } my $full_path = File::Spec->rel2abs( $file ); $source =~ s/^/#line 1 "$full_path"\n\x7Bpackage $package;/; # make sure we add the closing } even if the last line is a comment if( $source =~ /^#.*\Z/m ) { $source =~ s/^(?=#.*\Z)/\x7D/m; } else { $source =~ s/\Z/\x7D/; } $scripts{$package}{inner_packages} = [ @inner_packages ]; @owner_package{ @inner_packages } = ($package) x @inner_packages; _do_eval( $source ); unless( exists $scripts{$package}{gui_entry} ) { $scripts{$package}{gui_entry} = HexChat::Internal::register( "", "unknown", "", $file );