view release on metacpan or  search on metacpan

bin/bcvi  view on Meta::CPAN

sub load_plugins {
    my($class) = @_;

    my $dir = $class->conf_directory();
    foreach my $file (sort glob("$dir/*.pm")) {
        $class->load_plugin_file($file);
    }
}


sub load_plugin_file {
    my($class, $file) = @_;

    my @parts = File::Spec->splitdir($file);
    my $key = pop @parts;
    return if $plugin_loaded{$key};

    eval { require $file; };
    if($@) {
        die qq{Error loading plugin "$file"\n$@\n}
    }

    $plugin_loaded{$key} = $file;
}


sub hook_client_class {
    my($class) = @_;

    my($calling_class, $calling_file) = caller();
    my $client_class = $class->client_class();
    $class->map_class(client => $calling_class);

    no strict 'refs';
    unshift @{"${calling_class}::ISA"}, $client_class;
    push @plugins, { class => $calling_class, file => $calling_file };
    return 1;
}


sub hook_server_class {
    my($class) = @_;

    my($calling_class, $calling_file) = caller();
    my $server_class = $class->server_class();
    $class->map_class(server => $calling_class);

    no strict 'refs';
    unshift @{"${calling_class}::ISA"}, $server_class;
    push @plugins, { class => $calling_class, file => $calling_file };
    return 1;
}


sub process_command_line {
    my($class, @args) = @_;

    my $opt = $class->option_defaults();
    my @cfg = $class->getopt_config();

    local(@ARGV) = @args;
    Getopt::Long::GetOptions($opt, @cfg) or $class->die_synopsis();

    my $handler = $opt->{listener}
                ? $class->server_class
                : $class->client_class;

    $handler->new(_options => $opt)->dispatch(@ARGV);
}


sub option_defaults {
    return { };
}


sub getopt_config {
    my($class) = @_;

    my @spec;
    $class->each_option(sub {
        my($o) = @_;
        my $def = $o->{name};
        $def .= "|$o->{alias}" if defined $o->{alias};
        $def .= $o->{arg_spec} if defined $o->{arg_spec};
        push @spec, $def;
    });
    return @spec
}


sub die_synopsis {
    my($class, $message) = @_;

    warn "$message\n" if $message;
    $class->pod_class->synopsis();
    exit(1);
}


sub new {
    my $class = shift;

    return bless { @_ }, $class;
}


sub DEBUG {
    my $self = shift;

    return unless $self->opt('debug');
    warn "$_\n" foreach @_;
}


sub dispatch {
    my($self, @args) = @_;

    if(my $method = $self->dispatch_option) {
        $self->DEBUG("Dispatching to: $method");
        $self->$method(@args);