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