From: Johannes Plunien <plu@cpan.org>
Date: Sun, 14 Jun 2009 12:47:38 +0000 (+0000)
Subject: Added patch by rbo: New method hashref_pk: Calls hashref_array and returns a referenc... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=698b98d027c36b44ec4e6c8b9065b6b95386bd61;p=dbsrgits%2FDBIx-Class-ResultSet-HashRef.git

Added patch by rbo: New method hashref_pk: Calls hashref_array and returns a reference to a hash containing the primary key
---

diff --git a/README b/README
index f81b64f..e7d80b7 100644
--- a/README
+++ b/README
@@ -50,6 +50,15 @@ METHODS
         my $first_row = $schema->resultset('User')->search( { } )->hashref_first;
         print Dumper $first_row
 
+  hashref_pk( )
+    Calls hashref_array and returns a reference to a hash containing the
+    primary key. For each key the corresponding value is a reference to a
+    hash of the resultset inflated by
+    DBIx::Class::ResultClass::HashRefInflator.
+
+        my $hashref_pk = $schema->resultset('User')->search( { } )->hashref_pk;
+        print Dumper $hashref_pk
+
 AUTHOR
     Johannes Plunien <plu@cpan.org>
 
diff --git a/lib/DBIx/Class/ResultSet/HashRef.pm b/lib/DBIx/Class/ResultSet/HashRef.pm
index 17dabe0..0f26f48 100644
--- a/lib/DBIx/Class/ResultSet/HashRef.pm
+++ b/lib/DBIx/Class/ResultSet/HashRef.pm
@@ -2,6 +2,7 @@ package DBIx::Class::ResultSet::HashRef;
 
 use warnings;
 use strict;
+use Carp;
 use base qw( DBIx::Class::ResultSet );
 use DBIx::Class::ResultClass::HashRefInflator;
 
@@ -83,6 +84,26 @@ sub hashref_first {
     return shift->hashref_rs->first;
 }
 
+=head2 hashref_pk( )
+
+Calls hashref_array and returns a reference to a hash containing the primary key. For each key the corresponding value is a reference to a hash of the resultset inflated by L<DBIx::Class::ResultClass::HashRefInflator>.
+
+    my $hashref_pk = $schema->resultset('User')->search( { } )->hashref_pk;
+    print Dumper $hashref_pk
+
+=cut
+
+sub hashref_pk{
+    my $self = shift;
+    my @primary_columns = $self->result_source->primary_columns;
+    croak "Multi-column primary keys are not supported." if (scalar @primary_columns > 1 );
+    croak "No primary key found." if (scalar @primary_columns == 0 );
+    my $primary_key = shift @primary_columns;
+    my %hash_pk = ();
+    %hash_pk = map { $_->{$primary_key} => $_ } $self->hashref_array;
+    return wantarray ? %hash_pk : \%hash_pk ;
+}
+
 =head1 AUTHOR
 
 Johannes Plunien E<lt>plu@cpan.orgE<gt>
diff --git a/t/10-hashref.t b/t/10-hashref.t
index b1ebe9b..90b1083 100644
--- a/t/10-hashref.t
+++ b/t/10-hashref.t
@@ -10,7 +10,7 @@ BEGIN {
     eval "use SQL::Translator ();";
     plan skip_all => 'SQL::Translator required to run this test' if $@;
 
-    plan( tests => 10 );
+    plan( tests => 11 );
 }
 
 use lib 't/lib';
@@ -312,3 +312,37 @@ foreach my $user (@users) {
         "hashref_first"
     );
 }
+
+{
+    my $hashref = $schema->resultset('User')->search( {}, { order_by => 'me.id ASC' } )->hashref_pk;
+    is_deeply(
+        $hashref,
+        {
+            1 => {
+                'id'    => '1',
+                'login' => 'root'
+            },
+            2 => {
+                'id'    => '2',
+                'login' => 'toor'
+            },
+            3 => {
+                'id'    => '3',
+                'login' => 'daemon'
+            },
+            4 => {
+                'id'    => '4',
+                'login' => 'operator'
+            },
+            5 => {
+                'id'    => '5',
+                'login' => 'bin'
+            },
+            6 => {
+                'id'    => '6',
+                'login' => 'tty'
+            }
+        },
+        'hashref_pk'
+    );
+}