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