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