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 =head1 VERSION
  37
  38 Version 1.000001
  39
  40 =cut
  41
  42 our $VERSION = '1.000001';
  43
  44 =head1 NAME
  45
  46 DBIx::Class::ResultSet::WithMetaData
  47
  48 =head1 SYNOPSIS
  49
  50   package MyApp::Schema::ResultSet::ObjectType;
  51
  52   use Moose;
  53   use MooseX::Method::Signatures;
  54   extends 'DBIx::Class::ResultSet::WithMetaData;
  55
  56   method with_substr () {
  57     return $self->_with_meta_key(
  58       substr => sub {
  59         return substr(shift->{name}, 0, 3);
  60       }
  61     );
  62   }
  63
  64   ...
  65
  66
  67   # then somewhere else
  68
  69   my $object_type_arrayref = $object_type_rs->with_substr->display();
  70
  71   # [{
  72   #    'artistid' => '1',
  73   #    'name' => 'Caterwauler McCrae',
  74   #    'substr' => 'Cat'
  75   #  },
  76   #  {
  77   #    'artistid' => '2',
  78   #    'name' => 'Random Boy Band',
  79   #    'substr' => 'Ran'
  80   #  },
  81   #  {
  82   #    'artistid' => '3',
  83   #    'name' => 'We Are Goth',
  84   #    'substr' => 'We '
  85   #  }]
  86
  87 =head1 DESCRIPTION
  88
  89 Attach metadata to rows by chaining ResultSet methods together. When the ResultSet is
  90 flattened to an ArrayRef the attached metadata is merged with the row hashes to give
  91 a combined 'hash-plus-other-stuff' representation.
  92
  93 =head1 METHODS
  94
  95 =cut
  96
  97 sub new {
  98   my $self = shift;
  99
 100   my $new = $self->next::method(@_);
 101   foreach my $key (qw/_row_info was_row id_cols _key_modifiers _hash_modifiers/) {
 102     alias $new->{$key} = $new->{attrs}{$key};
 103   }
 104
 105   unless ($new->_row_info) {
 106     $new->_row_info({});
 107   }
 108
 109   unless ($new->_key_modifiers) {
 110     $new->_key_modifiers([]);
 111   }
 112   unless ($new->_hash_modifiers) {
 113     $new->_hash_modifiers([]);
 114   }
 115
 116   unless ($new->id_cols && scalar(@{$new->id_cols})) {
 117     $new->id_cols([sort $new->result_source->primary_columns]);
 118   }
 119
 120   return $new;
 121 }
 122
 123 =head2 display
 124
 125 =over 4
 126
 127 =item Arguments: none
 128
 129 =item Return Value: ArrayRef
 130
 131 =back
 132
 133  $arrayref_of_row_hashrefs = $rs->display();
 134
 135 This method uses L<DBIx::Class::ResultClass::HashRefInflator> to convert all
 136 rows in the ResultSet to HashRefs. These are then merged with any metadata
 137 that had been attached to the rows using L</add_row_info>.
 138
 139 =cut
 140
 141 method display () {
 142   my $rs = $self->search({});
 143   $rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
 144   my @rows;
 145   foreach my $row ($rs->all) {
 146     # THIS BLOCK IS DEPRECATED
 147     if (my $info = $self->row_info_for(id => $self->_mk_id(row => $row))) {
 148       $row = { %{$row}, %{$info} };
 149     }
 150
 151     foreach my $modifier (@{$rs->_hash_modifiers}) {
 152       my $row_hash = $modifier->($row);
 153       if (ref $row_hash ne 'HASH') {
 154         die 'modifier subref (added via build_metadata) did not return hashref';
 155       }
 156
 157       # simple merge for now, potentially needs to be more complex
 158       $row->{$_} = $row_hash->{$_} for keys %{$row_hash};
 159     }
 160
 161     foreach my $params (@{$rs->_key_modifiers}) {
 162       my $modifier = $params->{modifier};
 163       my $key = $params->{key};
 164
 165       if (my $val = $modifier->($row)) {
 166         $row->{$key} = $val;
 167       }
 168     }
 169     push(@rows, $row);
 170   }
 171
 172   return ($self->was_row) ? $rows[0] : \@rows;
 173 }
 174
 175 =head2 _with_meta_key
 176
 177 =over 4
 178
 179 =item Arguments: key_name => subref($row_hash)
 180
 181 =item Return Value: ResultSet
 182
 183 =back
 184
 185  $self->_with_meta_key( substr => sub ($row) {
 186    return substr(shift->{name}, 0, 3);
 187  });
 188
 189 This method allows you populate a certain key for each row hash at  L</display> time.
 190
 191 =cut
 192
 193 method _with_meta_key ($key, $modifier) {
 194   my $rs = $self->search({});
 195   unless ($key) {
 196     die 'build_metadata called without key';
 197   }
 198
 199   unless ($modifier && (ref $modifier eq 'CODE')) {
 200     die 'build_metadata called without modifier param';
 201   }
 202
 203   push( @{$rs->_key_modifiers}, { key => $key, modifier => $modifier });
 204   return $rs;
 205 }
 206
 207 =head2 _with_meta_hash
 208
 209 =over 4
 210
 211 =item Arguments: subref($row_hash)
 212
 213 =item Return Value: ResultSet
 214
 215 =back
 216
 217  $self->_with_meta_hash( sub ($row) {
 218    my $row = shift;
 219    my $return_hash = { substr => substr($row->{name}, 0, 3), substr2 => substr($row->{name}, 0, 4) };
 220    return $return_hash;
 221  });
 222
 223 Use this method when you want to populate multiple keys of the hash at the same time. If you just want to
 224 populate one key, use L</_with_meta_key>.
 225
 226 =cut
 227
 228 method _with_meta_hash ($modifier) {
 229   my $rs = $self->search({});
 230   unless ($modifier && (ref $modifier eq 'CODE')) {
 231     die 'build_metadata called without modifier param';
 232   }
 233
 234   push( @{$rs->_hash_modifiers}, $modifier );
 235   return $rs;
 236 }
 237
 238 =head2 add_row_info (DEPRECATED)
 239
 240 =over 4
 241
 242 =item Arguments: row => DBIx::Class::Row object, info => HashRef to attach to the row
 243
 244 =item Return Value: ResultSet
 245
 246 =back
 247
 248  $rs = $rs->add_row_info(row => $row, info => { dates => [qw/mon weds fri/] } );
 249
 250 DEPRECATED - this method is quite slow as it requires that you iterate through
 251 the resultset each time you want to add metadata. Replaced by L</build_metadata>.
 252
 253 =cut
 254
 255 method add_row_info (%opts) {
 256   my ($row, $id, $info) = map { $opts{$_} } qw/row id info/;
 257
 258   warn 'DEPRECATED - add_row_info is deprecated in favour of build_metadata';
 259   if ($row) {
 260     $id = $self->_mk_id(row => { $row->get_columns });
 261   }
 262
 263   unless ($row || $self->find($id)) {
 264     die 'invalid id passed to add_row_info';
 265   }
 266
 267   if (my $existing = $self->_row_info->{$id}) {
 268     $info = { %{$existing}, %{$info} };
 269   }
 270
 271   $self->_row_info->{$id} = $info;
 272 }
 273
 274 # DEPRECATED
 275 method row_info_for (%opts) {
 276   my $id = $opts{id};
 277   return $self->_row_info->{$id};
 278 }
 279
 280 # DEPRECATED
 281 method _mk_id (%opts) {
 282   my $row = $opts{row};
 283   return join('-', map { $row->{$_} } @{$self->id_cols});
 284 }
 285
 286 =head1 AUTHOR
 287
 288   Luke Saunders <luke.saunders@gmail.com>
 289
 290 =head1 THANKS
 291
 292 As usual, thanks to Matt S Trout for the sanity check.
 293
 294 =head1 LICENSE
 295
 296   This library is free software under the same license as perl itself
 297
 298 =cut
 299
 300 1;