view release on metacpan or  search on metacpan

bin/pocoirc  view on Meta::CPAN

    # network-specific config options
    '6|ipv6'         => \$args{ipv6},
    'S|ssl'          => \$args{ssl},
    'C|class=s'      => \$args{class},
    's|server=s'     => \$args{server},
    'p|port=s'       => \$args{port},
    'P|password=s'   => \$args{password},
    'n|nick=s'       => \$args{nick},
    'u|username=s'   => \$args{username},
    'r|realname=s'   => \$args{ircname},
    'j|join=s@'      => \$args{chan_specs},
    'N|nspassword=s' => \$args{nspassword},
    'a|plugin=s@'    => \$args{plugin_specs},
    'A|arg=s@'       => \$args{args},

    'V|version'      => sub {
        require App::Pocoirc;
        no strict 'vars';
        my $version = defined $App::Pocoirc::VERSION
            ? $App::Pocoirc::VERSION
            : 'dev-git';
        print "Version $version\n";
        exit;
    },
);

if (!$success || @ARGV) {
    warn "Unrecognized arguments: @ARGV\n" if @ARGV;
    require Pod::Usage;
    Pod::Usage::pod2usage();
}

my $procname = 'pocoirc';
$0 = $procname;
if ($] < 5.013000 && $^O eq 'linux') {
    local $@;
    eval {
        require Sys::Prctl;
        Sys::Prctl::prctl_name($procname);
    };
}

my $config;
if (defined $args{cfg_file}) {
    if ($args{cfg_file} =~ /\.ya?ml$/i) {
        require YAML::XS;
        YAML::XS->import('LoadFile');

        eval { $config = LoadFile($args{cfg_file}) };

        if ($@) {
            chomp $@;
            die "Failed to read YAML data from $args{cfg_file}: $@\n"
        }
        if (ref $config ne 'HASH') {
            die "YAML data in $args{cfg_file} should be a hash\n";
        }
    }
    elsif ($args{cfg_file} =~ /\.json$/i) {
        require JSON::XS;
        JSON::XS->import('decode_json');

        open my $fh, '<', $args{cfg_file} or die "Can't open $args{cfg_file}: $!\n";
        my $json = do { local $/; <$fh> };

        eval { $config = decode_json($json) };
        if ($@) {
            chomp $@;
            die "Failed to read JSON data from $args{cfg_file}: $@\n"
        }
        if (ref $config ne 'HASH') {
            die "JSON data in $args{cfg_file} be a hash\n";
        }
    }
    else {
        die "Config file format not supported, it must be YAML or JSON\n";
    }
}
else {
    my @plugins;
    if ($args{plugin_specs} && @{ $args{plugin_specs} }) {
        require JSON::XS;
        JSON::XS->import('decode_json');

        for my $plugspec (@{ $args{plugin_specs} }) {
            my ($class, $json) = $plugspec =~ /^([:A-Za-z0-9]+)\s*(.+)?/;
            die "Missing plugin class for option --plugin\n" if !defined $class;

            my $plug_args;
            if (defined $json) {
                eval { $plug_args = decode_json($json) };
                if ($@) {
                    chomp $@;
                    die "Invalid JSON argument for plugin $class: $@\n"
                }
                if (ref $plug_args ne 'HASH') {
                    die "JSON argument for plugin $class should be a hash\n";
                }
            }

            push @plugins, [$class, $plug_args];
        }
    }

    # process -j options
    if ($args{chan_specs}) {
        my %chans;
        for my $chanspec (@{ $args{chan_specs} }) {
            my ($chan, $pass) = split /,/, $chanspec, 2;
            $chans{$chan} = $pass;
        }
        push @plugins, ['AutoJoin', { Channels => \%chans }];
    }

    # process -N option
    if (defined $args{nspassword}) {
        push @plugins, ['NickServID', { Password => $args{nspassword}} ],
    }

    # process -a options
    my %direct_args;
    if ($args{args}) {
        for my $arg (@{ $args{args} }) {
            my ($key, $val) = split /:/, $arg, 2;
            if (!defined $key || !defined $val) {
                die "Invalid argument to -a or --arg: $arg\n";
            }
            $direct_args{$key} = $val;
        }
    }

    $config = {
        (map { defined $args{$_} ? ($_ => $args{$_}) : () } qw(lib log_file pid_file)),
        networks => {
            default => {
                local_plugins => \@plugins,
                %direct_args,
                (map {
                    defined $args{$_} ? ($_ => $args{$_}) : ()
                } qw(class server port password nick username ircname ipv6 ssl)),
            }
        },
    };