summary refs log tree commit diff stats
path: root/plugins/perl/lib/Xchat
diff options
context:
space:
mode:
authorFarow <farow_spam@lavabit.com>2013-10-02 17:47:56 +0300
committerEustachy Kapusta <Eustachy.kapusta@gmail.com>2013-10-07 22:58:38 +0200
commit075cc61c942998b7fdfeabfde10490ef233f88cd (patch)
tree00d3c95ac10ab8b5d3ff325d977860545e9ad661 /plugins/perl/lib/Xchat
parentaafbb6374b903d0c8ec5364f4cb3f2065cc7d31e (diff)
Rebrand Perl plugin to HexChat,
Add /pl and plugin_pref

Add help messages
Diffstat (limited to 'plugins/perl/lib/Xchat')
-rw-r--r--plugins/perl/lib/Xchat/Embed.pm325
-rw-r--r--plugins/perl/lib/Xchat/List/Network.pm33
-rw-r--r--plugins/perl/lib/Xchat/List/Network/AutoJoin.pm80
-rw-r--r--plugins/perl/lib/Xchat/List/Network/Entry.pm106
4 files changed, 0 insertions, 544 deletions
diff --git a/plugins/perl/lib/Xchat/Embed.pm b/plugins/perl/lib/Xchat/Embed.pm
deleted file mode 100644
index 6993dc6e..00000000
--- a/plugins/perl/lib/Xchat/Embed.pm
+++ /dev/null
@@ -1,325 +0,0 @@
-package Xchat::Embed;
-use strict;
-use warnings;
-# 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} );
-		Xchat::printf(
-			qq{'%s' already loaded from '%s'.\n},
-			$filename, $pkg_info->{filename}
-		);
-		Xchat::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
-		# Xchat::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";
-			}
-			Xchat::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} =
-				Xchat::Internal::register(
-					"", "unknown", "", $file
-				);
-		}
-
-		if( $@ ) {
-			# something went wrong
-			$@ =~ s/\(eval \d+\)/$file/g;
-			Xchat::print( "Error loading '$file':\n$@\n" );
-			# make sure the script list doesn't contain false information
-			unload( $scripts{$package}{filename} );
-			return 1;
-		}
-	} else {
-		Xchat::print( "Error opening '$file': $!\n" );
-		return 2;
-	}
-
-	return 0;
-}
-
-sub _do_eval {
-	no strict;
-	no warnings;
-	eval $_[0];
-}
-
-sub unload {
-	my $file = shift @_;
-	my $package = file2pkg( $file );
-	my $pkg_info = pkg_info( $package );
-
-	if( $pkg_info ) {	
-		# take care of the shutdown callback
-		if( exists $pkg_info->{shutdown} ) {
-			# allow incorrectly written scripts to be unloaded
-			eval {
-				if( ref $pkg_info->{shutdown} eq 'CODE' ) {
-					$pkg_info->{shutdown}->();
-				} elsif ( $pkg_info->{shutdown} ) {
-					no strict 'refs';
-					&{$pkg_info->{shutdown}};
-				}
-			};
-		}
-
-		if( exists $pkg_info->{hooks} ) {
-			for my $hook ( @{$pkg_info->{hooks}} ) {
-				Xchat::unhook( $hook, $package );
-			}
-		}
-
-		if( exists $pkg_info->{gui_entry} ) {
-			plugingui_remove( $pkg_info->{gui_entry} );
-		}
-		
-		delete @owner_package{ @{$pkg_info->{inner_packages}} };
-		for my $inner_package ( @{$pkg_info->{inner_packages}} ) {
-			Symbol::delete_package( $inner_package );
-		}
-		Symbol::delete_package( $package );
-		delete $scripts{$package};
-		return Xchat::EAT_ALL;
-	} else {
-		Xchat::print( qq{"$file" is not loaded.\n} );
-		return Xchat::EAT_NONE;
-	}
-}
-
-sub unload_all {
-	for my $package ( keys %scripts ) {
-		unload( $scripts{$package}->{filename} );
-	}
-	
-	return Xchat::EAT_ALL;
-}
-
-sub reload {
-	my $file = shift @_;
-	my $package = file2pkg( $file );
-	my $pkg_info = pkg_info( $package );
-	my $fullpath = $file;
-	
-	if( $pkg_info ) {
-		$fullpath = $pkg_info->{filename};
-		unload( $file );
-	}
-	
-	load( $fullpath );
-	return Xchat::EAT_ALL;
-}
-
-sub reload_all {
-	my @dirs = Xchat::get_info( "configdir" );
-	push @dirs, File::Spec->catdir( $dirs[0], "plugins" );
-	for my $dir ( @dirs ) {
-		my $auto_load_glob = File::Spec->catfile( $dir, "*.pl" );
-		my @scripts = map { $_->{filename} }
-			sort { $a->{loaded_at} <=> $b->{loaded_at} } values %scripts;
-		push @scripts, File::Glob::bsd_glob( $auto_load_glob );
-
-		my %seen;
-		@scripts = grep { !$seen{ $_ }++ } @scripts;
-
-		unload_all();
-		for my $script ( @scripts ) {
-			if( !pkg_info( file2pkg( $script ) ) ) {
-				load( $script );
-			}
-		}
-	}
-}
-
-sub expand_homedir {
-	my $file = shift @_;
-
-	if ( $^O eq "MSWin32" ) {
-		$file =~ s/^~/$ENV{USERPROFILE}/;
-	} else {
-		$file =~ s{^~}{
-			(getpwuid($>))[7] ||  $ENV{HOME} || $ENV{LOGDIR}
-		}ex;
-	}
-	return $file;
-}
-
-sub file2pkg {
-	my $string = File::Basename::basename( shift @_ );
-	$string =~ s/\.pl$//i;
-	$string =~ s|([^A-Za-z0-9/])|'_'.unpack("H*",$1)|eg;
-	return "Xchat::Script::" . $string;
-}
-
-sub pkg_info {
-	my $package = shift @_;
-	return $scripts{$package};
-}
-
-sub find_external_pkg {
-	my $level = 1;
-
-	while( my @frame = caller( $level ) ) {
-		return @frame if $frame[0] !~ /(?:^IRC$|^Xchat)/;
-		$level++;
-	}
-	return;
-}
-
-sub find_pkg {
-	my $level = 1;
-
-	while( my ($package, $file, $line) = caller( $level ) ) {
-		return $package if $package =~ /^Xchat::Script::/;
-		$level++;
-	}
-
-	my $current_package = get_current_package();
-	if( defined $current_package ) {
-		return $current_package;
-	}
-
-	my @frame = find_external_pkg();
-	my $location;
-
-	if( $frame[0] or $frame[1] ) {
-		my $calling_package = $frame[0];
-		if( defined( my $owner = $owner_package{ $calling_package } ) ) {
-			return ($owner, $calling_package);
-		}
-
-		$location = $frame[1] ? $frame[1] : "package $frame[0]";
-		$location .= " line $frame[2]";
-	} else {
-		$location = "unknown location";
-	}
-
-	die "Unable to determine which script this hook belongs to. at $location\n";
-
-}
-
-# convert function names into code references
-sub fix_callback {
-	my ($package, $calling_package, $callback) = @_;
-	
-	unless( ref $callback ) {
-		unless( $callback =~ /::/ ) {
-			my $prefix = defined $calling_package ? $calling_package : $package;
-			$callback =~ s/^/${prefix}::/;
-		}
-
-		no strict 'subs';
-		$callback = \&{$callback};
-	}
-	
-	return $callback;
-}
-
-sub get_current_package {
-	return $current_package;
-}
-
-sub set_current_package {
-	my $old_package = $current_package;
-	$current_package = shift;
-
-	return $old_package;
-}
-
-1
diff --git a/plugins/perl/lib/Xchat/List/Network.pm b/plugins/perl/lib/Xchat/List/Network.pm
deleted file mode 100644
index 3a7e2ae6..00000000
--- a/plugins/perl/lib/Xchat/List/Network.pm
+++ /dev/null
@@ -1,33 +0,0 @@
-package Xchat::List::Network;
-use strict;
-use warnings;
-use Storable qw(dclone);
-my $last_modified;
-my @servers;
-
-sub get {
-	my $server_file = Xchat::get_info( "configdir" ) . "/servlist.conf";
-
-	# recreate the list only if the server list file has changed
-	if( -f $server_file && 
-			(!defined $last_modified || $last_modified != -M $server_file ) ) {
-		$last_modified = -M _;
-
-		@servers = ();
-		if( open my $fh, "<", $server_file ) {
-			local $/ = "\n\n";
-			while( my $record = <$fh> ) {
-				chomp $record;
-				next if $record =~ /^v=/; # skip the version line
-				push @servers, Xchat::List::Network::Entry::parse( $record );
-			}
-		} else {
-			warn "Unable to open '$server_file': $!";
-		}
-	}
-
-	my $clone = dclone( \@servers );
-	return @$clone;
-}
-
-1
diff --git a/plugins/perl/lib/Xchat/List/Network/AutoJoin.pm b/plugins/perl/lib/Xchat/List/Network/AutoJoin.pm
deleted file mode 100644
index 8b4e40d2..00000000
--- a/plugins/perl/lib/Xchat/List/Network/AutoJoin.pm
+++ /dev/null
@@ -1,80 +0,0 @@
-package Xchat::List::Network::AutoJoin;
-use strict;
-use warnings;
-
-use overload
-#	'%{}' => \&as_hash,
-#	'@{}' => \&as_array,
-	'""'   => 'as_string',
-	'0+'   => 'as_bool';
-
-sub new {
-	my $class = shift;
-
-	my @autojoins;
-
-	return bless \@autojoins, $class;
-}
-
-sub add {
-	my $self = shift;
-
-	my $line = shift;
-
-	my ( $channel, $key ) = split /,/, $line, 2;
-	$key = $key || '';
-
-	push @$self, {
-		channel => $channel,
-		key     => $key,
-		};
-}
-
-sub channels {
-	my $self = shift;
-
-	if( wantarray ) {
-		return map { $_->{channel} } @$self;
-	} else {
-		return scalar @$self;
-	}
-}
-
-sub keys {
-	my $self = shift;
-	return map { $_->{key} } @$self  ;
-
-}
-
-sub pairs {
-	my $self = shift;
-
-	my @channels = $self->channels;
-	my @keys = $self->keys;
-
-	my @pairs = map { $_ => shift @keys } @channels;
-}
-
-sub as_hash {
-	my $self = shift;
-	return +{ $self->pairs };
-}
-
-sub as_string {
-	my $self = shift;
-	return join " ",
-		join( ",", $self->channels ),
-		join( ",", $self->keys );
-}
-
-sub as_array {
-	my $self = shift;
-	return [ map { \%$_ } @$self ];
-}
-
-sub as_bool {
-	my $self = shift;
-	return $self->channels ? 1 : "";
-}
-
-1
diff --git a/plugins/perl/lib/Xchat/List/Network/Entry.pm b/plugins/perl/lib/Xchat/List/Network/Entry.pm
deleted file mode 100644
index 6f2aa925..00000000
--- a/plugins/perl/lib/Xchat/List/Network/Entry.pm
+++ /dev/null
@@ -1,106 +0,0 @@
-package Xchat::List::Network::Entry;
-use strict;
-use warnings;
-
-my %key_for = (
-	I => "irc_nick1",
-	i => "irc_nick2",
-	U => "irc_user_name",
-	R => "irc_real_name",
-	P => "server_password",
-	B => "nickserv_password",
-	N => "network",
-	D => "selected",
-	E => "encoding",
-);
-my $letter_key_re = join "|", keys %key_for;
-
-sub parse {
-	my $data  = shift;
-	my $entry = {
-		irc_nick1       => undef,
-		irc_nick2       => undef,
-		irc_user_name   => undef,
-		irc_real_name   => undef,
-		server_password => undef,
-
-		# the order of the channels need to be maintained
-		# list of { channel => .., key => ... }
-		autojoins         => Xchat::List::Network::AutoJoin->new( '' ),
-		connect_commands   => [],
-		flags             => {},
-		selected          => undef,
-		encoding          => undef,
-		servers           => [],
-		nickserv_password => undef,
-		network           => undef,
-	};
-
-	my @fields = split /\n/, $data;
-	chomp @fields;
-
-	$entry->{ autojoins } = Xchat::List::Network::AutoJoin->new();
-
-	for my $field ( @fields ) {
-	SWITCH: for ( $field ) {
-			/^($letter_key_re)=(.*)/ && do {
-				$entry->{ $key_for{ $1 } } = $2;
-				last SWITCH;
-			};
-
-			/^J.(.*)/ && do {
-				$entry->{ autojoins }->add( $1 );
-			};
-
-			/^F.(.*)/ && do {
-				$entry->{ flags } = parse_flags( $1 );
-			};
-
-			/^S.(.+)/ && do {
-				push @{$entry->{servers}}, parse_server( $1 );
-			};
-
-			/^C.(.+)/ && do {
-				push @{$entry->{connect_commands}}, $1;
-			};
-		}
-	}
-
-#	$entry->{ autojoins } = $entry->{ autojoin_channels };
-	return $entry;
-}
-
-sub parse_flags {
-	my $value = shift || 0;
-	my %flags;
-
-	$flags{ "cycle" }         = $value & 1  ? 1 : 0;
-	$flags{ "use_global" }    = $value & 2  ? 1 : 0;
-	$flags{ "use_ssl" }       = $value & 4  ? 1 : 0;
-	$flags{ "autoconnect" }   = $value & 8  ? 1 : 0;
-	$flags{ "use_proxy" }     = $value & 16 ? 1 : 0;
-	$flags{ "allow_invalid" } = $value & 32 ? 1 : 0;
-
-	return \%flags;
-}
-
-sub parse_server {
-	my $data = shift;
-	if( $data ) {
-		my ($host, $port) = split /\//, $data;
-		unless( $port ) {
-			my @parts = split /:/, $host;
-
-			# if more than 2 then we are probably dealing with a IPv6 address
-			# if less than 2 then no port was specified
-			if( @parts == 2 ) {
-				$port = $parts[1];
-			}
-		}
-
-		$port ||= 6667;
-		return { host => $host, port => $port };
-	}
-}
-
-1