Rebrand Perl plugin to HexChat,
Add /pl and plugin_pref Add help messages
This commit is contained in:
33
plugins/perl/lib/HexChat/List/Network.pm
Normal file
33
plugins/perl/lib/HexChat/List/Network.pm
Normal file
@ -0,0 +1,33 @@
|
||||
package HexChat::List::Network;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Storable qw(dclone);
|
||||
my $last_modified;
|
||||
my @servers;
|
||||
|
||||
sub get {
|
||||
my $server_file = HexChat::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, HexChat::List::Network::Entry::parse( $record );
|
||||
}
|
||||
} else {
|
||||
warn "Unable to open '$server_file': $!";
|
||||
}
|
||||
}
|
||||
|
||||
my $clone = dclone( \@servers );
|
||||
return @$clone;
|
||||
}
|
||||
|
||||
1
|
80
plugins/perl/lib/HexChat/List/Network/AutoJoin.pm
Normal file
80
plugins/perl/lib/HexChat/List/Network/AutoJoin.pm
Normal file
@ -0,0 +1,80 @@
|
||||
package HexChat::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
|
106
plugins/perl/lib/HexChat/List/Network/Entry.pm
Normal file
106
plugins/perl/lib/HexChat/List/Network/Entry.pm
Normal file
@ -0,0 +1,106 @@
|
||||
package HexChat::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 => HexChat::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 } = HexChat::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
|
Reference in New Issue
Block a user