source: trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Cli.pm @ 984

Last change on this file since 984 was 861, checked in by nanardon, 12 years ago
  • reimport missing files from previous svn
  • Property svn:keywords set to Id
File size: 28.4 KB
Line 
1package LATMOS::Accounts::Cli;
2
3# $Id$
4
5use strict;
6use warnings;
7use LATMOS::Accounts::Log;
8use LATMOS::Accounts::Utils;
9use Term::ReadLine;
10use Text::ParseWords;
11use Getopt::Long;
12
13{
14    open (my $fh, "/dev/tty" )
15        or eval 'sub Term::ReadLine::findConsole { ("&STDIN", "&STDERR") }';
16    die $@ if $@;
17    close ($fh);
18}
19
20my $term = Term::ReadLine->new('LA CLI');
21$term->MinLine(99999);
22my $OUT = $term->OUT || \*STDOUT;
23
24my $trans_mode = 0;
25
26sub globalenv {
27    my ($labase) = @_;
28    my $env = LATMOS::Accounts::Cli->new({ prompt => sub { $_[0]->base->label . " cli > " }, },
29        $labase);
30    $env->add_func('unexported', {
31        help => 'unexported yes|no|show - switch or show base mode regarding' .
32            ' unexported objects',
33        completion => sub {
34            if (!$_[2]) {
35                return qw(yes no show);
36            }
37        },
38        code => sub {
39            my ($env, $arg) = @_;
40            if ($arg eq 'yes') {
41                $env->base->unexported(1);
42                print $OUT "Unexported are now show\n";
43            } elsif ($arg eq 'no') {
44                $env->base->unexported(0);
45                print $OUT "Unexported are no longer show\n";
46            } elsif ($arg eq 'show') {
47                print $OUT "Unexported objects " . ($env->base->unexported ?
48                "enable" : "disable") . "\n";
49            } else {
50                print $OUT "wrong argument\n";
51            }
52        },
53    });
54    $env->add_func('ls', {
55            help => 'ls object_type - list object of type object_type', 
56            completion => sub {
57                if(!$_[2]) {
58                    return $_[0]->base->list_supported_objects
59                } else { () }
60            },
61            code => sub {
62                if ($_[1]) {
63                    print $OUT map { "$_\n" } $_[0]->base->list_objects($_[1]);
64                } else {
65                    print $OUT "Object type missing\n";
66                }
67            },
68        });
69    $env->add_func('search', {
70            help => 'search objecttype filter1 [filter2...] - search object according filter',
71            completion => sub {
72                if(!$_[2]) {
73                    return $_[0]->base->list_supported_objects
74                } else { return() }
75            },
76            code => sub {
77                my ($env, @args) = @_;
78                if ($_[1]) {
79                    my @res = $env->base->search_objects(@args);
80                    print $OUT map { "$_\n" } @res;
81                    $env->{_lastsearch} = \@res;
82                    $env->{_lastsearchtype} = $args[0];
83                } else {
84                    print $OUT "Object type missing\n";
85                }
86            },
87        });
88    $env->add_func('expired', {
89        help => 'expired [delay] - list expired account more than delay (default is now)',
90        code => sub {
91            my ($env, $expire) = @_;
92            my @users = $env->base->find_expired_users($expire);
93            print $OUT map { "$_\n" } @users;
94            $env->{_lastsearchtype} = 'user';
95            $env->{_lastsearch} = \@users;
96        },
97    }) if ($env->base->can('find_expired_users'));
98    $env->add_func('expires', {
99        help => 'expires [delay] - list account expiring before delay (default is 1 month)',
100        code => sub {
101            my ($env, $expire) = @_;
102            my @users = $env->base->find_next_expire_users($expire);
103            print $OUT map { "$_\n" } @users;
104            $env->{_lastsearchtype} = 'user';
105            $env->{_lastsearch} = \@users;
106        },
107    }) if ($env->base->can('find_next_expire_users'));
108    $env->add_func('select', {
109            help => 'select object_type - select objects to perform action on it',
110            completion => sub {
111                if ($_[2]) {
112                    return $_[0]->base->list_objects($_[2]);
113                } else {
114                    return '@', $_[0]->base->list_supported_objects;
115                }
116            },
117            code => sub {
118                my ($env, $otype, @ids) = @_;
119                my @objs;
120                if ($otype eq '@') {
121                    if (@{$env->{_lastsearch}}) {
122                        $otype = $env->{_lastsearchtype};
123                        @ids = @{$env->{_lastsearch}};
124                    } else {
125                        print $OUT "No results store from previous search\n";
126                        return;
127                    }
128                }
129                if (!@ids) {
130                    print $OUT 'not enough arguments' . "\n";
131                    return;
132                }
133                foreach (@ids) {
134                    my $obj = $env->base->get_object($otype, $_) or do {
135                        print $OUT "Cannot get $otype $_\n";
136                        return;
137                    };
138                    push(@objs, $obj);
139                }
140                print $OUT "Selecting $otype " . join(', ', @ids) . "\n";
141                objenv($_[0]->base, $otype, @objs)->cli();
142            },
143        });
144    $env->add_func('create', {
145            code => sub {
146                my ($env, $otype) = @_;
147                my $helper = $env->base->ochelper($otype);
148                my $info = undef;
149                while (1) {
150                    my $status;
151                    ($status, $info) = $helper->step($info);
152
153                    if ($status ne 'NEEDINFO') {
154                        if ($status eq 'CREATED') {
155                            print $OUT "Object created\n";
156                            $env->commit;
157                        } else {
158                            print $OUT "Nothing done\n";
159                            $env->rollback;
160                        }
161                        return;
162                    }
163
164                    if ($info->{name}{ask}) {
165                        my $line = $term->readline("Name of the object ?");
166                        $info->{name}{content} = $line;
167                    }
168                    foreach my $attr (@{$info->{ask} || []}) {
169                        $term->Attribs->{completion_function} = sub {
170                            $info->{contents}{$attr}
171                        };
172                        my $line = $term->readline(sprintf('  %s %s? ',
173                                $attr,
174                                $info->{contents}{$attr}
175                                ? '(' . $info->{contents}{$attr} . ') '
176                                : ''
177                            ));
178                        $info->{contents}{$attr} = $line if($line);
179                    }
180                }
181            },
182        }
183    );
184    $env->add_func('exchangeip', 
185        {
186            help => 'Exchange two IP on host',
187            code => sub {
188                my ($env, @args) = @_;
189                my ($ip1, $ip2) =
190                    grep { $_ && $_ =~ /\d+\.\d+\.\d+\.\d+/ } @args;
191                if (!$ip2) {
192                    print $OUT "Need two ip to exchange\n";
193                    return;
194                }
195                if ($env->base->nethost_exchange_ip($ip1, $ip2)) {
196                    print $OUT "$ip1 and $ip2 get exchange\n";
197                    $env->commit;
198                } else {
199                    $env->rollback;
200                }   
201            },
202            completion => sub {
203                my ($env, $carg, @args) = @_;
204                if ($args[-1] && $args[-1] !~ m/\d+\.\d+\.\d+\.\d+/) {
205                    if (my $obj = $env->base->get_object('nethost', $args[-1])) {
206                        return $obj->get_attributes('ip');
207                    }
208                } else {
209                    my @list = 
210                    ($env->base->attributes_summary('nethost', 'ip'),
211                        $env->base->list_objects('nethost'));
212                    return @list;
213                }
214            },
215        }
216    );
217    $env->add_func('user',  { alias => [qw'select user' ] });
218    $env->add_func('group', { alias => [qw'select group'] });
219    return $env
220}
221
222sub objenv {
223    my ($labase, $otype, @objs) = @_;
224    my $objenv = LATMOS::Accounts::Cli->new(
225        {
226            prompt => sub {
227                sprintf("%s %s/%s > ",
228                    $_[0]->base->label,
229                    $_[0]->{_otype},
230                    @{$_[0]->{_objects}} > 1 ? '(' .
231                    scalar(@{$_[0]->{_objects}}) . ' obj.)' : $_[0]->{_objects}[0]->id,
232                );
233            },
234        },
235        $labase
236    );
237    $objenv->{_otype} = $otype;
238    $objenv->{_objects} = [ @objs ];
239    $objenv->add_func('+', {
240        help => 'add item to selection',
241        code => sub {
242            my ($env, @ids) = @_;
243            my %ids = map { $_->id => 1 } @{$env->{_objects}};
244            foreach (@ids) {
245                $ids{$_} and next;
246                my $o = $env->base->get_object($env->{_otype}, $_) or next;
247                push(@{$env->{_objects}}, $o);
248            }
249            printf $OUT "select is now %s: %s\n", $env->{_otype}, join(', ', map {
250                $_->id } @{$env->{_objects}});
251        },
252        completion => sub {
253            my ($env, undef, @ids) = @_;
254            my %ids = map { $_->id => 1 } @{$env->{_objects}};
255            return ( grep { ! $ids{$_} } $env->base->list_objects($env->{_otype}));
256        },
257        }
258    );
259    $objenv->add_func('-', {
260        help => 'add item to selection',
261        code => sub {
262            my ($env, @ids) = @_;
263            my %ids = map { $_ => 1 } @ids;
264            my @newobjs = grep { !$ids{$_->id} } @{$env->{_objects}};
265
266            if (!@newobjs) {
267                print $OUT "This would remove all objects from the list...\n";
268                return;
269            } else {
270                @{$env->{_objects}} = @newobjs;
271            }
272            printf $OUT "select is now %s: %s\n", $env->{_otype}, join(', ', map {
273                $_->id } @{$env->{_objects}});
274        },
275        completion => sub {
276            my ($env, undef, @ids) = @_;
277            my %ids = map { $_ => 1 } @ids;
278            grep { !$ids{$_} } map { $_->id } @{$env->{_objects}};
279        },
280        }
281    );
282    $objenv->add_func('show', {
283        help => 'show attributes - show an attributes of object',
284        code => sub {
285            my ($env, $attr) = @_;
286            if (!$attr) {
287                foreach (@{$env->{_objects}}) {
288                    print $OUT $_->dump;
289                }
290            } else {
291                foreach my $u (@{$env->{_objects}}) {
292                    print $OUT sort map { $u->id . ': ' .($_ || '') . "\n" } $u->get_attributes($attr);
293                }
294            }
295        },
296        completion => sub {
297            if (!$_[2]) {
298                return $_[0]->base->list_canonical_fields($_[0]->{_otype}, 'r')
299            }
300        },
301    });
302    $objenv->add_func('print', {
303        help => 'print fmt - show attributes using template',
304        code => sub {
305            my ($env, $fmt) = @_;
306            if (!defined($fmt)) {
307                print $OUT "no format given";
308                return;
309            }
310            foreach (@{$env->{_objects}}) {
311                print $OUT $_->queryformat($fmt) . "\n";
312            }
313        },
314    });
315    $objenv->add_func('unset', {
316        help => 'unset attribute - unset specified attribute',
317        code => sub {
318            my ($env, $attr) = @_;
319            $attr or do {
320                print $OUT "Attributes must be specified";
321                return;
322            };
323            foreach (@{$env->{_objects}}) {
324                defined $_->set_c_fields($attr => undef) or do {
325                    print $OUT "cannot unset attributes $attr for " . $_->id .
326                    "\n";
327                    return;
328                };
329            }
330            $env->commit;
331            print $OUT "Changes applied\n";
332        },
333        completion => sub {
334            my ($env, $lastw, @args) = @_;
335            if (!$args[0]) {
336                return $env->base->list_canonical_fields($env->{_otype}, 'w')
337            }
338        },
339    });
340    $objenv->add_func('set', {
341        help => 'set attribute value - set an attributes to single value "value"',
342        code => sub {
343            my ($env, $attr, @value) = @_;
344            @value or do {
345                print $OUT "attribute and value must be specified\n";
346                return;
347            };
348            foreach (@{$env->{_objects}}) {
349                defined $_->set_c_fields($attr => @value <= 1 ? $value[0] :
350                    \@value) or do {
351                    $_->base->rollback;
352                    printf $OUT "Cannot set $attr to %s for %s\n", join(', ',
353                        @value), $_->id;
354                    return;
355                };
356            }
357            $env->commit;
358            print $OUT "Done.\n";
359        },
360        completion => sub {
361            my ($env, $lastw, @args) = @_;
362            if (!$args[0]) {
363                return $env->base->list_canonical_fields($env->{_otype}, 'w')
364            } else {
365                my $attr = $env->base->attribute($env->{_otype}, $args[0]);
366                if ($attr->has_values_list) {
367                    $attr->can_values;
368                } elsif (@{$env->{_objects}} == 1) {
369                    return
370                    $env->{_objects}[0]->get_attributes($args[0]);
371                }
372            }
373        },
374    });
375    $objenv->add_func('add', {
376        help => 'add a value to an attribute',
377        code => sub {
378            my ($env, $attr, @value) = @_;
379            @value or do {
380                print $OUT "attribute and value must be specified\n";
381                return;
382            };
383            foreach (@{$env->{_objects}}) {
384                my @attrv = grep { $_ } $_->get_attributes($attr);
385                defined $_->set_c_fields($attr => [ @attrv, @value ]) or do {
386                    $_->rollback;
387                    printf $OUT "Cannot set $attr to %s for %s\n", join(', ',
388                        @value), $_->id;
389                    return;
390                };
391            }
392            $env->commit;
393            print $OUT "done\n";
394        },
395        completion => sub {
396            my ($env, $lastw, @args) = @_;
397            if (!$args[0]) {
398                return grep {
399                    $env->base->attribute($env->{_otype}, $_)->{multiple}
400                } $env->base->list_canonical_fields($env->{_otype}, 'w')
401            } else {
402                my $attr = $env->base->attribute($env->{_otype}, $args[0]);
403                if ($attr->has_values_list) {
404                    $attr->can_values;
405                } elsif (@{$env->{_objects}} == 1) {
406                    return
407                    $env->{_objects}[0]->get_attributes($args[0]);
408                }
409            }
410        },
411    });
412    $objenv->add_func('remove', {
413        help => 'remove a value from an attribute',
414        code => sub {
415            my ($env, $attr, @value) = @_;
416            @value or do {
417                print $OUT "attribute and value must be specified\n";
418                return;
419            };
420            foreach (@{$env->{_objects}}) {
421                my @attrv = grep { $_ } $_->get_attributes($attr);
422                foreach my $r (@value) {
423                    @attrv = grep { $_ ne $r } @attrv;
424                }
425                defined $_->set_c_fields($attr => @attrv ? [ @attrv ] : undef) or do {
426                    $_->rollback;
427                    printf $OUT "Cannot set $attr to %s for %s\n", join(', ',
428                        @value), $_->id;
429                    return;
430                };
431            }
432            $env->commit;
433            print $OUT "done\n";
434        },
435        completion => sub {
436            my ($env, $lastw, @args) = @_;
437            if (!$args[0]) {
438                return grep {
439                    $env->base->attribute($env->{_otype}, $_)->{multiple}
440                } $env->base->list_canonical_fields($env->{_otype}, 'w')
441            } else {
442                my $attr = $env->base->attribute($env->{_otype}, $args[0]);
443                if (@{$env->{_objects}} == 1) {
444                    return
445                    $env->{_objects}[0]->get_attributes($args[0]);
446                }
447            }
448        },
449    });
450    $objenv->add_func('list', {
451        help => 'list current selected objects',
452        code => sub {
453            printf $OUT "%s: %s\n", $_[0]->{_otype}, join(', ', map { $_->id }
454            @{$_[0]->{_objects}});
455        }
456    });
457    $objenv->add_func('edit', {
458            help => 'edit [object] - edit selected object using vi',
459            completion => sub {
460                return map { $_->id } @{$_[0]->{_objects}}
461            },
462            code => sub {
463                my ($env, $id) = @_;
464                my $obj;
465                if ($id) {
466                    $obj = grep { $_->id = $id } @{$env->{_objects}} or do {
467                        print $OUT "$id is not part of selected objects\n";
468                        return;
469                    };
470                } elsif (@{$env->{_objects}} == 1) {
471                    $obj = $env->{_objects}[0]
472                } else {
473                    print $OUT "multiple objects selected but can edit only one,"
474                    . "please specify which one\n";
475                    return;
476                }
477                my $res = LATMOS::Accounts::Utils::dump_read_temp_file(
478                    sub {
479                        my ($fh) = @_;
480                        $obj->text_dump($fh,
481                            {
482                                empty_attr => 1,
483                                only_rw => 1,
484                            }
485                        );
486                    },
487                    sub {
488                        my ($fh) = @_;
489                        my %attr = LATMOS::Accounts::Utils::parse_obj_file($fh);
490                        my $res = $obj->set_c_fields(%attr);
491                        if ($res) {
492                            print $OUT "Changes applied\n";
493                            $env->commit;
494                        }
495                        else { print $OUT "Error applying changes\n" }
496                        return $res ? 1 : 0;
497                    }
498                );
499            },
500        });
501    $objenv->add_func('delete', {
502        help => 'delete - delete selected object',
503        code => sub {
504            my ($env) = @_;
505            printf $OUT "%s: %s\ndelete selected objects ? (yes/NO)\n",
506            $env->{_otype}, join(', ', map { $_->id } @{$env->{_objects}});
507            my $reply = <STDIN> || ''; chomp($reply);
508            if ($reply eq 'yes') {
509                foreach (@{$env->{_objects}}) {
510                    $env->base->delete_object($env->{_otype}, $_->id) or do {
511                        print $OUT "Cannot delete " . $_->id . "\n";
512                        return;
513                    };
514                }
515                $env->commit;
516                return "EXIT";
517            } else {
518                print $OUT "cancel !\n"
519            }
520        },
521    });
522    if (grep { $objenv->base->attribute($otype, $_)->reference }
523        $objenv->base->list_canonical_fields($otype, 'r')) {
524        $objenv->add_func('select', {
525            help => 'select attribute [object]',
526            code => sub {
527                my ($env, $attrname, @objects) = @_;
528                my $totype = $env->base->attribute($env->{_otype},
529                    $attrname)->reference or return;
530
531                if (! @objects) {
532                    @objects = grep { $_ } 
533                      map { $_->get_attributes($attrname) } @{$env->{_objects}};
534                }
535                {
536                    my %uniq = map { $_ => 1 } @objects;
537                    @objects = keys %uniq;
538                }
539                my @objs = (grep { $_ } map { $env->base->get_object($totype, $_) }
540                        @objects);
541                return if (!@objs);
542                print $OUT "Selecting $otype " . join(', ', map { $_->id } @objs) . "\n";
543                objenv($_[0]->base, $totype, @objs)->cli();
544            },
545            completion => sub {
546                if ($_[2]) {
547                    my $totype = $_[0]->base->attribute($_[0]->{_otype},
548                        $_[2])->reference or return;
549                    return grep { $_ }
550                           map { $_->get_attributes($_[2]) }
551                           @{$_[0]->{_objects}};
552                } else {
553                    return grep { $_[0]->base->attribute($otype, $_)->reference }
554                    $_[0]->base->list_canonical_fields($otype, 'r');
555                }
556            },
557            }
558        );
559    }
560
561    if (lc($otype) eq 'user') {
562        $objenv->add_func('group', {
563            help => 'group add|remove|primary goupname',
564            code => sub {
565                my ($env, $action, @groups) = @_;
566                foreach my $obj (@{$env->{_objects}}) {
567                    if ($action eq 'primary') {
568                        my $gid = $groups[0];
569                        if ($gid !~ /^\d/) {
570                            my $gobj = $env->base->get_object('group', $gid) or
571                            do {
572                                print $OUT "Cannot find group $gid\n";
573                                return;
574                            };
575                            $gid = $gobj->get_attributes('gidNumber');
576                        }
577                        $obj->set_c_fields('gidNumber', $gid);
578                    } else {
579                        my %gr;
580                        foreach ($obj->get_attributes('memberOf')) {
581                            $gr{$_} = 1;
582                        }
583                        if ($action eq 'add') {
584                            $gr{$_} = 1 foreach(@groups);
585                        } elsif ($action eq 'remove') {
586                            delete($gr{$_}) foreach(@groups);
587                        } else {
588                            print $OUT 'invalid action' . "\n";
589                            return;
590                        }
591                        defined $obj->set_c_fields('memberOf' => [ keys %gr ]) or do {
592                            print $OUT "cannot set memberOf attributes for " .
593                            $obj->id . "\n";
594                            return;
595                        };
596                    }
597                }
598                $env->commit;
599            },
600            completion => sub {
601                if (!$_[2]) {
602                    return (qw(add remove primary));
603                } else {
604                    if ($_[2] eq 'remove') {
605                        my %uniq = map { $_ => 1 }
606                            grep { $_ }
607                            map { $_->get_attributes('memberOf') }
608                            @{$_[0]->{_objects}};
609                        return sort keys %uniq;
610                    } else {
611                        return $_[0]->base->search_objects('group');
612                    }
613                }
614            },
615        });
616    } elsif ($otype eq 'group') {
617        $objenv->add_func('member', {
618            help => 'member add|remove user',
619            code => sub {
620                my ($env, $action, @groups) = @_;
621                foreach my $obj (@{$env->{_objects}}) {
622                    my %gr;
623                    foreach ($obj->get_attributes('memberUID')) {
624                        $gr{$_} = 1;
625                    }
626                    if ($action eq 'add') {
627                        $gr{$_} = 1 foreach(@groups);
628                    } elsif ($action eq 'remove') {
629                        delete($gr{$_}) foreach(@groups);
630                    } else {
631                        print $OUT 'invalid action' . "\n";
632                        return;
633                    }
634                    defined $obj->set_c_fields('memberUID' => [ keys %gr ]) or do {
635                        print $OUT "cannot set memberUID attributes for " .
636                        $obj->id . "\n";
637                        return;
638                    };
639                }
640                $env->commit;
641            },
642            completion => sub {
643                if (!$_[2]) {
644                    return (qw(add remove));
645                } else {
646                    if ($_[2] eq 'remove') {
647                        my %uniq = map { $_ => 1 }
648                            grep { $_ }
649                            map { $_->get_attributes('member') }
650                            @{$_[0]->{_objects}};
651                        return sort keys %uniq;
652                    } else {
653                        return $_[0]->base->search_objects('user');
654                    }
655                }
656            },
657        });
658    }
659
660    return $objenv;
661}
662
663sub new {
664    my ($class, $env, $labase) = @_;
665    bless($env, $class);
666    $env->{_labase} = $labase;
667
668    if ($labase->is_transactionnal) {
669        $env->add_func(
670            'transaction', {
671                help => 'change transaction mode',
672                code => sub {
673                    $trans_mode = $_[1] eq 'on' ? 1 : 0;
674                },
675                completion => sub {
676                    $trans_mode == 0 ? 'on' : 'off';
677                },
678            }
679        );
680        $env->add_func(
681            'commit', {
682                help => 'commit pending change',
683                code => sub {
684                    $_[0]->_commit;
685                },
686            }
687        );
688        $env->add_func(
689            'rollback', {
690                help => 'commit pending change',
691                code => sub {
692                    $_[0]->_rollback;
693                },
694            }
695        );
696    }
697    $env->add_func('quit', { help => 'quit - exit the tool',
698            code => sub { print "\n"; exit(0) }, });
699    $env->add_func('exit', { help => "exit current mode",
700            code => sub { return "EXIT" }, });
701    $env->add_func('help', {
702        help => 'help [command] - print help about command',
703        completion => sub {
704            if (!$_[2]) { return sort keys %{ $_[0]->{funcs} || {}} }
705        },
706        code => sub {
707            my ($self, $name) = @_;
708            if (!$name) {
709                print $OUT join(', ', sort keys %{ $self->{funcs} || {}}) . "\n";
710            } elsif ($self->{funcs}{$name}{alias}) {
711                print $OUT "$name is an alias for " . join(' ',
712                    @{$self->{funcs}{$name}{alias}}) . "\n";
713            } elsif ($self->{funcs}{$name}{help}) {
714                print $OUT $self->{funcs}{$name}{help} . "\n";
715            } else {
716                print $OUT "No help availlable\n";
717            }
718        },
719    });
720
721    $env;
722}
723
724sub base { $_[0]->{_labase} }
725
726sub cli {
727    my ($self) = @_;
728    while (1) {
729        $term->Attribs->{completion_function} = sub {
730            $self->complete($_[0], shellwords(substr($_[1], 0, $_[2])));
731        };
732        defined (my $line = $term->readline($self->prompt)) or do {
733            print $OUT "\n";
734            return;
735        };
736        $term->addhistory($line);
737        my $res = $self->run(shellwords($line));
738        $self->rollback if (!$trans_mode);
739        if ($res && $res eq 'EXIT') { print $OUT "\n"; return }
740    }
741}
742
743sub prompt {
744    my ($self) = @_;
745    if (!$self->{prompt}) {
746        return "LA cli > ";
747    } else {
748        $self->{prompt}->($self);
749    }
750}
751
752sub add_func {
753    my ($self, $name, $param) = @_;
754    $self->{funcs}{$name} = $param;
755}
756
757sub getoption {
758    my ($self, $opt, @args) = @_;
759    local @ARGV = @args;
760    Getopt::Long::Configure("pass_through");
761    GetOptions(%{ $opt });
762
763    return @ARGV;
764}
765
766sub parse_arg {
767    my ($self, $name, @args) = @_;
768    return @args;
769}
770
771sub complete {
772    my ($self, $lastw, $name, @args) = @_;
773    if (!$name) {
774        return grep { /^\Q$lastw\E/ } sort
775            (keys %{ $self->{funcs} || {}});
776    } elsif ($self->{funcs}{$name}{alias}) {
777        $self->complete($lastw, @{$self->{funcs}{$name}{alias}}, @args);
778    } elsif ($self->{funcs}{$name}{completion}) {
779        my @pargs = $self->parse_arg($name, @args);
780        return map { my $t = $_; $t =~ s/\s/\\ /g; $t } grep { $_ && /^\Q$lastw\E/ } $self->{funcs}{$name}{completion}->($self, $lastw, @pargs);
781    } else {
782        return ();
783    }
784}
785
786sub run {
787    my ($self, $name, @args) = @_;
788    return if (!$name);
789    if (!exists($self->{funcs}{$name})) {
790        print $OUT "No command $name found\n";
791    } elsif ($self->{funcs}{$name}{alias}) {
792        $self->run(@{$self->{funcs}{$name}{alias}}, @args);
793    } elsif ($self->{funcs}{$name}{code}) {
794        my @pargs = $self->parse_arg($name, @args);
795        $self->{funcs}{$name}{code}->($self, @args);
796    } else {
797        print $OUT "No command $name found\n";
798    }
799}
800
801sub commit {
802    my ($self) = @_;
803    if ($trans_mode) {
804    } else {
805        $self->_commit;
806    }
807}
808
809sub _commit {
810    my ($self) = @_;
811    $self->base->commit;
812}
813
814sub rollback {
815    my ($self) = @_;
816    if ($trans_mode) {
817        print $OUT "All pending changes get rollback\n";
818    }
819    $self->_rollback;
820}
821
822sub _rollback {
823    my ($self) = @_;
824    $self->base->rollback;
825}
826
8271;
Note: See TracBrowser for help on using the repository browser.