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