Lim

 view release on metacpan or  search on metacpan

lib/Lim/CLI.pm  view on Meta::CPAN

=cut

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my %args = ( @_ );
    my $self = {
        logger => Log::Log4perl->get_logger($class),
        cli => {},
        busy => 0,
        no_completion => 0,
        prompt => 'lim> '
    };
    bless $self, $class;
    weaken($self->{logger});
    my $real_self = $self;
    weaken($self);

    unless (defined $args{on_quit}) {
        confess __PACKAGE__, ': Missing on_quit';

lib/Lim/CLI.pm  view on Meta::CPAN

Process a line of input, called from the input watcher
(L<AnyEvent::ReadLine::Gnu> or L<AnyEvent::Handle>).

=cut

sub process {
    my ($self, $line) = @_;
    my ($cmd, $args);

    if ($self->{busy}) {
        return;
    }

    if (defined $line) {
        ($cmd, $args) = split(/\s+/o, $line, 2);
        $cmd = lc($cmd);
    }
    else {
        $cmd = 'quit';
    }

lib/Lim/CLI.pm  view on Meta::CPAN

            $self->println('Available commands: ', join(' ', sort @cmds));
        }
        $self->prompt;
    }
    else {
        if ($cmd) {
            if (exists $self->{current}) {
                if ($self->{current}->{module}->Commands->{$cmd} and
                    $self->{current}->{obj}->can($cmd))
                {
                    $self->{busy} = 1;
                    $self->set_prompt('');
                    $self->{current}->{obj}->$cmd($args);
                }
                else {
                    $self->unknown_command($cmd);
                }
            }
            elsif (exists $self->{cli}->{$cmd}) {
                if ($args) {
                    my $current = $self->{cli}->{$cmd};
                    ($cmd, $args) = split(/\s+/o, $args, 2);
                    $cmd = lc($cmd);

                    if ($current->{module}->Commands->{$cmd} and
                        $current->{obj}->can($cmd))
                    {
                        $self->{busy} = 1;
                        $self->set_prompt('');
                        $current->{obj}->$cmd($args);
                    }
                    else {
                        $self->unknown_command($cmd);
                    }
                }
                else {
                    $self->{current} = $self->{cli}->{$cmd};
                    $self->set_prompt('lim'.$self->{current}->{obj}->Prompt.'> ');

lib/Lim/CLI.pm  view on Meta::CPAN

=item $cli->Successful

Called from L<Lim::Component::CLI> when a command was successful.

=cut

sub Successful {
    my ($self) = @_;

    $self->{busy} = 0;
    if (exists $self->{current}) {
        $self->set_prompt('lim'.$self->{current}->{obj}->Prompt.'> ');
    }
    else {
        $self->set_prompt('lim> ');
    }
    $self->prompt;
    return;
}

lib/Lim/CLI.pm  view on Meta::CPAN

    foreach (@_) {
        if (blessed $_ and $_->isa('Lim::Error')) {
            $self->print($_->toString);
        }
        else {
            $self->print($_);
        }
    }
    $self->println;

    $self->{busy} = 0;
    if (exists $self->{current}) {
        $self->set_prompt('lim'.$self->{current}->{obj}->Prompt.'> ');
    }
    else {
        $self->set_prompt('lim> ');
    }
    $self->prompt;
}

=item $cli->Editor($content)

lib/Lim/Util/DBI.pm  view on Meta::CPAN

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $dbi = shift;
    my $user = shift;
    my $password = shift;
    my %args = ( @_ );
    my $self = {
        logger => Log::Log4perl->get_logger($class),
        json => JSON::XS->new->utf8->convert_blessed,
        busy => 0
    };
    bless $self, $class;
    weaken($self->{logger});
    my $real_self = $self;
    weaken($self);

    unless (defined $dbi) {
        confess __PACKAGE__, ': Missing dbi connection string';
    }
    unless (defined $args{on_connect} and ref($args{on_connect}) eq 'CODE') {

lib/Lim/Util/DBI.pm  view on Meta::CPAN

                }

                if (defined $response and exists $self->{cb}) {
                    unless (ref($response) eq 'ARRAY') {
                        $@ = 'Invalid response';
                        Lim::DEBUG and $self->{logger}->debug($@);
                        $response = [];
                    }

                    my $cb = delete $self->{cb};
                    $self->{busy} = 0;
                    $cb->($self, @$response);
                }
            });
    }
    elsif (defined $pid) {
        #
        # Child process
        #

        $SIG{HUP} => 'IGNORE';

lib/Lim/Util/DBI.pm  view on Meta::CPAN

        $cb->();
        return;
    }

    unless (exists $self->{child}) {
        $@ = 'No connection to the DBI process';
        $cb->();
        return;
    }

    if ($self->{busy}) {
        $@ = 'DBH is busy, multiple command execution is not allowed';
        $cb->();
        return;
    }

    eval {
        $request = $self->{json}->encode(\@_);
    };
    if ($@) {
        $cb->();
        return;
    }

    $self->{busy} = 1;
    $self->{cb} = $cb;

    Lim::DEBUG and $self->{logger}->debug('Sending DBI request ', $method);

    my $len = syswrite $self->{child}, $request;
    unless (defined $len and $len > 0) {
        $@ = 'Connection broken';
        $self->kill;
        $cb->();
        return;

lib/Lim/Util/DBI.pm  view on Meta::CPAN

sub kill {
    my ($self) = @_;

    if (exists $self->{child}) {
        shutdown($self->{child}, 2);
        close(delete $self->{child});
    }

    delete $self->{child_watcher};
    delete $self->{request_watcher};
    $self->{busy} = 0;
    delete $self->{cb};
}

=item child_connect

=cut

sub child_connect {
    my ($self, $dbi, $user, $pass, $attr) = @_;