Ignore:
Timestamp:
12/02/11 11:42:17 (12 years ago)
Author:
nanardon
Message:
  • reimport missing files from previous svn
File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r851 r861  
    99use Term::ReadLine; 
    1010use 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} 
    1119 
    1220my $term = Term::ReadLine->new('LA CLI'); 
     21$term->MinLine(99999); 
    1322my $OUT = $term->OUT || \*STDOUT; 
     23 
     24my $trans_mode = 0; 
    1425 
    1526sub globalenv { 
    … …  
    2940            if ($arg eq 'yes') { 
    3041                $env->base->unexported(1); 
    31                 print $OUT "Unexported are now show"; 
     42                print $OUT "Unexported are now show\n"; 
    3243            } elsif ($arg eq 'no') { 
    3344                $env->base->unexported(0); 
    34                 print $OUT "Unexported are no longer show"; 
     45                print $OUT "Unexported are no longer show\n"; 
    3546            } elsif ($arg eq 'show') { 
    36                 print $OUT "Unexported objects " . $env->base->unexported ? 
    37                 "enable" : "disable"; 
     47                print $OUT "Unexported objects " . ($env->base->unexported ? 
     48                "enable" : "disable") . "\n"; 
    3849            } else { 
    39                 print $OUT "wrong argument"; 
     50                print $OUT "wrong argument\n"; 
    4051            } 
    4152        }, 
    … …  
    5263                    print $OUT map { "$_\n" } $_[0]->base->list_objects($_[1]); 
    5364                } else { 
    54                     print $OUT "Object type missing"; 
     65                    print $OUT "Object type missing\n"; 
    5566                } 
    5667            }, 
    … …  
    7182                    $env->{_lastsearchtype} = $args[0]; 
    7283                } else { 
    73                     print $OUT "Object type missing"; 
     84                    print $OUT "Object type missing\n"; 
    7485                } 
    7586            }, 
    … …  
    112123                        @ids = @{$env->{_lastsearch}}; 
    113124                    } else { 
    114                         print $OUT "No results store from previous search"; 
     125                        print $OUT "No results store from previous search\n"; 
    115126                        return; 
    116127                    } 
    117128                } 
    118129                if (!@ids) { 
    119                     print $OUT 'not enough arguments'; 
     130                    print $OUT 'not enough arguments' . "\n"; 
    120131                    return; 
    121132                } 
    122133                foreach (@ids) { 
    123134                    my $obj = $env->base->get_object($otype, $_) or do { 
    124                         print $OUT "Cannot get $otype $_"; 
     135                        print $OUT "Cannot get $otype $_\n"; 
    125136                        return; 
    126137                    }; 
    127138                    push(@objs, $obj); 
    128139                } 
    129                 print $OUT "Selecting $otype " . join(', ', @ids); 
     140                print $OUT "Selecting $otype " . join(', ', @ids) . "\n"; 
    130141                objenv($_[0]->base, $otype, @objs)->cli(); 
    131142            }, 
    132143        }); 
     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    ); 
    133217    $env->add_func('user',  { alias => [qw'select user' ] }); 
    134218    $env->add_func('group', { alias => [qw'select group'] }); 
    … …  
    153237    $objenv->{_otype} = $otype; 
    154238    $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    ); 
    155282    $objenv->add_func('show', { 
    156283        help => 'show attributes - show an attributes of object', 
    … …  
    177304        code => sub { 
    178305            my ($env, $fmt) = @_; 
     306            if (!defined($fmt)) { 
     307                print $OUT "no format given"; 
     308                return; 
     309            } 
    179310            foreach (@{$env->{_objects}}) { 
    180311                print $OUT $_->queryformat($fmt) . "\n"; 
    … …  
    192323            foreach (@{$env->{_objects}}) { 
    193324                defined $_->set_c_fields($attr => undef) or do { 
    194                     print $OUT "cannot unset attributes $attr for " . $_->id; 
     325                    print $OUT "cannot unset attributes $attr for " . $_->id . 
     326                    "\n"; 
    195327                    return; 
    196328                }; 
    197329            } 
    198             $env->base->commit; 
    199             print $OUT "Changes applied"; 
     330            $env->commit; 
     331            print $OUT "Changes applied\n"; 
    200332        }, 
    201333        completion => sub { 
    … …  
    211343            my ($env, $attr, @value) = @_; 
    212344            @value or do { 
    213                 print $OUT "attribute and value must be specified"; 
     345                print $OUT "attribute and value must be specified\n"; 
    214346                return; 
    215347            }; 
    … …  
    218350                    \@value) or do { 
    219351                    $_->base->rollback; 
    220                     printf $OUT "Cannot set $attr to %s for %s", join(', ', 
     352                    printf $OUT "Cannot set $attr to %s for %s\n", join(', ', 
    221353                        @value), $_->id; 
    222354                    return; 
    223355                }; 
    224356            } 
    225             $env->base->commit; 
    226             print $OUT "done"; 
     357            $env->commit; 
     358            print $OUT "Done.\n"; 
    227359        }, 
    228360        completion => sub { 
    … …  
    231363                return $env->base->list_canonical_fields($env->{_otype}, 'w') 
    232364            } else { 
    233                 if ($env->base->obj_attr_allowed_values($env->{_otype}, $args[0])) { 
    234                     return $env->base->obj_attr_allowed_values($env->{_otype}, $args[0]) 
    235                 } 
    236                 for ($args[0]) { 
    237                     /^manager|managedBy$/ and return 
    238                         $env->base->search_objects('user'); 
    239                     /^department$/ and return 
    240                         $env->base->search_objects('group', 'sutype=dpmt'); 
    241                     /^contratType$/ and return 
    242                         $env->base->search_objects('group', 'sutype=contrattype'); 
    243                     /^site$/ and return 
    244                         $env->base->search_objects('site'); 
    245                     if (@{$env->{_objects}} == 1) { 
    246                         return $env->{_objects}[0]->get_attributes($args[0]); 
    247                     } 
     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]); 
    248446                } 
    249447            } 
    … …  
    253451        help => 'list current selected objects', 
    254452        code => sub { 
    255             printf $OUT "%s: %s", $_[0]->{_otype}, join(', ', map { $_->id } 
     453            printf $OUT "%s: %s\n", $_[0]->{_otype}, join(', ', map { $_->id } 
    256454            @{$_[0]->{_objects}}); 
    257455        } 
    … …  
    267465                if ($id) { 
    268466                    $obj = grep { $_->id = $id } @{$env->{_objects}} or do { 
    269                         print $OUT "$id is not part of selected objects"; 
     467                        print $OUT "$id is not part of selected objects\n"; 
    270468                        return; 
    271469                    }; 
    … …  
    274472                } else { 
    275473                    print $OUT "multiple objects selected but can edit only one," 
    276                     . "please specify which one"; 
     474                    . "please specify which one\n"; 
    277475                    return; 
    278476                } 
    … …  
    292490                        my $res = $obj->set_c_fields(%attr); 
    293491                        if ($res) { 
    294                             print $OUT "Changes applied"; 
    295                             $env->base->commit; 
     492                            print $OUT "Changes applied\n"; 
     493                            $env->commit; 
    296494                        } 
    297                         else { print $OUT "Error applying changes" } 
     495                        else { print $OUT "Error applying changes\n" } 
    298496                        return $res ? 1 : 0; 
    299497                    } 
    … …  
    305503        code => sub { 
    306504            my ($env) = @_; 
    307             printf $OUT "%s: %s\ndelete selected objects ? (yes/NO) ", 
     505            printf $OUT "%s: %s\ndelete selected objects ? (yes/NO)\n", 
    308506            $env->{_otype}, join(', ', map { $_->id } @{$env->{_objects}}); 
    309507            my $reply = <STDIN> || ''; chomp($reply); 
    … …  
    311509                foreach (@{$env->{_objects}}) { 
    312510                    $env->base->delete_object($env->{_otype}, $_->id) or do { 
    313                         print $OUT "Cannot delete " . $_->id; 
     511                        print $OUT "Cannot delete " . $_->id . "\n"; 
    314512                        return; 
    315513                    }; 
    316514                } 
    317                 $env->base->commit; 
     515                $env->commit; 
    318516                return "EXIT"; 
    319517            } else { 
    320                 print $OUT "cancel !" 
    321             } 
    322         }, 
    323     }); 
     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    } 
    324560 
    325561    if (lc($otype) eq 'user') { 
    … …  
    334570                            my $gobj = $env->base->get_object('group', $gid) or 
    335571                            do { 
    336                                 print $OUT "Cannot find group $gid"; 
     572                                print $OUT "Cannot find group $gid\n"; 
    337573                                return; 
    338574                            }; 
    … …  
    350586                            delete($gr{$_}) foreach(@groups); 
    351587                        } else { 
    352                             print $OUT 'invalid action'; 
     588                            print $OUT 'invalid action' . "\n"; 
    353589                            return; 
    354590                        } 
    355591                        defined $obj->set_c_fields('memberOf' => [ keys %gr ]) or do { 
    356592                            print $OUT "cannot set memberOf attributes for " . 
    357                             $obj->id; 
     593                            $obj->id . "\n"; 
    358594                            return; 
    359595                        }; 
    360596                    } 
    361597                } 
    362                 $env->base->commit; 
     598                $env->commit; 
    363599            }, 
    364600            completion => sub { 
    … …  
    366602                    return (qw(add remove primary)); 
    367603                } else { 
    368                     return $_[0]->base->search_objects('group'); 
     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                    } 
    369613                } 
    370614            }, 
    … …  
    385629                        delete($gr{$_}) foreach(@groups); 
    386630                    } else { 
    387                         print $OUT 'invalid action'; 
     631                        print $OUT 'invalid action' . "\n"; 
    388632                        return; 
    389633                    } 
    390634                    defined $obj->set_c_fields('memberUID' => [ keys %gr ]) or do { 
    391635                        print $OUT "cannot set memberUID attributes for " . 
    392                         $obj->id; 
     636                        $obj->id . "\n"; 
    393637                        return; 
    394638                    }; 
    395639                } 
    396                 $env->base->commit; 
     640                $env->commit; 
    397641            }, 
    398642            completion => sub { 
    … …  
    400644                    return (qw(add remove)); 
    401645                } else { 
    402                     return $_[0]->base->search_objects('user'); 
     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                    } 
    403655                } 
    404656            }, 
    … …  
    413665    bless($env, $class); 
    414666    $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    } 
    415697    $env->add_func('quit', { help => 'quit - exit the tool', 
    416698            code => sub { print "\n"; exit(0) }, }); 
    … …  
    425707            my ($self, $name) = @_; 
    426708            if (!$name) { 
    427                 print $OUT join(', ', sort keys %{ $self->{funcs} || {}}); 
     709                print $OUT join(', ', sort keys %{ $self->{funcs} || {}}) . "\n"; 
    428710            } elsif ($self->{funcs}{$name}{alias}) { 
    429711                print $OUT "$name is an alias for " . join(' ', 
    430                     @{$self->{funcs}{$name}{alias}}); 
     712                    @{$self->{funcs}{$name}{alias}}) . "\n"; 
    431713            } elsif ($self->{funcs}{$name}{help}) { 
    432                 print $OUT $self->{funcs}{$name}{help}; 
     714                print $OUT $self->{funcs}{$name}{help} . "\n"; 
    433715            } else { 
    434                 print $OUT "No help availlable"; 
     716                print $OUT "No help availlable\n"; 
    435717            } 
    436718        }, 
    … …  
    448730            $self->complete($_[0], shellwords(substr($_[1], 0, $_[2]))); 
    449731        }; 
    450         defined (my $line = $term->readline($self->prompt)) or return; 
     732        defined (my $line = $term->readline($self->prompt)) or do { 
     733            print $OUT "\n"; 
     734            return; 
     735        }; 
     736        $term->addhistory($line); 
    451737        my $res = $self->run(shellwords($line)); 
    452         $self->base->rollback; 
    453         if ($res && $res eq 'EXIT') { return } 
     738        $self->rollback if (!$trans_mode); 
     739        if ($res && $res eq 'EXIT') { print $OUT "\n"; return } 
    454740    } 
    455741} 
    … …  
    469755} 
    470756 
     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 
    471766sub parse_arg { 
    472767    my ($self, $name, @args) = @_; 
    473     if ($self->{funcs}{$name}{opt}) { 
    474         @ARGV = @args; 
    475     } else { 
    476         return @args; 
    477     } 
    478     return @ARGV; 
     768    return @args; 
    479769} 
    480770 
    … …  
    497787    my ($self, $name, @args) = @_; 
    498788    return if (!$name); 
    499     if ($self->{funcs}{$name}{alias}) { 
     789    if (!exists($self->{funcs}{$name})) { 
     790        print $OUT "No command $name found\n"; 
     791    } elsif ($self->{funcs}{$name}{alias}) { 
    500792        $self->run(@{$self->{funcs}{$name}{alias}}, @args); 
    501793    } elsif ($self->{funcs}{$name}{code}) { 
    502794        my @pargs = $self->parse_arg($name, @args); 
    503795        $self->{funcs}{$name}{code}->($self, @args); 
     796    } else { 
     797        print $OUT "No command $name found\n"; 
    504798    } 
    505799} 
    506800 
     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 
    5078271; 
Note: See TracChangeset for help on using the changeset viewer.