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 =head1 VERSION
  27
  28 Version 0.999003
  29
  30 =cut
  31
  32 our $VERSION = '0.999003';
  33
  34 =head1 NAME
  35
  36 DBIx::Class::ResultSet::WithMetaData
  37
  38 =head1 SYNOPSIS
  39
  40   package MyApp::Schema::ResultSet::ObjectType;
  41
  42   use Moose;
  43   use MooseX::Method::Signatures;
  44   extends 'DBIx::Class::ResultSet::WithMetaData;
  45
  46   method with_substr () {
  47     foreach my $row ($self->all) {
  48       my $substr = substr($row->name, 0, 3);
  49       $self->add_row_info(row => $row, info => { substr => $substr });
  50     }
  51     return $self;
  52   }
  53
  54   ...
  55
  56
  57   # then somewhere else
  58
  59   my $object_type_arrayref = $object_type_rs->with_substr->display();
  60
  61   # [{
  62   #    'artistid' => '1',
  63   #    'name' => 'Caterwauler McCrae',
  64   #    'substr' => 'Cat'
  65   #  },
  66   #  {
  67   #    'artistid' => '2',
  68   #    'name' => 'Random Boy Band',
  69   #    'substr' => 'Ran'
  70   #  },
  71   #  {
  72   #    'artistid' => '3',
  73   #    'name' => 'We Are Goth',
  74   #    'substr' => 'We '
  75   #  }]
  76
  77 =head1 DESCRIPTION
  78
  79 Attach metadata to rows by chaining ResultSet methods together. When the ResultSet is
  80 flattened to an ArrayRef the attached metadata is merged with the row hashes to give
  81 a combined 'hash-plus-other-stuff' representation.
  82
  83 =head1 METHODS
  84
  85 =cut
  86
  87 sub new {
  88   my $self = shift;
  89
  90   my $new = $self->next::method(@_);
  91   foreach my $key (qw/_row_info was_row id_cols/) {
  92     alias $new->{$key} = $new->{attrs}{$key};
  93   }
  94
  95   unless ($new->_row_info) {
  96     $new->_row_info({});
  97   }
  98
  99   unless ($new->id_cols && scalar(@{$new->id_cols})) {
 100     $new->id_cols([sort $new->result_source->primary_columns]);
 101   }
 102
 103   return $new;
 104 }
 105
 106 =head2 display
 107
 108 =over 4
 109
 110 =item Arguments: none
 111
 112 =item Return Value: ArrayRef
 113
 114 =back
 115
 116  $arrayref_of_row_hashrefs = $rs->display();
 117
 118 This method uses L<DBIx::Class::ResultClass::HashRefInflator> to convert all
 119 rows in the ResultSet to HashRefs. These are then merged with any metadata
 120 that had been attached to the rows using L</add_row_info>.
 121
 122 =cut
 123
 124 method display () {
 125   my $rs = $self->search({});
 126   $rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
 127   my @rows;
 128   foreach my $row ($rs->all) {
 129     if (my $info = $self->row_info_for(id => $self->_mk_id(row => $row))) {
 130       $row = { %{$row}, %{$info} };
 131     }
 132     push(@rows, $row);
 133   }
 134
 135   return ($self->was_row) ? $rows[0] : \@rows;
 136 }
 137
 138 =head2 add_row_info
 139
 140 =over 4
 141
 142 =item Arguments: row => DBIx::Class::Row object, info => HashRef to attach to the row
 143
 144 =item Return Value: ResultSet
 145
 146 =back
 147
 148  $rs = $rs->add_row_info(row => $row, info => { dates => [qw/mon weds fri/] } );
 149
 150 This method allows you to attach a HashRef of metadata to a row which will be merged
 151 with that row when the ResultSet is flattened to a datastructure with L</display>.
 152
 153 =cut
 154
 155 method add_row_info (%opts) {
 156   my ($row, $id, $info) = map { $opts{$_} } qw/row id info/;
 157   if ($row) {
 158     $id = $self->_mk_id(row => { $row->get_columns });
 159   }
 160
 161   unless ($row || $self->find($id)) {
 162     die 'invalid id passed to add_row_info';
 163   }
 164
 165   if (my $existing = $self->_row_info->{$id}) {
 166     $info = { %{$existing}, %{$info} };
 167   }
 168
 169   $self->_row_info->{$id} = $info;
 170 }
 171
 172 method row_info_for (%opts) {
 173   my $id = $opts{id};
 174   return $self->_row_info->{$id};
 175 }
 176
 177 method _mk_id (%opts) {
 178   my $row = $opts{row};
 179   return join('-', map { $row->{$_} } @{$self->id_cols});
 180 }
 181
 182 =head1 AUTHOR
 183
 184   Luke Saunders <luke.saunders@gmail.com>
 185
 186 =head1 THANKS
 187
 188 As usual, thanks to Matt S Trout for the sanity check.
 189
 190 =head1 LICENSE
 191
 192   This library is free software under the same license as perl itself
 193
 194 =cut
 195
 196 1;