Open-ILS/src/perlmods/lib/OpenILS/Application/Flattener.pm

   1 package OpenILS::Application::Flattener;
   2
   3 # This package is not meant to be registered as a stand-alone OpenSRF
   4 # application, but to be used by high level methods in other services.
   5
   6 use base qw/OpenILS::Application/;
   7
   8 use strict;
   9 use warnings;
  10
  11 use OpenSRF::EX qw/:try/;
  12 use OpenSRF::Utils::Logger qw/:logger/;
  13 use OpenILS::Utils::CStoreEditor q/:funcs/;
  14 use OpenSRF::Utils::JSON;
  15
  16 sub _fm_link_from_class {
  17     my ($class, $field) = @_;
  18
  19     return Fieldmapper->publish_fieldmapper->{$class}{links}{$field};
  20 }
  21
  22 sub _flattened_search_single_flesh_wad {
  23     my ($hint, $path)  = @_;
  24
  25     $path = [ @$path ]; # clone for processing here
  26     my $class = OpenSRF::Utils::JSON->lookup_class($hint);
  27
  28     my $flesh_depth = 0;
  29     my $flesh_fields = {};
  30
  31     pop @$path; # last part is just field
  32
  33     my $piece;
  34
  35     while ($piece = shift @$path) {
  36         my $link = _fm_link_from_class($class, $piece);
  37         if ($link) {
  38             $flesh_fields->{$hint} ||= [];
  39             push @{ $flesh_fields->{$hint} }, $piece;
  40             $hint = $link->{class};
  41             $class = OpenSRF::Utils::JSON->lookup_class($hint);
  42             $flesh_depth++;
  43         } else {
  44             throw OpenSRF::EX::ERROR("no link $piece on $class");
  45         }
  46     }
  47
  48     return {
  49         flesh => $flesh_depth,
  50         flesh_fields => $flesh_fields
  51     };
  52 }
  53
  54 # returns a join clause AND a string representing the deepest join alias
  55 # generated.
  56 sub _flattened_search_single_join_clause {
  57     my ($column_name, $hint, $path)  = @_;
  58
  59     my $class = OpenSRF::Utils::JSON->lookup_class($hint);
  60     my $last_ident = $class->Identity;
  61
  62     $path = [ @$path ]; # clone for processing here
  63
  64     pop @$path; # last part is just field
  65
  66     my $core_join = {};
  67     my $last_join;
  68     my $piece;
  69     my $alias;  # yes, we need it out at this scope.
  70
  71     while ($piece = shift @$path) {
  72         my $link = _fm_link_from_class($class, $piece);
  73         if ($link) {
  74             $hint = $link->{class};
  75             $class = OpenSRF::Utils::JSON->lookup_class($hint);
  76
  77             my $reltype = $link->{reltype};
  78             my $field = $link->{key};
  79             if ($link->{map}) {
  80                 # XXX having a non-blank value for map means we'll need
  81                 # an additional level of join. TODO.
  82                 throw OpenSRF::EX::ERROR(
  83                     "support not yet implemented for links like '$piece' with" .
  84                     " non-blank 'map' IDL attribute"
  85                 );
  86             }
  87
  88             $alias = "__${column_name}_${hint}";
  89             my $new_join;
  90             if ($reltype eq "has_a") {
  91                 $new_join = {
  92                     class => $hint,
  93                     fkey => $piece,
  94                     field => $field
  95                 };
  96             } elsif ($reltype eq "has_many" or $reltype eq "might_have") {
  97                 $new_join = {
  98                     class => $hint,
  99                     fkey => $last_ident,
 100                     field => $field
 101                 };
 102             } else {
 103                 throw OpenSRF::EX::ERROR("unexpected reltype for link $piece");
 104             }
 105
 106             if ($last_join) {
 107                 $last_join->{join}{$alias} = $new_join;
 108             } else {
 109                 $core_join->{$alias} = $new_join;
 110             }
 111
 112             $last_ident = $class->Identity;
 113             $last_join = $new_join;
 114         } else {
 115             throw new OpenSRF::EX::ERROR("no link '$piece' on $class");
 116         }
 117     }
 118
 119     return ($core_join, $alias);
 120 }
 121
 122 # When $value is a string (short form of a column definition), it is assumed to
 123 # be a dot-delimited path.  This will be normalized into a hash (long form)
 124 # containing and path key, whose value will be made into an array, and true
 125 # values for sort/filter/display.
 126 #
 127 # When $value is already a hash (long form), just make an array of the path key
 128 # and explicity set any sort/filter/display values not present to 0.
 129 #
 130 sub _flattened_search_normalize_map_column {
 131     my ($value) = @_;
 132
 133     if (ref $value eq "HASH") {
 134         foreach (qw/sort filter display/) {
 135             $value->{$_} = 0 unless exists $value->{$_};
 136         }
 137         $value->{path} = [split /\./, $value->{path}];
 138     } else {
 139         $value = {
 140             path => [split /\./, $value],
 141             sort => 1,
 142             filter => 1,
 143             display => 1
 144         };
 145     }
 146
 147     return $value;
 148 }
 149
 150 sub _flattened_search_merge_flesh_wad {
 151     my ($old, $new) = @_;
 152
 153     $old->{flesh} ||= 0;
 154     $old->{flesh} = $old->{flesh} > $new->{flesh} ? $old->{flesh} : $new->{flesh};
 155
 156     $old->{flesh_fields} ||= {};
 157     foreach my $key (keys %{$new->{flesh_fields}}) {
 158         if ($old->{flesh_fields}{$key}) {
 159             # For easy bonus points, somebody could take the following block
 160             # and make it use Set::Scalar so it's more semantic, which would
 161             # mean a new Evergreen dependency.
 162             #
 163             # The nonobvious point of the following code is to merge the
 164             # arrays at $old->{flesh_fields}{$key} and
 165             # $new->{flesh_fields}{$key}, treating the arrays as sets.
 166
 167             my %hash = map { $_ => 1 } (
 168                 @{ $old->{flesh_fields}{$key} },
 169                 @{ $new->{flesh_fields}{$key} }
 170             );
 171             $old->{flesh_fields}{$key} = [ keys(%hash) ];
 172         } else {
 173             $old->{flesh_fields}{$key} = $new->{flesh_fields}{$key};
 174         }
 175     }
 176 }
 177
 178 sub _flattened_search_merge_join_clause {
 179     my ($old, $new) = @_;
 180
 181     %$old = ( %$old, %$new );
 182 }
 183
 184 sub _flattened_search_expand_filter_column {
 185     my ($o, $key, $map) = @_;
 186
 187     if ($map->{$key}) {
 188         my $table = $map->{$key}{last_join_alias};
 189         my $column = $map->{$key}{path}[-1];
 190
 191         if ($table) {
 192             $table = "+" . $table;
 193             $o->{$table} ||= {};
 194
 195             $o->{$table}{$column} = $o->{$key};
 196             delete $o->{$key};
 197
 198             return $o->{$table}{$column};
 199         } else {    # field must be on core class
 200             if ($column ne $key) {
 201                 $o->{$column} = $o->{$key};
 202                 delete $o->{$key};
 203             }
 204             return $o->{$column};
 205         }
 206     } else {
 207         return $o->{$key};
 208     }
 209 }
 210
 211 sub _flattened_search_recursively_apply_map_to_filter {
 212     my ($o, $map, $state) = @_;
 213
 214     $state ||= {};
 215
 216     if (ref $o eq "HASH") {
 217         foreach my $key (keys %$o) {
 218             # XXX this business about "in_expr" may prove inadequate, but it's
 219             # intended to avoid trying to map things like "between" in
 220             # constructs like:
 221             #   {"somecolumn": {"between": [1,10]}}
 222             # and to that extent, it works.
 223
 224             if (not $state->{in_expr} and $key =~ /^[a-z]/) {
 225                 $state->{in_expr} = 1;
 226
 227                 _flattened_search_recursively_apply_map_to_filter(
 228                     _flattened_search_expand_filter_column($o, $key, $map),
 229                     $map, $state
 230                 );
 231
 232                 $state->{in_expr} = 0;
 233             } else {
 234                 _flattened_search_recursively_apply_map_to_filter(
 235                     $o->{$key}, $map, $state
 236                 );
 237             }
 238         }
 239     } elsif (ref $o eq "ARRAY") {
 240         _flattened_search_recursively_apply_map_to_filter(
 241             $_, $map, $state
 242         ) foreach @$o;
 243     } # else scalar, nothing to do?
 244 }
 245
 246 # returns a normalized version of the map, and the jffolo (see below)
 247 sub process_map {
 248     my ($hint, $map) = @_;
 249
 250     $map = { %$map };   # clone map, to work on new copy
 251
 252     my $jffolo = {    # jffolo: join/flesh/flesh_fields/order_by/limit/offset
 253         join => {}
 254     };
 255
 256     foreach my $k (keys %$map) {
 257         my $column = $map->{$k} =
 258             _flattened_search_normalize_map_column($map->{$k});
 259
 260         # For display columns, we'll need fleshing.
 261         if ($column->{display}) {
 262             _flattened_search_merge_flesh_wad(
 263                 $jffolo,
 264                 _flattened_search_single_flesh_wad($hint, $column->{path})
 265             );
 266         }
 267
 268         # For filter or sort columns, we'll need joining.
 269         if ($column->{filter} or $column->{sort}) {
 270             my ($clause, $last_join_alias) =
 271                 _flattened_search_single_join_clause($k,$hint,$column->{path});
 272
 273             $map->{$k}{last_join_alias} = $last_join_alias;
 274             _flattened_search_merge_join_clause($jffolo->{join}, $clause);
 275         }
 276     }
 277
 278     return ($map, $jffolo);
 279 }
 280
 281 # return a filter clause for PCRUD or cstore, by processing the supplied
 282 # simplifed $where clause using $map.
 283 sub prepare_filter {
 284     my ($map, $where) = @_;
 285
 286     my $filter = {%$where};
 287
 288     _flattened_search_recursively_apply_map_to_filter($filter, $map);
 289
 290     return $filter;
 291 }
 292
 293 # Return a jffolo with sort/limit/offset from the simplified sort hash (slo)
 294 # mixed in.  limit and offset are copied as-is.  sort is translated into
 295 # an order_by that calls simplified column named by their real names by checking
 296 # the map.
 297 sub finish_jffolo {
 298     my ($core_hint, $map, $jffolo, $slo) = @_;
 299
 300     $jffolo = { %$jffolo }; # clone
 301     $slo = { %$slo };       # clone
 302
 303     $jffolo->{limit} = $slo->{limit} if exists $slo->{limit};
 304     $jffolo->{offset} = $slo->{offset} if exists $slo->{offset};
 305
 306     return $jffolo unless $slo->{sort};
 307
 308     # The slo has a special format for 'sort' that gives callers what they
 309     # need, but isn't as flexible as json_query's 'order_by'.
 310     #
 311     # "sort": [{"column1": "asc"}, {"column2": "desc"}]
 312     #   or
 313     # "sort": ["column1", {"column2": "desc"}]
 314     #   or
 315     # "sort": {"onlycolumn": "asc"}
 316     #   or
 317     # "sort": "onlycolumn"
 318
 319     $jffolo->{order_by} = [];
 320
 321     # coerce from optional simpler format (see comment blob above)
 322     $slo->{sort} = [ $slo->{sort} ] unless ref $slo->{sort} eq "ARRAY";
 323
 324     foreach my $exp (@{ $slo->{sort} }) {
 325         $exp = { $exp => "asc" } unless ref $exp;
 326
 327         # XXX By assuming that each sort expression is (at most) a single
 328         # key/value pair, we preclude the ability to use transforms and the
 329         # like for now.
 330
 331         my ($key) = keys(%$exp);
 332
 333         if ($map->{$key}) {
 334             my $class = $map->{$key}{last_join_alias} || $core_hint;
 335             push @{ $jffolo->{order_by} }, {
 336                 class => $class,
 337                 field => $map->{$key}{path}[-1],
 338                 direction => $exp->{$key}
 339             };
 340         }
 341
 342         # If the key wasn't defined in the map, we'll leave it out of our
 343         # order_by clause.
 344     }
 345
 346     return $jffolo;
 347 }
 348
 349 # Given a map and a fieldmapper object, return a flat representation as
 350 # specified by the map's display fields
 351 sub process_result {
 352     my ($map, $fmobj) = @_;
 353
 354     if (not ref $fmobj) {
 355         throw OpenSRF::EX::ERROR(
 356             "process_result() was passed an inappropriate second argument"
 357         );
 358     }
 359
 360     my $flatrow = {};
 361
 362     while (my ($key, $mapping) = each %$map) {
 363         next unless $mapping->{display};
 364
 365         my @path = @{ $mapping->{path} };
 366         my $field = pop @path;
 367
 368         my $objs = [$fmobj];
 369         while (my $step = shift @path) {
 370             $objs = [ map { $_->$step } @$objs ];
 371             last unless ref $$objs[0];
 372         }
 373
 374         # We can get arrays of values be either:
 375         #  - ending on a $field within a has_many reltype
 376         #  - passing through a path that is a has_many reltype
 377         if (@$objs > 1 or ref $$objs[0] eq 'ARRAY') {
 378             $flatrow->{$key} = [];
 379             for my $o (@$objs) {
 380                 push @{ $flatrow->{$key} }, extract_field_value( $o, $field );
 381             }
 382         } else {
 383             $flatrow->{$key} = extract_field_value( $$objs[0], $field );
 384         }
 385     }
 386
 387     return $flatrow;
 388 }
 389
 390 sub extract_field_value {
 391     my $obj = shift;
 392     my $field = shift;
 393
 394     if (ref $obj eq 'ARRAY') {
 395         # has_many links return arrays
 396         return ( map {$_->$field} @$obj );
 397     }
 398     return ref $obj ? $obj->$field : undef;
 399 }
 400
 401 1;