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.999001
  29
  30 =cut
  31
  32 our $VERSION = '0.999001';
  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->limit(count => 3)->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   unless ($self->find($id)) {
 161     die 'invalid id passed to add_row_info';
 162   }
 163
 164   if (my $existing = $self->_row_info->{$id}) {
 165     $info = { %{$existing}, %{$info} };
 166   }
 167
 168   $self->_row_info->{$id} = $info;
 169 }
 170
 171 method row_info_for (%opts) {
 172   my $id = $opts{id};
 173   return $self->_row_info->{$id};
 174 }
 175
 176 =head2 order_by (EXPERIMENTAL)
 177
 178 =over 4
 179
 180 =item Arguments: col => $column_name
 181
 182 =item Return Value: ResultSet
 183
 184 =back
 185
 186  $ordered_rs = $rs->order_by(col => 'name');
 187
 188 Convenience method. Essentually a shortcut for $rs->search({}, { order_by => $col }).
 189
 190 =cut
 191
 192 method order_by (%opts) {
 193   my $col = $opts{col};
 194   $col = "me.$col" unless ($col =~ m/\./);
 195   return $self->search({}, { order_by => $col });
 196 }
 197
 198 =head2 limit (EXPERIMENTAL)
 199
 200 =over 4
 201
 202 =item Arguments: count => Int
 203
 204 =item Return Value: ResultSet
 205
 206 =back
 207
 208  $limitted_rs = $rs->limit(count => 3);
 209
 210 Convenience method. Essentually a shortcut for $rs->search({}, { rows => $count }).
 211
 212 =cut
 213
 214 method limit (%opts) {
 215   my $count = $opts{count};
 216   return $self->search({}, { rows => $count });
 217 }
 218
 219 method _mk_id (%opts) {
 220   my $row = $opts{row};
 221   return join('-', map { $row->{$_} } @{$self->id_cols});
 222 }
 223
 224 =head1 AUTHOR
 225
 226   Luke Saunders <luke.saunders@gmail.com>
 227
 228 =head1 THANKS
 229
 230 As usual, thanks to Matt S Trout for the sanity check.
 231
 232 =head1 LICENSE
 233
 234   This library is free software under the same license as perl itself
 235
 236 =cut
 237
 238 1;