Changeset 2423

Timestamp:

06/26/20 01:20:59 (4 years ago)

Author:

nanardon

Message:

la-cli: add collection command (save object list)

Location:

trunk/LATMOS-Accounts

Files:

• bin/la-cli (modified) (1 diff)
• lib/LATMOS/Accounts/Cli.pm (modified) (1 diff)
• lib/LATMOS/Accounts/Cli/Base.pm (modified) (2 diffs)
• lib/LATMOS/Accounts/Cli/Context.pm (modified) (3 diffs)

trunk/LATMOS-Accounts/bin/la-cli

@@ -81 +81 @@
     $Env->run(@ARGV);
 } else {
-     my $history = "$ENV{HOME}/.lacli_history";
-     $Env->Context->Term->ReadHistory($history);
-     $Env->cli;
-     if (! $Env->Context->Term->WriteHistory($history)) {
-         warn "Cannot write history:  $!\n";
-     }
+     $Env->topCli;
 }
 print "\n";

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

@@ -223 +223 @@
                     push(@objs, $obj);
                 }
-                $self->print("Selecting $otype " . join(', ', @ids) . "\n");
+                $self->print("Selecting $otype " . join(', ', @objs) . "\n");
                 LATMOS::Accounts::Cli::Object->new(
                     Parent  => $self,

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

@@ -249 +249 @@
     }
 
+=head3 collection
+
+Manage saved objects list:
+
+    collection list
+    collection save
+    collection load
+    collection delete
+
+=cut
+
+    $self->add_func( 'collection',
+        {
+            code => sub {
+                my ( $self, $subcommand, @args ) = @_;
+                $subcommand ||= '';
+                $self->Context->Preferences->{Collections} ||= {};
+                my $Collections = $self->Context->Preferences->{Collections};
+                if ( $subcommand eq 'list' || !$subcommand ) {
+                    foreach my $c ( sort keys %{ $Collections } ) {
+                        my @objlist = @{ $Collections->{$c}{objs} || []};
+                        $self->printf(
+                            "%s: %s, %s\n",
+                            $c,
+                            $Collections->{$c}{otype},
+                            (@objlist >= 1 ? scalar(@objlist) . ' objs.' : $objlist[0]),
+                        );
+                    }
+                } elsif ($subcommand eq 'load') {
+                    my $c = $args[0] or do {
+                        $self->print("No collection name given\n");
+                        return;
+                    };
+                    if (! $Collections->{$c} ) {
+                        $self->print("This collection does not exists\n");
+                        return;
+                    }
+                    my $otype = $Collections->{ $c }{otype};
+                    my @objs;
+                    foreach (@{ $Collections->{ $c }{ objs } || []}) {
+                        my $obj = $self->base->get_object($otype, $_) or do {
+                            $self->print("Cannot get $otype $_\n");
+                            return;
+                        };
+                        push(@objs, $obj);
+                    }
+                    if (@objs) {
+                        $self->print("Selecting $otype " . join(', ', map { $_->id } @objs) . "\n");
+                        LATMOS::Accounts::Cli::Object->new(
+                            Parent  => $self,
+                            Context => $self->Context,
+                            otype   => $otype,
+                            objs    => \@objs,
+                        )->cli();
+                    } else {
+                        $self->print("No objects to load\n");
+                    }
+                } elsif ($subcommand eq 'clear') {
+                    $self->Context->Preferences->{Collections} = {};
+                } elsif ($subcommand =~ m/^(delete|del)$/) {
+                    my ( $name ) = @args;
+                    delete( $Collections->{$name} );
+                } elsif ($subcommand eq 'save' ) {
+                    my ( $name, $what ) = @args;
+                    $what ||= '';
+
+                    if ( $what eq '@' ) {
+                        if (! $self->{_lastsearch} ) {
+                            $self->print("No previous search found, nothing saved\n");
+                            return;
+                        }
+                        $Collections->{ $name } = {
+                            otype => $self->{_lastsearchtype},
+                            objs =>  [ @{$self->{_lastsearch}} ],
+                        }
+                    } elsif ($self->can('otype')) {
+                        $Collections->{ $name } = {
+                            otype => $self->otype,
+                            objs =>  [ map { $_->id } @{ $self->objs || [] } ],
+                        };
+                    } else {
+                        $self->print("No objects to save");
+                    }
+                }
+            },
+            completion => sub {
+                my ($self, undef, $command, $name, $what) = @_;
+                $command ||= '';
+                my $Collections = $self->Context->Preferences->{Collections} || {};
+                if ( ! $command ) {
+                    return qw(list load save delete clear);
+                } elsif ( $command =~ /^(load|delete|del)$/ ) {
+                    return sort keys %{ $Collections };
+                } elsif ( $command eq 'save' ) {
+                    if ($name) {
+                        return qw( @ );
+                    }
+                } else {
+                    return;
+                }
+            },
+        }
+    );
+
 =head2 GLOBAL and OBJECTS FUNCTION
 
@@ -525 +629 @@
     return ( $op, $shellLine, shellwords($internalLine) );
 
+}
+
+=head2 topCli
+
+Entry point for cli
+
+=cut
+
+sub topCli {
+    my ( $self ) = @_;
+
+    $self->Context->ReadHistory();
+    $self->Context->ReadPreferences();
+    $self->cli();
+    if (! $self->Context->WriteHistory() ) {
+        warn "Cannot write history:  $!\n";
+    }
+    $self->Context->WritePreferences();
 }
 

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

@@ -11 +11 @@
 use Text::ParseWords;
 use Getopt::Long;
+use YAML;
 use utf8;
 use open qw( :std :utf8 );
@@ -39 +40 @@
 has TempOut => ( is => 'rw' );
 has Interractive => ( is => 'rw', isa => 'Bool', default => 1 );
+has Preferences => ( is => 'rw', default => sub { {} } );
 
 =head1 FUNCTIONS
@@ -59 +61 @@
     my $OUT = \*STDOUT;
 
+    $term->ReadHistory( _historyFile() );
 
     return $class->$orig( Out => $OUT, Term => $term, @_ );
 
 };
+
+sub _historyFile { "$ENV{HOME}/.lacli_history" }
+
+sub ReadHistory {
+    my ( $self ) = @_;
+    $self->Term->ReadHistory( _historyFile() );
+}
+
+sub WriteHistory {
+    my ( $self ) = @_;
+    $self->Term->WriteHistory( _historyFile() );
+}
+
+sub _preferenceFile { "$ENV{HOME}/.lacli_preference" }
+
+sub ReadPreferences {
+    my ( $self ) = @_;
+
+    if (-f _preferenceFile() ) {
+        $self->Preferences( YAML::LoadFile( _preferenceFile() ) );
+    }
+}
+
+sub WritePreferences {
+    my ( $self ) = @_;
+
+    YAML::DumpFile( _preferenceFile(), $self->Preferences() );
+}
 
 =head2 print