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