Changeset 2447

Timestamp:

10/27/20 08:49:06 (4 years ago)

Author:

nanardon

Message:

Add grep, rework sed

File:

• trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Cli/Object.pm (modified) (2 diffs)

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

@@ -380 +380 @@
         },
     });
-    $self->add_func('sed', {
-        help => 'Apply regular expression on curent attribute',
-        code => sub {
-            my ($env, $attr, $reg) = @_;
+
+=head3 show
+
+    grep ATTRIBUTE REGEXP
+    
+Show value on specified attribute matching RE
+
+=cut
+
+    $self->add_func('grep', {
+        help => 'Find value matching regular expression on given attribute',
+        code => sub {
+            my ($env, @args) = @_;
+            my ( $attr, $reg )  = $self->getoption(
+                {
+                    'i'      => \my $icase,
+                }, @args
+            );
             $reg or do {
                 $self->print( "attribute and value must be specified\n" );
                 return;
             };
+            my $reopt = '';
+            $reopt .= 'i' if($icase);
+            my $re = eval"qr/$reg/$reopt";
+            if ($@) {
+                $self->print($@);
+                return;
+            }
+            foreach (@{$env->{_objects}}) {
+                foreach my $val ($_->get_attributes($attr)) {
+                    if ($@) {
+                        $self->print("$@No change done\n");
+                        $env->rollback;
+                        return;
+                    }
+                    if ($val =~ $re) {
+                        $self->printf("%s: %s\n", $_->id, $val);
+                    }
+                }
+            }
+        },
+        completion => sub {
+            my ($env, $lastw, @args) = @_;
+            if (!$args[0]) {
+                return $env->base->list_canonical_fields($env->{_otype}, 'w')
+            }
+        },
+    });
+
+=head3 sed
+
+    sed ATTRIBUTE REGEXP VALUE
+
+Replace matching REGEXP by VALUE for specified ATTRIBUTE.
+If the resulting value is empty the value is deleted.
+
+=cut
+
+    $self->add_func('sed', {
+        help => 'Apply regular expression on given attribute to modify it',
+        code => sub {
+            my ($env, @args) = @_;
+            my ( $attr, $reg, $subst )  = $self->getoption(
+                {
+                    'i'      => \my $icase,
+                }, @args
+            );
+            $subst or do {
+                $self->print( "attribute and value must be specified\n" );
+                return;
+            };
+            my $reopt = '';
+            $reopt .= 'i' if($icase);
+            my $re = eval"qr/$reg/$reopt";
+            if ($@) {
+                $self->print($@);
+                return;
+            }
             foreach (@{$env->{_objects}}) {
                 my @newvalues;
@@ -393 +464 @@
                 foreach my $val ($_->get_attributes($attr)) {
                     my $nval = $val;
-                    eval "\$nval =~ $reg;";
-                    if ($@) {
-                        $self->print("$@No change done\n");
-                        $env->rollback;
-                        return;
-                    }
+                    $nval =~ s/$re/$subst/;
                     if ($val ne $nval) {
                         $self->printf("%s: %s => %s\n", $_->id, $val, $nval);