DBIx-Class-SingletonRows

 view release on metacpan or  search on metacpan

lib/DBIx/Class/SingletonRows.pm  view on Meta::CPAN

# $Id: SingletonRows.pm,v 1.10 2008-06-25 14:39:08 cantrelld Exp $

package DBIx::Class::SingletonRows;

use strict;
use warnings;

use Digest::MD5 qw(md5_hex);
use Scalar::Util qw(refaddr);

use base qw(DBIx::Class);

use vars qw(
    $VERSION
    $cache
);

=head1 NAME

DBIx::Class::SingletonRows - make database rows returned by DBIx::Class
into singletons

=head1 DESCRIPTION

When you do this with DBIx::Class:

    my $row = $schema->...

    my $row2 = update_and_return();

    sub update_and_return {
        my $row = $schema->...
        $row->somefield("HLAGH");
        $row->update();
        return $row;
    }

then even if both C<$row> and C<$row2> have the same row_id, they'll have
different values for C<somefield>.  This irritates me, so this mixin fixes it.

=head1 SYNOPSIS

When creating the class that respresents your table, load the 'SingletonRows'
component thus.  Make sure to load it before you load the 'Core' component:

    package MyProject::DB::Employee;

    use base qw(DBIx::Class);

    __PACKAGE__->load_components(qw(SingletonRows Core));

    __PACKAGE__->table('employees');
    ...

=head1 METHODS

It wraps around C<DBIx::Class::Row>'s C<inflate_result()> method so that it
always returns singletons.

=head1 BUGS and WARNINGS

This should be considered to be pre-production code.  It's probably chock
full of exciting data-eating bugs.

=head1 AUTHOR, COPYRIGHT and LICENCE

Written by David Cantrell E<lt>david@cantrell.org.ukE<gt>

Copyright 2008 Outcome Technologies Ltd

This software is free-as-in-speech software, and may be used, distributed,
and modified under the terms of either the GNU General Public Licence
version 2 or the Artistic Licence. It's up to you which one you use. The
full text of the licences can be found in the files GPL2.txt and
ARTISTIC.txt, respectively.

=cut

$VERSION = '0.11';

sub inflate_result {
    my $self = shift;
    my $row = $self->next::method(@_);
    my $key = join(',', refaddr($row->result_source()->schema()), map { md5_hex($_) } $row->id());
    my $class = ref($row);
    $cache->{$class} ||= {};

    $cache->{$class}->{$key} = $row
        if(!exists($cache->{$class}->{$key}));

    $cache->{$class}->{$key}->{_DCS_refcount} += 1;



( run in 0.861 second using v1.01-cache-2.11-cpan-d7f47b0818f )