Lim

 view release on metacpan or  search on metacpan

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

83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
 
=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

297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
 
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

341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
        $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

551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
 
=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

584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
    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

54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
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

147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
            }
 
            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

331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
    $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

404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
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) = @_;