Capture fields modifying the original alias

Signed-off-by: Mike Rylander <mrylander@gmail.com>

diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/QueryParser.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/QueryParser.pm
index dc44b34..1703925 100644 (file)
--- a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/QueryParser.pm
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/QueryParser.pm
@@ -475,19 +475,23 @@ sub decompose {
     my $first_class = 1;
 
     my %seen_classes;
-    for my $class ( keys %{$pkg->search_fields} ) {
+    for my $class ( keys %{$pkg->search_field_aliases} ) {
+        warn " *** ... Looking for search fields in $class\n" if $self->debug;
 
-        for my $field ( @{$pkg->search_fields->{$class}} ) {
+        for my $field ( keys %{$pkg->search_field_aliases->{$class}} ) {
+            warn " *** ... Looking for aliases of $field\n" if $self->debug;
 
             for my $alias ( @{$pkg->search_field_aliases->{$class}{$field}} ) {
                 my $aliasr = qr/$alias/;
+                s/(^|\s+)$aliasr\|/$1$class\|$field#$alias\|/g;
                 s/(^|\s+)$aliasr[:=]/$1$class\|$field#$alias:/g;
+                warn " *** Rewriting: $alias ($aliasr) as $class\|$field\n" if $self->debug;
             }
         }
 
         $search_class_re .= '|' unless ($first_class);
         $first_class = 0;
-        $search_class_re .= $class . '(?:[|#]\w+)*';
+        $search_class_re .= $class . '(?:[|#][^:|]+)*';
         $seen_classes{$class} = 1;
     }
 
@@ -497,13 +501,14 @@ sub decompose {
             my $aliasr = qr/$alias/;
             s/(^|[^|])\b$aliasr\|/$1$class#$alias\|/g;
             s/(^|[^|])\b$aliasr[:=]/$1$class#$alias:/g;
+            warn " *** Rewriting: $alias ($aliasr) as $class\n" if $self->debug;
         }
 
         if (!$seen_classes{$class}) {
             $search_class_re .= '|' unless ($first_class);
             $first_class = 0;
 
-            $search_class_re .= $class . '(?:[|#]\w+)*';
+            $search_class_re .= $class . '(?:[|#][^:|]+)*';
             $seen_classes{$class} = 1;
         }
     }
@@ -1090,18 +1095,26 @@ sub requested_class { # also split into classname, fields and alias
     my $class = shift;
 
     if ($class) {
-        my $alias;
-        if ($class =~ s/#([^|]*)//) {
-                $alias = $1;
+        my @afields;
+        my (undef, $alias) = split '#', $class;
+        if ($alias) {
+            $class =~ s/#[^|]+//;
+            ($alias, @afields) = split '\|', $alias;
         }
 
+        my @fields = @afields;
         my ($class_part, @field_parts) = split '\|', $class;
+        for my $f (@field_parts) {
+             push(@fields, $f) unless (grep { $f eq $_ } @fields);
+        }
+
         $class_part ||= $class;
 
         $self->{requested_class} = $class;
         $self->{alias} = $alias if $alias;
+        $self->{alias_fields} = \@afields if $alias;
         $self->{classname} = $class_part;
-        $self->{fields} = \@field_parts;
+        $self->{fields} = \@fields;
     }
 
     return $self->{requested_class};
@@ -1123,6 +1136,14 @@ sub alias {
     return $self->{alias};
 }
 
+sub alias_fields {
+    my $self = shift;
+    my $alias = shift;
+
+    $self->{alias_fields} = $alias if ($alias);
+    return $self->{alias_fields};
+}
+
 sub classname {
     my $self = shift;
     my $class = shift;
@@ -1254,6 +1275,7 @@ sub to_abstract_query {
     my $abstract_query = {
         "type" => "node",
         "alias" => $self->alias,
+        "alias_fields" => $self->alias_fields,
         "class" => $self->classname,
         "fields" => $self->fields
     };