Changeset 4840

Timestamp:

2003-07-01T11:55:31+12:00 (21 years ago)

Author:

davidb

Message:

-removesuffix option added to provide similar funtionality to -removeprefix

Location:

trunk/gsdl/perllib/classify

Files:

• AZCompactList.pm (modified) (6 diffs)
• AZList.pm (modified) (5 diffs)

trunk/gsdl/perllib/classify/AZCompactList.pm

@@ -68 +68 @@
       { 'name' => "removeprefix",
     'desc' => "A prefix to ignore in the Metadata values for the field when sorting.",
+    'type' => "string",
+    'deft' => "",
+    'reqd' => "no" },
+      { 'name' => "removesuffix",
+    'desc' => "A suffix to ignore in the Metadata values for the field when sorting.",
     'type' => "string",
     'deft' => "",
@@ -142 +147 @@
 
 
-    my ($metaname, $title, $removeprefix);
+    my ($metaname, $title, $removeprefix, $removesuffix);
     my $mingroup = 2;
     my $minnesting = 20;
@@ -156 +161 @@
              q^buttonname/.*/^, \$title,
              q^removeprefix/.*/^, \$removeprefix,
+             q^removesuffix/.*/^, \$removesuffix,
              q^mingroup/.*/2^, \$mingroup,
              q^minnesting/.*/20^, \$minnesting,
@@ -187 +193 @@
     $self->{'title'} = "$title";     # title for the titlebar.
     if (defined($removeprefix) && $removeprefix) {
+    $removeprefix =~ s/^\^//; # don't need a leading ^
     $self->{'removeprefix'} = $removeprefix;
+    }
+    if (defined($removesuffix) && $removesuffix) {
+    $removesuffix =~ s/\$$//; # don't need a trailing $
+    $self->{'removesuffix'} = $removesuffix;
     }
     $self->{'mingroup'} = $mingroup;
@@ -277 +288 @@
         if (defined $metavalue && $metavalue =~ /\w/) 
         {
-        if ($self->{'removeprefix'}) {
+        if (defined($self->{'removeprefix'}) &&
+            length($self->{'removeprefix'})) {
             $metavalue =~ s/^$self->{'removeprefix'}//;
+
+            # check that it's not now empty
+            if (!$metavalue) {next;}
+        }
+
+        if (defined($self->{'removesuffix'}) &&
+            length($self->{'removesuffix'})) {
+            $metavalue =~ s/$self->{'removesuffix'}$//;
 
             # check that it's not now empty
@@ -423 +443 @@
         my $formatted_node = $metavalue;
 
-        if ($self->{'removeprefix'}) {
+        if (defined($self->{'removeprefix'}) &&
+            length($self->{'removeprefix'})) {
             $formatted_node =~ s/^$self->{'removeprefix'}//;
+            # check that it's not now empty
+            if (!$formatted_node) {next;}
+        }
+        if (defined($self->{'removesuffix'}) &&
+            length($self->{'removesuffix'})) {
+            $formatted_node =~ s/$self->{'removesuffix'}$//;
             # check that it's not now empty
             if (!$formatted_node) {next;}

trunk/gsdl/perllib/classify/AZList.pm

@@ -50 +50 @@
     'type' => "string",
     'deft' => "",
-    'reqd' => "no" } ];
+    'reqd' => "no" } ,
+      { 'name' => "removesuffix",
+    'desc' => "A suffix to ignore in the Metadata values for the field when sorting.",
+    'type' => "string",
+    'deft' => "",
+    'reqd' => "no" } 
+      ];
 
 my $options = { 'name'     => "AZList",
@@ -81 +87 @@
     push( @{$option_list}, $options );
     
-    my ($metaname, $title, $removeprefix);
+    my ($metaname, $title, $removeprefix, $removesuffix);
     
     if (!parsargv::parse(\@_, 
@@ -87 +93 @@
              q^buttonname/.*/^, \$title,
              q^removeprefix/.*/^, \$removeprefix,
+             q^removesuffix/.*/^, \$removesuffix,
              "allow_extra_options")) {
     
@@ -109 +116 @@
     $self->{'removeprefix'} = $removeprefix;
     }
+    if (defined($removesuffix) && $removesuffix) {
+    $removesuffix =~ s/\$$//; # don't need a trailing $
+    $self->{'removesuffix'} = $removesuffix;
+    }
 
     return bless $self, $class;
@@ -133 +144 @@
         length($self->{'removeprefix'})) {
         $metavalue =~ s/^$self->{'removeprefix'}//;
+    }
+    if (defined($self->{'removesuffix'}) &&
+        length($self->{'removesuffix'})) {
+        $metavalue =~ s/$self->{'removesuffix'}$//;
     }