Ignore:
Timestamp:
02/20/19 10:53:50 (5 years ago)
Author:
nanardon
Message:

Rework la-cli to ease functions adding

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Cli.pm

    r2205 r2209  
    55use strict; 
    66use warnings; 
     7use Moose; 
    78use LATMOS::Accounts::Log; 
    89use LATMOS::Accounts::Utils; 
    … …  
    1011use Text::ParseWords; 
    1112use Getopt::Long; 
     13use LATMOS::Accounts::Cli::Object; 
     14 
     15extends 'LATMOS::Accounts::Cli::Base'; 
    1216 
    1317=head1 NAME 
    … …  
    2125=cut 
    2226 
    23 { 
    24     open (my $fh, "/dev/tty" ) 
    25         or eval 'sub Term::ReadLine::findConsole { ("&STDIN", "&STDERR") }'; 
    26     die $@ if $@; 
    27     close ($fh); 
    28 } 
    29  
    30 our $term = Term::ReadLine->new('LA CLI'); 
    31 $term->MinLine(99999); 
    32 my $OUT = $term->OUT || \*STDOUT; 
    33  
    34 our $trans_mode = 0; 
    35 my $trans_start = 0; 
    36  
    3727=head1 FUNCTIONS 
    3828 
    … …  
    4535=cut 
    4636 
    47 sub globalenv { 
    48     my ($labase) = @_; 
    49     my $env = LATMOS::Accounts::Cli->new({ prompt => sub { $_[0]->base->label . " cli" }, }, 
    50         $labase); 
    51     $env->add_func('unexported', { 
     37sub BUILD { 
     38    my ( $self ) = @_; 
     39 
     40    my $labase = $self->base; 
     41    my $OUT = $self->Context->Out; 
     42 
     43    $self->add_func('unexported', { 
    5244        help => 'unexported yes|no|show - switch or show base mode regarding' . 
    5345            ' unexported objects', 
    … …  
    5850        }, 
    5951        code => sub { 
    60             my ($env, $arg) = @_; 
     52            my ($self, $arg) = @_; 
    6153            if ($arg eq 'yes') { 
    62                 $env->base->unexported(1); 
     54                $self->base->unexported(1); 
    6355                print $OUT "Unexported are now show\n"; 
    6456            } elsif ($arg eq 'no') { 
    65                 $env->base->unexported(0); 
     57                $self->base->unexported(0); 
    6658                print $OUT "Unexported are no longer show\n"; 
    6759            } elsif ($arg eq 'show') { 
    68                 print $OUT "Unexported objects " . ($env->base->unexported ? 
     60                print $OUT "Unexported objects " . ($self->base->unexported ? 
    6961                "enable" : "disable") . "\n"; 
    7062            } else { 
    … …  
    7365        }, 
    7466    }); 
    75     $env->add_func('ls', { 
     67    $self->add_func('ls', { 
    7668            help => 'ls object_type - list object of type object_type',  
    7769            completion => sub { 
    … …  
    8880            }, 
    8981        }); 
    90     $env->add_func('search', { 
     82    $self->add_func('search', { 
    9183            help => 'search objecttype filter1 [filter2...] - search object according filter', 
    9284            completion => sub { 
    … …  
    9688            }, 
    9789            code => sub { 
    98                 my ($env, @args) = @_; 
     90                my ($self, @args) = @_; 
    9991                if ($_[1]) { 
    100                     my @res = $env->base->search_objects(@args); 
     92                    my @res = $self->base->search_objects(@args); 
    10193                    print $OUT map { "$_\n" } @res; 
    102                     $env->{_lastsearch} = \@res; 
    103                     $env->{_lastsearchtype} = $args[0]; 
     94                    $self->{_lastsearch} = \@res; 
     95                    $self->{_lastsearchtype} = $args[0]; 
    10496                } else { 
    10597                    print $OUT "Object type missing\n"; 
    … …  
    10799            }, 
    108100        }); 
    109     $env->add_func('expired', { 
     101    $self->add_func('expired', { 
    110102        help => 'expired [delay] - list expired account more than delay (default is now)', 
    111103        code => sub { 
    112             my ($env, $expire) = @_; 
    113             my @users = $env->base->find_expired_users($expire); 
     104            my ($self, $expire) = @_; 
     105            my @users = $self->base->find_expired_users($expire); 
    114106            print $OUT map { "$_\n" } @users; 
    115             $env->{_lastsearchtype} = 'user'; 
    116             $env->{_lastsearch} = \@users; 
    117         }, 
    118     }) if ($env->base->can('find_expired_users')); 
    119     $env->add_func('expires', { 
     107            $self->{_lastsearchtype} = 'user'; 
     108            $self->{_lastsearch} = \@users; 
     109        }, 
     110    }) if ($self->base->can('find_expired_users')); 
     111    $self->add_func('expires', { 
    120112        help => 'expires [delay] - list account expiring before delay (default is 1 month)', 
    121113        code => sub { 
    122             my ($env, $expire) = @_; 
    123             my @users = $env->base->find_next_expire_users($expire); 
     114            my ($self, $expire) = @_; 
     115            my @users = $self->base->find_next_expire_users($expire); 
    124116            print $OUT map { "$_\n" } @users; 
    125             $env->{_lastsearchtype} = 'user'; 
    126             $env->{_lastsearch} = \@users; 
    127         }, 
    128     }) if ($env->base->can('find_next_expire_users')); 
    129     $env->add_func('select', { 
     117            $self->{_lastsearchtype} = 'user'; 
     118            $self->{_lastsearch} = \@users; 
     119        }, 
     120    }) if ($self->base->can('find_next_expire_users')); 
     121    $self->add_func('select', { 
    130122            help => 'select object_type - select objects to perform action on it', 
    131123            completion => sub { 
    … …  
    137129            }, 
    138130            code => sub { 
    139                 my ($env, $otype, @ids) = @_; 
     131                my ($self, $otype, @ids) = @_; 
    140132                my @objs; 
    141133                if ($otype eq '@') { 
    142                     if (@{$env->{_lastsearch} || []}) { 
    143                         $otype = $env->{_lastsearchtype}; 
    144                         @ids = @{$env->{_lastsearch}}; 
     134                    if (@{$self->{_lastsearch} || []}) { 
     135                        $otype = $self->{_lastsearchtype}; 
     136                        @ids = @{$self->{_lastsearch}}; 
    145137                    } else { 
    146138                        print $OUT "No results store from previous search\n"; 
    … …  
    153145                } 
    154146                foreach (@ids) { 
    155                     my $obj = $env->base->get_object($otype, $_) or do { 
     147                    my $obj = $self->base->get_object($otype, $_) or do { 
    156148                        print $OUT "Cannot get $otype $_\n"; 
    157149                        return; 
    … …  
    160152                } 
    161153                print $OUT "Selecting $otype " . join(', ', @ids) . "\n"; 
    162                 objenv($_[0]->base, $otype, @objs)->cli(); 
     154                LATMOS::Accounts::Cli::Object->new( 
     155                    Context => $self->Context, 
     156                    otype   => $otype, 
     157                    objs    => \@objs, 
     158                )->cli(); 
    163159            }, 
    164160        }); 
    165     $env->add_func('create', { 
    166             code => sub { 
    167                 my ($env, $otype) = @_; 
    168                 my $helper = $env->base->ochelper($otype); 
     161    $self->add_func('create', { 
     162            code => sub { 
     163                my ($self, $otype) = @_; 
     164                my $helper = $self->base->ochelper($otype); 
    169165                my $info = undef; 
    170166                while (1) { 
    … …  
    175171                        if ($status eq 'CREATED') { 
    176172                            print $OUT "Object created\n"; 
    177                             $env->commit; 
     173                            $self->commit; 
    178174                        } else { 
    179175                            print $OUT "Nothing done\n"; 
    180                             $env->rollback; 
     176                            $self->rollback; 
    181177                        } 
    182178                        return; 
    … …  
    184180 
    185181                    if ($info->{name}{ask}) { 
    186                         my $line = $term->readline("Name of the object ?"); 
     182                        my $line = $self->Context->Term->readline("Name of the object ?"); 
    187183                        $info->{name}{content} = $line; 
    188184                    } 
    189185                    foreach my $attr (@{$info->{ask} || []}) { 
    190                         $term->Attribs->{completion_function} = sub { 
     186                        $self->Context->Term->Attribs->{completion_function} = sub { 
    191187                            $info->{contents}{$attr} 
    192188                        }; 
    193                         my $line = $term->readline(sprintf('  %s %s? ', 
     189                        my $line = $self->Context->Term->readline(sprintf('  %s %s? ', 
    194190                                $attr, 
    195191                                $info->{contents}{$attr} 
    … …  
    203199        } 
    204200    ); 
    205     $env->add_func('exchangeip',  
     201    $self->add_func('exchangeip',  
    206202        { 
    207203            help => 'Exchange two IP on host', 
    208204            code => sub { 
    209                 my ($env, @args) = @_; 
     205                my ($self, @args) = @_; 
    210206                my ($ip1, $ip2) = 
    211207                    grep { $_ && $_ =~ /\d+\.\d+\.\d+\.\d+/ } @args; 
    … …  
    214210                    return; 
    215211                } 
    216                 if ($env->base->nethost_exchange_ip($ip1, $ip2)) { 
     212                if ($self->base->nethost_exchange_ip($ip1, $ip2)) { 
    217213                    print $OUT "$ip1 and $ip2 get exchange\n"; 
    218                     $env->commit; 
    219                 } else { 
    220                     $env->rollback; 
     214                    $self->commit; 
     215                } else { 
     216                    $self->rollback; 
    221217                }    
    222218            }, 
    223219            completion => sub { 
    224                 my ($env, $carg, @args) = @_; 
     220                my ($self, $carg, @args) = @_; 
    225221                if ($args[-1] && $args[-1] !~ m/\d+\.\d+\.\d+\.\d+/) { 
    226                     if (my $obj = $env->base->get_object('nethost', $args[-1])) { 
     222                    if (my $obj = $self->base->get_object('nethost', $args[-1])) { 
    227223                        return $obj->get_attributes('ip'); 
    228224                    } 
    229225                } else { 
    230226                    my @list =  
    231                     ($env->base->attributes_summary('nethost', 'ip'), 
    232                         $env->base->list_objects('nethost')); 
     227                    ($self->base->attributes_summary('nethost', 'ip'), 
     228                        $self->base->list_objects('nethost')); 
    233229                    return @list; 
    234230                } 
    … …  
    236232        } 
    237233    ); 
    238     $env->add_func('user',  { alias => [qw'select user' ] }); 
    239     $env->add_func('group', { alias => [qw'select group'] }); 
    240     return $env 
    241 } 
    242  
    243 =head2 objenv ($labase, $otype, @objs) 
    244  
    245 Return a C<cli> envirronment over object. 
    246  
    247 =cut 
    248  
    249 sub objenv { 
    250     my ($labase, $otype, @objs) = @_; 
    251     my $objenv = LATMOS::Accounts::Cli->new( 
    252         { 
    253             prompt => sub { 
    254                 sprintf("%s %s/%s", 
    255                     $_[0]->base->label, 
    256                     $_[0]->{_otype}, 
    257                     @{$_[0]->{_objects}} > 1 ? '(' . 
    258                     scalar(@{$_[0]->{_objects}}) . ' obj.)' : $_[0]->{_objects}[0]->id, 
    259                 ); 
    260             }, 
    261         }, 
    262         $labase 
    263     ); 
    264     $objenv->{_otype} = $otype; 
    265     $objenv->{_objects} = [ @objs ]; 
    266     $objenv->add_func('+', { 
    267         help => 'add item to selection', 
    268         code => sub { 
    269             my ($env, @ids) = @_; 
    270             my %ids = map { $_->id => 1 } @{$env->{_objects}}; 
    271             foreach (@ids) { 
    272                 $ids{$_} and next; 
    273                 my $o = $env->base->get_object($env->{_otype}, $_) or next; 
    274                 push(@{$env->{_objects}}, $o); 
    275             } 
    276             printf $OUT "select is now %s: %s\n", $env->{_otype}, join(', ', map { 
    277                 $_->id } @{$env->{_objects}}); 
    278         }, 
    279         completion => sub { 
    280             my ($env, undef, @ids) = @_; 
    281             my %ids = map { $_->id => 1 } @{$env->{_objects}}; 
    282             return ( grep { ! $ids{$_} } $env->base->list_objects($env->{_otype})); 
    283         }, 
    284         } 
    285     ); 
    286     $objenv->add_func('-', { 
    287         help => 'add item to selection', 
    288         code => sub { 
    289             my ($env, @ids) = @_; 
    290             my %ids = map { $_ => 1 } @ids; 
    291             my @newobjs = grep { !$ids{$_->id} } @{$env->{_objects}}; 
    292  
    293             if (!@newobjs) { 
    294                 print $OUT "This would remove all objects from the list...\n"; 
    295                 return; 
    296             } else { 
    297                 @{$env->{_objects}} = @newobjs; 
    298             } 
    299             printf $OUT "select is now %s: %s\n", $env->{_otype}, join(', ', map { 
    300                 $_->id } @{$env->{_objects}}); 
    301         }, 
    302         completion => sub { 
    303             my ($env, undef, @ids) = @_; 
    304             my %ids = map { $_ => 1 } @ids; 
    305             grep { !$ids{$_} } map { $_->id } @{$env->{_objects}}; 
    306         }, 
    307         } 
    308     ); 
    309     $objenv->add_func('show', { 
    310         help => 'show attributes - show an attributes of object', 
    311         code => sub { 
    312             my ($env, $attr) = @_; 
    313             if (!$attr) { 
    314                 foreach (@{$env->{_objects}}) { 
    315                     print $OUT $_->dump; 
    316                 } 
    317             } else { 
    318                 foreach my $u (@{$env->{_objects}}) { 
    319                     print $OUT sort map { $u->id . ': ' .($_ || '') . "\n" } $u->get_attributes($attr); 
    320                 } 
    321             } 
    322         }, 
    323         completion => sub { 
    324             if (!$_[2]) { 
    325                 return $_[0]->base->list_canonical_fields($_[0]->{_otype}, 'r') 
    326             } 
    327         }, 
    328     }); 
    329     $objenv->add_func('print', { 
    330         help => 'print fmt - show attributes using template', 
    331         code => sub { 
    332             my ($env, $fmt) = @_; 
    333             if (!defined($fmt)) { 
    334                 print $OUT "no format given"; 
    335                 return; 
    336             } 
    337             foreach (@{$env->{_objects}}) { 
    338                 print $OUT $_->queryformat($fmt) . "\n"; 
    339             } 
    340         }, 
    341     }); 
    342     $objenv->add_func('unset', { 
    343         help => 'unset attribute - unset specified attribute', 
    344         code => sub { 
    345             my ($env, $attr) = @_; 
    346             $attr or do { 
    347                 print $OUT "Attributes must be specified"; 
    348                 return; 
    349             }; 
    350             foreach (@{$env->{_objects}}) { 
    351                 defined $_->set_c_fields($attr => undef) or do { 
    352                     print $OUT "cannot unset attributes $attr for " . $_->id . 
    353                     "\n"; 
    354                     return; 
    355                 }; 
    356             } 
    357             $env->commit; 
    358             print $OUT "Changes applied\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             } 
    365         }, 
    366     }); 
    367     $objenv->add_func('set', { 
    368         help => 'set attribute value - set an attributes to single value "value"', 
    369         code => sub { 
    370             my ($env, $attr, @value) = @_; 
    371             @value or do { 
    372                 print $OUT "attribute and value must be specified\n"; 
    373                 return; 
    374             }; 
    375             foreach (@{$env->{_objects}}) { 
    376                 defined $_->set_c_fields($attr => @value <= 1 ? $value[0] : 
    377                     \@value) or do { 
    378                     $_->base->rollback; 
    379                     printf $OUT "Cannot set $attr to %s for %s\n", join(', ', 
    380                         @value), $_->id; 
    381                     return; 
    382                 }; 
    383             } 
    384             $env->commit; 
    385             print $OUT "Done.\n"; 
    386         }, 
    387         completion => sub { 
    388             my ($env, $lastw, @args) = @_; 
    389             if (!$args[0]) { 
    390                 return $env->base->list_canonical_fields($env->{_otype}, 'w') 
    391             } else { 
    392                 my $attr = $env->base->attribute($env->{_otype}, $args[0]); 
    393                 if ($attr->has_values_list) { 
    394                     $attr->can_values; 
    395                 } elsif (@{$env->{_objects}} == 1) { 
    396                     return 
    397                     $env->{_objects}[0]->get_attributes($args[0]); 
    398                 } 
    399             } 
    400         }, 
    401     }); 
    402     $objenv->add_func('add', { 
    403         help => 'add a value to an attribute', 
    404         code => sub { 
    405             my ($env, $attr, @value) = @_; 
    406             @value or do { 
    407                 print $OUT "attribute and value must be specified\n"; 
    408                 return; 
    409             }; 
    410             foreach (@{$env->{_objects}}) { 
    411                 my @attrv = grep { $_ } $_->get_attributes($attr); 
    412                 defined $_->set_c_fields($attr => [ @attrv, @value ]) or do { 
    413                     $_->base->rollback; 
    414                     printf $OUT "Cannot set $attr to %s for %s\n", join(', ', 
    415                         @value), $_->id; 
    416                     return; 
    417                 }; 
    418             } 
    419             $env->commit; 
    420             print $OUT "done\n"; 
    421         }, 
    422         completion => sub { 
    423             my ($env, $lastw, @args) = @_; 
    424             if (!$args[0]) { 
    425                 return grep { 
    426                     $env->base->attribute($env->{_otype}, $_)->{multiple} 
    427                 } $env->base->list_canonical_fields($env->{_otype}, 'w') 
    428             } else { 
    429                 my $attr = $env->base->attribute($env->{_otype}, $args[0]); 
    430                 if ($attr->has_values_list) { 
    431                     $attr->can_values; 
    432                 } elsif (@{$env->{_objects}} == 1) { 
    433                     return 
    434                     $env->{_objects}[0]->get_attributes($args[0]); 
    435                 } 
    436             } 
    437         }, 
    438     }); 
    439     $objenv->add_func('remove', { 
    440         help => 'remove a value from an attribute', 
    441         code => sub { 
    442             my ($env, $attr, @value) = @_; 
    443             @value or do { 
    444                 print $OUT "attribute and value must be specified\n"; 
    445                 return; 
    446             }; 
    447             foreach (@{$env->{_objects}}) { 
    448                 my @attrv = grep { $_ } $_->get_attributes($attr); 
    449                 foreach my $r (@value) { 
    450                     @attrv = grep { $_ ne $r } @attrv; 
    451                 } 
    452                 defined $_->set_c_fields($attr => @attrv ? [ @attrv ] : undef) or do { 
    453                     $_->rollback; 
    454                     printf $OUT "Cannot set $attr to %s for %s\n", join(', ', 
    455                         @value), $_->id; 
    456                     return; 
    457                 }; 
    458             } 
    459             $env->commit; 
    460             print $OUT "done\n"; 
    461         }, 
    462         completion => sub { 
    463             my ($env, $lastw, @args) = @_; 
    464             if (!$args[0]) { 
    465                 return grep { 
    466                     $env->base->attribute($env->{_otype}, $_)->{multiple} 
    467                 } $env->base->list_canonical_fields($env->{_otype}, 'w') 
    468             } else { 
    469                 my $attr = $env->base->attribute($env->{_otype}, $args[0]); 
    470                 if (@{$env->{_objects}} == 1) { 
    471                     return 
    472                     $env->{_objects}[0]->get_attributes($args[0]); 
    473                 } 
    474             } 
    475         }, 
    476     }); 
    477     $objenv->add_func('list', { 
    478         help => 'list current selected objects', 
    479         code => sub { 
    480             printf $OUT "%s: %s\n", $_[0]->{_otype}, join(', ', map { $_->id } 
    481             @{$_[0]->{_objects}}); 
    482         } 
    483     }); 
    484     $objenv->add_func('edit', { 
    485             help => 'edit [object] - edit selected object using vi', 
    486             completion => sub { 
    487                 return map { $_->id } @{$_[0]->{_objects}} 
    488             }, 
    489             code => sub { 
    490                 my ($env, $id) = @_; 
    491                 my $obj; 
    492                 if ($id) { 
    493                     $obj = grep { $_->id = $id } @{$env->{_objects}} or do { 
    494                         print $OUT "$id is not part of selected objects\n"; 
    495                         return; 
    496                     }; 
    497                 } elsif (@{$env->{_objects}} == 1) { 
    498                     $obj = $env->{_objects}[0] 
    499                 } else { 
    500                     print $OUT "multiple objects selected but can edit only one," 
    501                     . "please specify which one\n"; 
    502                     return; 
    503                 } 
    504                 my $res = LATMOS::Accounts::Utils::dump_read_temp_file( 
    505                     sub { 
    506                         my ($fh) = @_; 
    507                         $obj->text_dump($fh, 
    508                             { 
    509                                 empty_attr => 1, 
    510                                 only_rw => 1, 
    511                             } 
    512                         ); 
    513                     }, 
    514                     sub { 
    515                         my ($fh) = @_; 
    516                         my %attr = LATMOS::Accounts::Utils::parse_obj_file($fh); 
    517                         my $res = $obj->set_c_fields(%attr); 
    518                         if ($res) { 
    519                             print $OUT "Changes applied\n"; 
    520                             $env->commit; 
    521                         } 
    522                         else { print $OUT "Error applying changes\n" } 
    523                         return $res ? 1 : 0; 
    524                     } 
    525                 ); 
    526             }, 
    527         }); 
    528     $objenv->add_func('delete', { 
    529         help => 'delete - delete selected object', 
    530         code => sub { 
    531             my ($env) = @_; 
    532             printf $OUT "%s: %s\ndelete selected objects ? (yes/NO)\n", 
    533             $env->{_otype}, join(', ', map { $_->id } @{$env->{_objects}}); 
    534             my $reply = <STDIN> || ''; chomp($reply); 
    535             if ($reply eq 'yes') { 
    536                 foreach (@{$env->{_objects}}) { 
    537                     $env->base->delete_object($env->{_otype}, $_->id) or do { 
    538                         print $OUT "Cannot delete " . $_->id . "\n"; 
    539                         return; 
    540                     }; 
    541                 } 
    542                 $env->commit; 
    543                 return "EXIT"; 
    544             } else { 
    545                 print $OUT "cancel !\n" 
    546             } 
    547         }, 
    548     }); 
    549     if (grep { $objenv->base->attribute($otype, $_)->reference } 
    550         $objenv->base->list_canonical_fields($otype, 'r')) { 
    551         $objenv->add_func('select', { 
    552             help => 'select attribute [object]', 
    553             code => sub { 
    554                 my ($env, $attrname, @objects) = @_; 
    555  
    556                 my $attr = $env->base->attribute( 
    557                     $env->{_otype}, 
    558                     $attrname 
    559                 ) or do { 
    560                     print $OUT "No attribute $attrname"; 
    561                     return; 
    562                 }; 
    563                 my $totype = $attr->reference or return; 
    564  
    565                 if (! @objects) { 
    566                     @objects = grep { $_ }  
    567                       map { $_->get_attributes($attrname) } @{$env->{_objects}}; 
    568                 } 
    569                 { 
    570                     my %uniq = map { $_ => 1 } @objects; 
    571                     @objects = keys %uniq; 
    572                 } 
    573                 my @objs = (grep { $_ } map { $env->base->get_object($totype, $_) } 
    574                         @objects); 
    575                 return if (!@objs); 
    576                 print $OUT "Selecting $otype " . join(', ', map { $_->id } @objs) . "\n"; 
    577                 objenv($_[0]->base, $totype, @objs)->cli(); 
    578             }, 
    579             completion => sub { 
    580                 if ($_[2]) { 
    581                     my $totype = $_[0]->base->attribute($_[0]->{_otype}, 
    582                         $_[2])->reference or return; 
    583                     return grep { $_ } 
    584                            map { $_->get_attributes($_[2]) } 
    585                            @{$_[0]->{_objects}}; 
    586                 } else { 
    587                     return grep { $_[0]->base->attribute($otype, $_)->reference } 
    588                     $_[0]->base->list_canonical_fields($otype, 'r'); 
    589                 } 
    590             }, 
    591             } 
    592         ); 
    593     } 
    594  
    595     if (lc($otype) eq 'user') { 
    596         $objenv->add_func('group', { 
    597             help => 'group add|remove|primary goupname', 
    598             code => sub { 
    599                 my ($env, $action, @groups) = @_; 
    600                 foreach my $obj (@{$env->{_objects}}) { 
    601                     if ($action eq 'primary') { 
    602                         my $gid = $groups[0]; 
    603                         if ($gid !~ /^\d/) { 
    604                             my $gobj = $env->base->get_object('group', $gid) or 
    605                             do { 
    606                                 print $OUT "Cannot find group $gid\n"; 
    607                                 return; 
    608                             }; 
    609                             $gid = $gobj->get_attributes('gidNumber'); 
    610                         } 
    611                         $obj->set_c_fields('gidNumber', $gid); 
    612                     } else { 
    613                         my %gr; 
    614                         foreach ($obj->get_attributes('memberOf')) { 
    615                             $gr{$_} = 1; 
    616                         } 
    617                         if ($action eq 'add') { 
    618                             $gr{$_} = 1 foreach(@groups); 
    619                         } elsif ($action eq 'remove') { 
    620                             delete($gr{$_}) foreach(@groups); 
    621                         } else { 
    622                             print $OUT 'invalid action' . "\n"; 
    623                             return; 
    624                         } 
    625                         defined $obj->set_c_fields('memberOf' => [ keys %gr ]) or do { 
    626                             print $OUT "cannot set memberOf attributes for " . 
    627                             $obj->id . "\n"; 
    628                             return; 
    629                         }; 
    630                     } 
    631                 } 
    632                 $env->commit; 
    633             }, 
    634             completion => sub { 
    635                 if (!$_[2]) { 
    636                     return (qw(add remove primary)); 
    637                 } else { 
    638                     if ($_[2] eq 'remove') { 
    639                         my %uniq = map { $_ => 1 } 
    640                             grep { $_ } 
    641                             map { $_->get_attributes('memberOf') } 
    642                             @{$_[0]->{_objects}}; 
    643                         return sort keys %uniq; 
    644                     } else { 
    645                         return $_[0]->base->search_objects('group'); 
    646                     } 
    647                 } 
    648             }, 
    649         }); 
    650     } elsif ($otype eq 'group') { 
    651         $objenv->add_func('member', { 
    652             help => 'member add|remove user', 
    653             code => sub { 
    654                 my ($env, $action, @groups) = @_; 
    655                 foreach my $obj (@{$env->{_objects}}) { 
    656                     my %gr; 
    657                     foreach ($obj->get_attributes('memberUID')) { 
    658                         $gr{$_} = 1; 
    659                     } 
    660                     if ($action eq 'add') { 
    661                         $gr{$_} = 1 foreach(@groups); 
    662                     } elsif ($action eq 'remove') { 
    663                         delete($gr{$_}) foreach(@groups); 
    664                     } else { 
    665                         print $OUT 'invalid action' . "\n"; 
    666                         return; 
    667                     } 
    668                     defined $obj->set_c_fields('memberUID' => [ keys %gr ]) or do { 
    669                         print $OUT "cannot set memberUID attributes for " . 
    670                         $obj->id . "\n"; 
    671                         return; 
    672                     }; 
    673                 } 
    674                 $env->commit; 
    675             }, 
    676             completion => sub { 
    677                 if (!$_[2]) { 
    678                     return (qw(add remove)); 
    679                 } else { 
    680                     if ($_[2] eq 'remove') { 
    681                         my %uniq = map { $_ => 1 } 
    682                             grep { $_ } 
    683                             map { $_->get_attributes('member') } 
    684                             @{$_[0]->{_objects}}; 
    685                         return sort keys %uniq; 
    686                     } else { 
    687                         return $_[0]->base->search_objects('user'); 
    688                     } 
    689                 } 
    690             }, 
    691         }); 
    692     } 
    693  
    694     return $objenv; 
    695 } 
    696  
    697 =head1 OBJECT FUNCTIONS 
    698  
    699 =head2 new ($env, $labase) 
    700  
    701 Create an envirronment object. 
    702  
    703 C<$env> is functions descriptions. 
    704  
    705 =cut 
    706  
    707 sub new { 
    708     my ($class, $env, $labase) = @_; 
    709     bless($env, $class); 
    710     $env->{_labase} = $labase; 
    711  
    712     if ($labase->is_transactionnal) { 
    713         $env->add_func( 
    714             'transaction', { 
    715                 help => 'change transaction mode', 
    716                 code => sub { 
    717                     $trans_mode = $_[1] eq 'on' ? 1 : 0; 
    718                 }, 
    719                 completion => sub { 
    720                     $trans_mode == 0 ? 'on' : 'off'; 
    721                 }, 
    722             } 
    723         ); 
    724         $env->add_func( 
    725             'begin', { 
    726                 help => 'Start transaction', 
    727                 code => sub { 
    728                     $trans_start = 1; 
    729                 }, 
    730             } 
    731         ); 
    732         $env->add_func( 
    733             'commit', { 
    734                 help => 'commit pending change', 
    735                 code => sub { 
    736                     $_[0]->_commit; 
    737                 }, 
    738             } 
    739         ); 
    740         $env->add_func( 
    741             'rollback', { 
    742                 help => 'commit pending change', 
    743                 code => sub { 
    744                     $_[0]->_rollback; 
    745                 }, 
    746             } 
    747         ); 
    748     } 
    749     if ($labase->can('CreateAlias')) { 
    750         $env->add_func( 
    751             'newalias', { 
    752                 help => 'Create an alias object', 
    753                 code => sub { 
    754                     my ($self, $otype, $name, $for) = @_; 
    755                     if ($self->base->CreateAlias($otype, $name, $for)) { 
    756                         print $OUT "Alias $otype/$name Created\n"; 
    757                         $self->commit; 
    758                     } 
    759                 }, 
    760                 completion => sub { 
    761                     if ($_[3]) { 
    762                         return $_[0]->base->list_objects($_[2]); 
    763                     } elsif (!$_[2]) { 
    764                         return $_[0]->base->list_supported_objects; 
    765                     } else { 
    766                         return; 
    767                     } 
    768                 } 
    769             }, 
    770         ); 
    771         $env->add_func( 
    772             'rmalias', { 
    773                 help => 'Remove an alias object', 
    774                 code => sub { 
    775                     my ($self, $otype, $name) = @_; 
    776                     if ($self->base->RemoveAlias($otype, $name)) { 
    777                         print $OUT "Alias $otype/$name Removed\n"; 
    778                         $self->commit; 
    779                     } 
    780                 }, 
    781                 completion => sub { 
    782                     if (!$_[2]) { 
    783                         return $_[0]->base->list_supported_objects; 
    784                     } else { 
    785                         return $_[0]->base->search_objects($_[2], 'oalias=*'); 
    786                     } 
    787                 } 
    788             }, 
    789         ); 
    790         $env->add_func( 
    791             'updalias', { 
    792                 help => 'Update an alias object', 
    793                 code => sub { 
    794                     my ($self, $otype, $name, $for) = @_; 
    795                     my $obj = $self->base->GetAlias($otype, $name) or do { 
    796                         print $OUT "No alias $otype/$name found"; 
    797                         return; 
    798                     }; 
    799                     if ($obj->set_c_fields(oalias => $for)) { 
    800                         print $OUT "Alias $otype/$name Updated\n"; 
    801                         $self->commit; 
    802                     } 
    803                 }, 
    804                 completion => sub { 
    805                     if ($_[3]) { 
    806                         return $_[0]->base->list_objects($_[2]); 
    807                     } elsif($_[2]) { 
    808                         return $_[0]->base->search_objects($_[2], 'oalias=*'); 
    809                     } else { 
    810                         return $_[0]->base->list_supported_objects; 
    811                     } 
    812                 } 
    813             }, 
    814         ); 
    815     } 
    816     $env->add_func('quit', { help => 'quit - exit the tool', 
    817             code => sub { print "\n"; exit(0) }, }); 
    818     $env->add_func('exit', { help => "exit current mode", 
    819             code => sub { return "EXIT" }, }); 
    820     $env->add_func('help', { 
    821         help => 'help [command] - print help about command', 
    822         completion => sub { 
    823             if (!$_[2]) { return sort keys %{ $_[0]->{funcs} || {}} } 
    824         }, 
    825         code => sub { 
    826             my ($self, $name) = @_; 
    827             if (!$name) { 
    828                 print $OUT join(', ', sort keys %{ $self->{funcs} || {}}) . "\n"; 
    829             } elsif ($self->{funcs}{$name}{alias}) { 
    830                 print $OUT "$name is an alias for " . join(' ', 
    831                     @{$self->{funcs}{$name}{alias}}) . "\n"; 
    832             } elsif ($self->{funcs}{$name}{help}) { 
    833                 print $OUT $self->{funcs}{$name}{help} . "\n"; 
    834             } else { 
    835                 print $OUT "No help availlable\n"; 
    836             } 
    837         }, 
    838     }); 
    839  
    840     $env; 
    841 } 
    842  
    843 =head2 base 
    844  
    845 Return the attached base object. 
    846  
    847 =cut 
    848  
    849 sub base { $_[0]->{_labase} } 
    850  
    851 =head2 cli 
    852  
    853 Start the main loop 
    854  
    855 =cut 
    856  
    857 sub cli { 
    858     my ($self) = @_; 
    859     while (1) { 
    860         $term->Attribs->{completion_function} = sub { 
    861             $self->complete($_[0], shellwords(substr($_[1], 0, $_[2]))); 
    862         }; 
    863         defined (my $line = $term->readline($self->prompt)) or do { 
    864             print $OUT "\n"; 
    865             return; 
    866         }; 
    867         $term->addhistory($line); 
    868         my $res = $self->run(shellwords($line)); 
    869         $self->rollback if (!$trans_mode); 
    870         if ($res && $res eq 'EXIT') { print $OUT "\n"; return } 
    871     } 
    872 } 
    873  
    874 =head2 prompt 
    875  
    876 Wait user to input command 
    877  
    878 =cut 
    879  
    880 sub prompt { 
    881     my ($self) = @_; 
    882     my $pr = $self->{prompt} 
    883         ? $self->{prompt}->($self) 
    884         : "LA cli"; 
    885     return sprintf( 
    886         "%s%s%s ", 
    887         $pr, 
    888         $trans_start ? '-' : '=', 
    889         $trans_mode  ? '#' : '>', 
    890     ); 
    891 } 
    892  
    893 =head2 add_func ($name, $param) 
    894  
    895 Add new function in the envirronment 
    896  
    897 =cut 
    898  
    899 # TODO: hide this 
    900  
    901 sub add_func { 
    902     my ($self, $name, $param) = @_; 
    903     $self->{funcs}{$name} = $param; 
    904 } 
    905  
    906 =head2 getoption ($opt, @args) 
    907  
    908 Parse commmand line 
    909  
    910 =cut 
    911  
    912 sub getoption { 
    913     my ($self, $opt, @args) = @_; 
    914     local @ARGV = @args; 
    915     Getopt::Long::Configure("pass_through"); 
    916     GetOptions(%{ $opt }); 
    917  
    918     return @ARGV; 
    919 } 
    920  
    921 =head2 complete 
    922  
    923 Return possible words according current entered words 
    924  
    925 =cut 
    926  
    927 sub complete { 
    928     my ($self, $lastw, $name, @args) = @_; 
    929     if (!$name) { 
    930         return grep { /^\Q$lastw\E/ } sort 
    931             (keys %{ $self->{funcs} || {}}); 
    932     } elsif ($self->{funcs}{$name}{alias}) { 
    933         $self->complete($lastw, @{$self->{funcs}{$name}{alias}}, @args); 
    934     } elsif ($self->{funcs}{$name}{completion}) { 
    935         return map { my $t = $_; $t =~ s/\s/\\ /g; $t } grep { $_ && /^\Q$lastw\E/ } $self->{funcs}{$name}{completion}->($self, $lastw, @args); 
    936     } else { 
    937         return (); 
    938     } 
    939 } 
    940  
    941 =head2 run ($name, @args) 
    942  
    943 Run functions 
    944  
    945 =cut 
    946  
    947 sub run { 
    948     my ($self, $name, @args) = @_; 
    949     return if (!$name); 
    950     if (!exists($self->{funcs}{$name})) { 
    951         print $OUT "No command $name found\n"; 
    952     } elsif ($self->{funcs}{$name}{alias}) { 
    953         $self->run(@{$self->{funcs}{$name}{alias}}, @args); 
    954     } elsif ($self->{funcs}{$name}{code}) { 
    955         $self->{funcs}{$name}{code}->($self, @args); 
    956     } else { 
    957         print $OUT "No command $name found\n"; 
    958     } 
    959 } 
    960  
    961 =head2 commit 
    962  
    963 Call commit to base unelss in transaction mode 
    964  
    965 =cut 
    966  
    967 sub commit { 
    968     my ($self) = @_; 
    969     if ($trans_mode || $trans_start) { 
    970         $trans_start = 1; 
    971     } else { 
    972         $self->_commit; 
    973     } 
    974 } 
    975  
    976 sub _commit { 
    977     my ($self) = @_; 
    978     $self->base->commit; 
    979     $trans_start = 0; 
    980 } 
    981  
    982 =head2 rollback 
    983  
    984 Perform rollback unless in transaction mode 
    985  
    986 =cut 
    987  
    988 sub rollback { 
    989     my ($self) = @_; 
    990     if ($trans_mode) { 
    991         print $OUT "All pending changes get rollback\n"; 
    992     } 
    993     if (!$trans_start) { 
    994         $self->_rollback; 
    995     } 
    996 } 
    997  
    998 sub _rollback { 
    999     my ($self) = @_; 
    1000     $self->base->rollback; 
    1001     $trans_start = 0; 
     234    $self->add_func('user',  { alias => [qw'select user' ] }); 
     235    $self->add_func('group', { alias => [qw'select group'] }); 
     236    return $self 
    1002237} 
    1003238 
Note: See TracChangeset for help on using the changeset viewer.