Changeset 844 for LATMOS-Accounts

Timestamp:

03/28/10 18:59:12 (14 years ago)

Author:

nanardon

Message:

• split la-cli into specific package

Location:

LATMOS-Accounts

Files:

• bin/la-cli (modified) (2 diffs)
• lib/LATMOS/Accounts/Cli.pm (added)
• t/06_cli.t (added)

LATMOS-Accounts/bin/la-cli

@@ -6 +6 @@
 use Getopt::Long;
 use Pod::Usage;
-use Term::ReadLine;
-use Text::ParseWords;
+use LATMOS::Accounts::Cli;
 
 =head1 NAME
@@ -64 +63 @@
 $labase->wexported($noexp ? 0 : 1);
 
-my $term = Term::ReadLine->new('LA CLI');
-my $attribs = $term->Attribs;
-my $OUT = $term->OUT || \*STDOUT;
+my $globalenv = LATMOS::Accounts::Cli::globalenv($labase);
 
-my $globalenv = LATMOS::Accounts::Clienv->new(
-    {
-        prompt => sub { "LA cli > " },
-    }
-);
-$globalenv->add_func('ls', {
-    help => 'ls object_type - list object of type object_type', 
-    completion => sub {
-        if(!$_[3]) {
-            return grep { /^\Q$_[1]\E/ } $labase->list_supported_objects
-        } else { () }
-    },
-    code => sub {
-        if ($_[1]) {
-            print $OUT map { "$_\n" } $labase->list_objects($_[1]);
-        } else {
-            print $OUT "Object type missing";
-        }
-    },
-});
-$globalenv->add_func('select', {
-    help => 'select object_type - select objects to perform action on it',
-    completion => sub {
-        if ($_[2]) {
-            return grep { /^\Q$_[1]\E/ } $labase->list_objects($_[2]);
-        } else {
-            return grep { /^\Q$_[1]\E/ } $labase->list_supported_objects;
-        }
-    },
-    code => sub {
-        my ($env, $otype, @ids) = @_;
-        my @objs;
-        if (!@ids) {
-            print $OUT 'not enough arguments';
-            return;
-        }
-        foreach (@ids) {
-            my $obj = $labase->get_object($otype, $_) or do {
-                print $OUT "Cannot get $otype $_";
-                return;
-            };
-            push(@objs, $obj);
-        }
-        cli(_obj_env($otype, @objs));
-    },
-});
-$globalenv->add_func('user',  { alias => 'select' });
-$globalenv->add_func('group', { alias => 'select' });
-
-
-sub _obj_env {
-    my ($otype, @objs) = @_;
-    my $objenv = LATMOS::Accounts::Clienv->new(
-        {
-            prompt => sub {
-                sprintf("%s (%s) > ",
-                    $_[0]->{_otype},
-                    @{$_[0]->{_objects}} > 1 ? '...' : $_[0]->{_objects}[0]->id,
-                );
-            },
-        }
-    );
-    $objenv->{_otype} = $otype;
-    $objenv->{_objects} = [ @objs ];
-    $objenv->add_func('show', {
-        help => 'show attributes - show an attributes of object',
-        code => sub {
-            my ($env, $attr) = @_;
-            if (!$attr) {
-                foreach (@{$env->{_objects}}) {
-                    print $OUT $_->dump;
-                }
-            } else {
-                foreach (@{$env->{_objects}}) {
-                    print $OUT sort map { ($_ || '') . "\n" } $_->get_attributes($attr);
-                }
-            }
-        },
-        completion => sub {
-            if (!$_[2]) {
-                return grep { /^\Q$_[1]\E/ }
-                $labase->list_canonical_fields($_[0]->{_otype}, 'r')
-            }
-        },
-    });
-
-    return $objenv;
+if (@ARGV) {
+    $globalenv->run(@ARGV);
+} else {
+    $globalenv->cli;
 }
-
-sub cli {
-    my ($env) = @_;
-    my $prompt = $env->prompt;
-    
-    while (1) {
-        $attribs->{completion_function} = sub {
-            $env->complete($_[0], shellwords(substr($_[1], 0, $_[2])));
-        };
-        defined (my $line = $term->readline($prompt)) or return;
-        $env->run(shellwords($line));
-        $labase->rollback;
-    }
-}
-
-cli($globalenv);
 print "\n";
 
 exit 0;
 
-package LATMOS::Accounts::Clienv;
-
-sub new {
-    my ($class, $env) = @_;
-    bless($env, $class);
-    $env->add_func('quit', { help => 'quit - exit the tool',
-            code => sub { print "\n"; exit(0) }, });
-    $env;
-}
-
-sub prompt {
-    my ($self) = @_;
-    if (!$self->{prompt}) {
-        return "LA cli > ";
-    } else {
-        $self->{prompt}->($self);
-    }
-}
-
-sub add_func {
-    my ($self, $name, $param) = @_;
-    $self->{funcs}{$name} = $param;
-}
-
-sub parse_arg {
-    my ($self, $name, @args) = @_;
-    if ($self->{funcs}{$name}{opt}) {
-        @ARGV = @args;
-    } else {
-        return @args;
-    }
-    return @ARGV;
-}
-
-sub complete {
-    my ($self, $lastw, $name, @args) = @_;
-    if (!$name) {
-        return grep { /^\Q$lastw\E/ } sort
-            ('help', keys %{ $self->{funcs} || {}});
-    } elsif ($name eq 'help') {
-        return grep { /^\Q$lastw\E/ } sort keys %{ $self->{funcs} || {}};
-    } elsif ($self->{funcs}{$name}{alias}) {
-        $self->complete($lastw, $self->{funcs}{$name}{alias}, $name, @args);
-    } elsif ($self->{funcs}{$name}{completion}) {
-        my @pargs = $self->parse_arg($name, @args);
-        return $self->{funcs}{$name}{completion}->($self, $lastw, @pargs);
-    } else {
-        return ();
-    }
-}
-
-sub run {
-    my ($self, $name, @args) = @_;
-    return if (!$name);
-    if ($name eq 'help') {
-        $self->help(@args);
-    } elsif ($self->{funcs}{$name}{alias}) {
-        $self->run($self->{funcs}{$name}{alias}, $name, @args);
-    } elsif ($self->{funcs}{$name}{code}) {
-        my @pargs = $self->parse_arg($name, @args);
-        $self->{funcs}{$name}{code}->($self, @args);
-    }
-}
-
-sub help {
-    my ($self, $name) = @_;
-    if (!$name) {
-        print $OUT join(', ', sort keys %{ $self->{funcs} || {}});
-    } elsif ($self->{funcs}{$name}{alias}) {
-        print $OUT "$name is an alias for `$self->{funcs}{$name}{alias} $name'";
-    } elsif ($self->{funcs}{$name}{help}) {
-        print $OUT $self->{funcs}{$name}{help};
-    } else {
-        print $OUT "No help availlable";
-    }
-}
-
-
-1;