lib/DBIx/Class/ResultSet/WithMetaData.pm

   1 package DBIx::Class::ResultSet::WithMetaData;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Data::Alias;
   7 use Moose;
   8 use Method::Signatures::Simple;
   9 extends 'DBIx::Class::ResultSet';
  10
  11 has '_row_info' => (
  12   is => 'rw',
  13   isa => 'HashRef'
  14 );
  15
  16 has 'was_row' => (
  17   is => 'rw',
  18   isa => 'Int'
  19 );
  20
  21 has 'id_cols' => (
  22   is => 'rw',
  23   isa => 'ArrayRef',
  24 );
  25
  26 has '_hash_modifiers' => (
  27   is => 'rw',
  28   isa => 'ArrayRef',
  29 );
  30
  31 has '_key_modifiers' => (
  32   is => 'rw',
  33   isa => 'ArrayRef',
  34 );
  35
  36 has '_object_hash_modifiers' => (
  37   is => 'rw',
  38   isa => 'ArrayRef',
  39 );
  40
  41 has '_object_key_modifiers' => (
  42   is => 'rw',
  43   isa => 'ArrayRef',
  44 );
  45
  46 =head1 VERSION
  47
  48 Version 1.000002
  49
  50 =cut
  51
  52 our $VERSION = '1.000002';
  53
  54 =head1 NAME
  55
  56 DBIx::Class::ResultSet::WithMetaData
  57
  58 =head1 SYNOPSIS
  59
  60   package MyApp::Schema::ResultSet::ObjectType;
  61
  62   use Moose;
  63   use MooseX::Method::Signatures;
  64   extends 'DBIx::Class::ResultSet::WithMetaData;
  65
  66   method with_substr () {
  67     return $self->_with_meta_key(
  68       substr => sub {
  69         return substr(shift->{name}, 0, 3);
  70       }
  71     );
  72   }
  73
  74   ...
  75
  76
  77   # then somewhere else
  78
  79   my $object_type_arrayref = $object_type_rs->with_substr->display();
  80
  81   # [{
  82   #    'artistid' => '1',
  83   #    'name' => 'Caterwauler McCrae',
  84   #    'substr' => 'Cat'
  85   #  },
  86   #  {
  87   #    'artistid' => '2',
  88   #    'name' => 'Random Boy Band',
  89   #    'substr' => 'Ran'
  90   #  },
  91   #  {
  92   #    'artistid' => '3',
  93   #    'name' => 'We Are Goth',
  94   #    'substr' => 'We '
  95   #  }]
  96
  97 =head1 DESCRIPTION
  98
  99 Attach metadata to rows by chaining ResultSet methods together. When the ResultSet is
 100 flattened to an ArrayRef the metadata is merged with the row hashes to give
 101 a combined 'hash-plus-other-stuff' representation.
 102
 103 =head1 METHODS
 104
 105 =cut
 106
 107 sub new {
 108   my $self = shift;
 109
 110   my $new = $self->next::method(@_);
 111   foreach my $key (qw/_row_info was_row id_cols _key_modifiers _hash_modifiers _object_key_modifiers _object_hash_modifiers/) {
 112     alias $new->{$key} = $new->{attrs}{$key};
 113   }
 114
 115   unless ($new->_row_info) {
 116     $new->_row_info({});
 117   }
 118
 119   unless ($new->_key_modifiers) {
 120     $new->_key_modifiers([]);
 121   }
 122   unless ($new->_hash_modifiers) {
 123     $new->_hash_modifiers([]);
 124   }
 125   unless ($new->_object_key_modifiers) {
 126     $new->_object_key_modifiers([]);
 127   }
 128   unless ($new->_object_hash_modifiers) {
 129     $new->_object_hash_modifiers([]);
 130   }
 131
 132   unless ($new->id_cols && scalar(@{$new->id_cols})) {
 133     $new->id_cols([sort $new->result_source->primary_columns]);
 134   }
 135
 136   return $new;
 137 }
 138
 139 =head2 display
 140
 141 =over 4
 142
 143 =item Arguments: none
 144
 145 =item Return Value: ArrayRef
 146
 147 =back
 148
 149  $arrayref_of_row_hashrefs = $rs->display();
 150
 151 This method uses L<DBIx::Class::ResultClass::HashRefInflator> to convert all
 152 rows in the ResultSet to HashRefs. Then the subrefs that were added via
 153 L</_with_meta_key> or L</_with_meta_hash> are run for each row and the
 154 resulting data merged with them.
 155
 156 =cut
 157
 158 method display () {
 159   my $rs = $self->search({});
 160 #  $rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
 161   $rs->result_class('DBIx::Class::WithMetaData::Inflator');
 162   my @rows;
 163   foreach my $row_rep ($rs->all) {
 164     # the custom inflator inflates to a arrayref with two versions of the row in it - hash and obj
 165     my ($row, $row_obj) = @{$row_rep};
 166     # THIS BLOCK IS DEPRECATED
 167     if (my $info = $self->row_info_for(id => $self->_mk_id(row => $row))) {
 168       $row = { %{$row}, %{$info} };
 169     }
 170
 171     foreach my $modifier (@{$rs->_hash_modifiers}) {
 172       my $row_hash = $modifier->($row);
 173       if (ref $row_hash ne 'HASH') {
 174         die 'modifier subref (added via build_metadata) did not return hashref';
 175       }
 176
 177       # simple merge for now, potentially needs to be more complex
 178       $row->{$_} = $row_hash->{$_} for keys %{$row_hash};
 179     }
 180
 181     foreach my $modifier (@{$rs->_object_hash_modifiers}) {
 182       my $row_hash = $modifier->($row, $row_obj);
 183       if (ref $row_hash ne 'HASH') {
 184         die 'modifier subref (added via build_metadata) did not return hashref';
 185       }
 186
 187       # simple merge for now, potentially needs to be more complex
 188       $row->{$_} = $row_hash->{$_} for keys %{$row_hash};
 189     }
 190
 191     foreach my $params (@{$rs->_key_modifiers}) {
 192       my $modifier = $params->{modifier};
 193       my $key = $params->{key};
 194
 195       if (my $val = $modifier->($row)) {
 196         $row->{$key} = $val;
 197       }
 198     }
 199
 200     foreach my $params (@{$rs->_object_key_modifiers}) {
 201       my $modifier = $params->{modifier};
 202       my $key = $params->{key};
 203
 204       if (my $val = $modifier->($row, $row_obj)) {
 205         $row->{$key} = $val;
 206       }
 207     }
 208     push(@rows, $row);
 209   }
 210
 211   return ($self->was_row) ? $rows[0] : \@rows;
 212 }
 213
 214 =head2 _with_meta_key
 215
 216 =over 4
 217
 218 =item Arguments: key_name => subref($row_hash)
 219
 220 =item Return Value: ResultSet
 221
 222 =back
 223
 224  $self->_with_meta_key( substr => sub ($row) {
 225    return substr(shift->{name}, 0, 3);
 226  });
 227
 228 This method allows you populate a certain key for each row hash at  L</display> time.
 229
 230 =cut
 231
 232 method _with_meta_key ($key, $modifier) {
 233   my $rs = $self->search({});
 234   unless ($key) {
 235     die 'build_metadata called without key';
 236   }
 237
 238   unless ($modifier && (ref $modifier eq 'CODE')) {
 239     die 'build_metadata called without modifier param';
 240   }
 241
 242   push( @{$rs->_key_modifiers}, { key => $key, modifier => $modifier });
 243   return $rs;
 244 }
 245
 246 =head2 _with_object_meta_key
 247
 248 =over 4
 249
 250 =item Arguments: key_name => subref($row_hash, $row_obj)
 251
 252 =item Return Value: ResultSet
 253
 254 =back
 255
 256  $self->_with_object_meta_key( substr => sub {
 257    my ($row_hash, $row_obj) = @_;
 258    return substr($row_obj->row_method, 0, 3);
 259  });
 260
 261 The same as L</_with_meta_key> but the subref gets the row object
 262 as well as the row hash. This should only be used when you need to
 263 access row methods as it's slower to inflate objects.
 264
 265 =cut
 266
 267 method _with_object_meta_key ($key, $modifier) {
 268   my $rs = $self->search({});
 269   unless ($key) {
 270     die '_with_object_meta_key called without key';
 271   }
 272
 273   unless ($modifier && (ref $modifier eq 'CODE')) {
 274     die '_with_object_meta_key called without modifier param';
 275   }
 276
 277   push( @{$rs->_object_key_modifiers}, { key => $key, modifier => $modifier });
 278   return $rs;
 279 }
 280
 281 =head2 _with_meta_hash
 282
 283 =over 4
 284
 285 =item Arguments: subref($row_hash)
 286
 287 =item Return Value: ResultSet
 288
 289 =back
 290
 291  $self->_with_meta_hash( sub ($row) {
 292    my $row = shift;
 293    my $return_hash = { substr => substr($row->{name}, 0, 3), substr2 => substr($row->{name}, 0, 4) };
 294    return $return_hash;
 295  });
 296
 297 Use this method when you want to populate multiple keys of the hash at the same time. If you just want to
 298 populate one key, use L</_with_meta_key>.
 299
 300 =cut
 301
 302 method _with_meta_hash ($modifier) {
 303   my $rs = $self->search({});
 304   unless ($modifier && (ref $modifier eq 'CODE')) {
 305     die 'build_metadata called without modifier param';
 306   }
 307
 308   push( @{$rs->_hash_modifiers}, $modifier );
 309   return $rs;
 310 }
 311
 312 =head2 _with_object_meta_hash
 313
 314 =over 4
 315
 316 =item Arguments: subref($row_hash, $row_object)
 317
 318 =item Return Value: ResultSet
 319
 320 =back
 321
 322  $self->_with_object_meta_hash( sub {
 323    my ($row_hash, $row_object) = @_;
 324
 325    my $return_hash = { substr => substr($row_object->name, 0, 3), substr2 => substr($row_hash->{name}, 0, 4) };
 326    return $return_hash;
 327  });
 328
 329 Like L</_with_meta_hash> but the subref gets the row object
 330 as well as the row hash. This should only be used when you need to
 331 access row methods as it's slower to inflate objects.
 332
 333 =cut
 334
 335 method _with_object_meta_hash ($modifier) {
 336   my $rs = $self->search({});
 337   unless ($modifier && (ref $modifier eq 'CODE')) {
 338     die 'build_metadata called without modifier param';
 339   }
 340
 341   push( @{$rs->_object_hash_modifiers}, $modifier );
 342   return $rs;
 343 }
 344
 345 =head2 add_row_info (DEPRECATED)
 346
 347 =over 4
 348
 349 =item Arguments: row => DBIx::Class::Row object, info => HashRef to attach to the row
 350
 351 =item Return Value: ResultSet
 352
 353 =back
 354
 355  $rs = $rs->add_row_info(row => $row, info => { dates => [qw/mon weds fri/] } );
 356
 357 DEPRECATED - this method is quite slow as it requires that you iterate through
 358 the resultset each time you want to add metadata. Replaced by L</build_metadata>.
 359
 360 =cut
 361
 362 method add_row_info (%opts) {
 363   my ($row, $id, $info) = map { $opts{$_} } qw/row id info/;
 364
 365   warn 'DEPRECATED - add_row_info is deprecated in favour of build_metadata';
 366   if ($row) {
 367     $id = $self->_mk_id(row => { $row->get_columns });
 368   }
 369
 370   unless ($row || $self->find($id)) {
 371     die 'invalid id passed to add_row_info';
 372   }
 373
 374   if (my $existing = $self->_row_info->{$id}) {
 375     $info = { %{$existing}, %{$info} };
 376   }
 377
 378   $self->_row_info->{$id} = $info;
 379 }
 380
 381 # DEPRECATED
 382 method row_info_for (%opts) {
 383   my $id = $opts{id};
 384   return $self->_row_info->{$id};
 385 }
 386
 387 # DEPRECATED
 388 method _mk_id (%opts) {
 389   my $row = $opts{row};
 390   return join('-', map { $row->{$_} } @{$self->id_cols});
 391 }
 392
 393 =head1 AUTHOR
 394
 395   Luke Saunders <luke.saunders@gmail.com>
 396
 397 =head1 THANKS
 398
 399 As usual, thanks to Matt S Trout for the sanity check.
 400
 401 =head1 LICENSE
 402
 403   This library is free software under the same license as perl itself
 404
 405 =cut
 406
 407 1;