source: LATMOS-Accounts/bin/la-cli @ 843

#!/usr/bin/perl

use strict;
use warnings;
use LATMOS::Accounts;
use Getopt::Long;
use Pod::Usage;
use Term::ReadLine;
use Text::ParseWords;

=head1 NAME

    la-query - Tools to query base in LATMOS::Accounts system

=head1 SYNOPSIS

    la-query [options] [obj_id]

=item [obj_id] : If present, all set attributes (rw) will be displayed for that obj_id.
        If none is given, all obj_ids will be printed.

For the default object_type (user), obj_id = login.

Example : la-query lambda

=cut

GetOptions(
    'c|config=s' => \my $config,
    'b|base=s'   => \my $base,
    'noexp'      => \my $noexp,
    'exp'        => \my $exp,
    'help'       => sub { pod2usage(0) },
) or pod2usage();

=head1 OPTIONS

=over 4

=item -c|--config configfile

Use this configuration file instead of the default one.

=item -b|--base basename

Query this specific base instead of the default one.

=item --noexp

Take into account all objects (even non propagated ones, with attribute 'exported'=0)

=item --exp

Take into account only propagated objects (attribute 'exported'=1) (default)

=back

=cut

my $LA = LATMOS::Accounts->new($config, noacl => 1);
my $labase = $base ? $LA->base($base) : $LA->default_base;
$labase && $labase->load or die "Cannot load base";

$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::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;
}

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;