Class::DBI::Plugin::PseudoColumns - an interface to use some pseudo columns

Class-DBI-Plugin-PseudoColumns documentation Contained in the Class-DBI-Plugin-PseudoColumns distribution.

Index

Code Index:

NAME

Top

Class::DBI::Plugin::PseudoColumns - an interface to use some pseudo columns

SYNOPSIS

Top

 package Music::CD;
 use base 'Music::DBI';

 Music::CD->table('cd');
 Music::CD->columns(All => qw/cdid artist title year reldate properties/);
 use Class::DBI::Plugin::PseudoColumns;
 Music::CD->pseudo_columns(properties => qw/asin tag/);

 use Music::CD;
 my $cds = Music::CD->search(artist => 'Steve Vai');
 while (my $cd = $cds->next) {
     if ($cd->title =~ /^Real\s+Illusions/i) {
         $cd->asin('B0007GADZO');
     }
     $cd->tag(['rock', 'guitar', 'tricky play']);
     $cd->update;
 }

 my $bought_cd = Music::CD->create({
     artist  => 'Rolling Stones',
     title   => 'A Bigger Bang',
     year    => 2005,
     reldate => '2005-11-22',
     asin    => 'B000BP86LE',
     tag     => ['rock', 'blues', 'favorite'],
 });
 $bought_cd->set(
     artist => 'The Rolling Stones',
     title  => 'A Bigger Bang - Special Edition',
 );
 $bought_cd->update;

DESCRIPTION

Top

This module provides an easy way to use pseudo column in your Class::DBI based table classes. The ``pseudo column'' means a kind of column that is including an optical hashref string (via Data::Dumper, by default). You can get and set with using the pseudo column accessors (same as always). But, you can't use the columns' name into your SQL, SQL interfaced methods, ORDER BY clause and GROUP BY clause, etc. This module is useful when you'd like to add an unimportant column without issuing ALTER TABLE, and when you'd like to have related multiple data without normalizing table.

HOW TO USE

Top

Create a column

You should create a huge size column into your table. like this:

 CREATE TABLE cd (
   cdid int UNSIGNED auto_increment,
   artist varchar(255),
   title varchar(255),
   year int,
   reldate date,
   properties text, # create for using pseudo column
   PRIMARY KEY (cdid)
 );

Create a table class

Almost same as usual.

 package Music::CD;
 use base 'Music::DBI';

 Music::CD->table('cd');
 Music::CD->columns(All => qw/cdid artist title year reldate properties/);

Use it

You will be able to use pseudo column with only to use this module.

 use Class::DBI::Plugin::PseudoColumns;

Set your pseudo columns as your like

 Music::CD->pseudo_columns(properties => qw/asin tag/);

METHOD

Top

This module provides following class methods.

* create(\%data);

create method works almost same as Class::DBI::create() if there's some pseudo column in %data.

* set(column => value[, column2 => value2, ...]);

set method works almost same as Class::DBI::set() if there's some pseudo column in argument.

* pseudo_columns([parent_colname => ('pseudo_column1'[, 'pseudo_column2' ...])]);

You can set a pseudo columns' name with parent column's name. ``pseudo_column1'' ... will provide to you each pseudo column's accessor.

if you want to take a list of pseudo columns, you can pass one argument to this method when you want to specify grouped parent column name.

 my @p_columns = Music::CD->pseudo_columns('properties');

And if you want to take all columns list of pseudo columns, you don't need to pass any argument to this method.

 my @all_p_columns = Music::CD->pseudo_columns();
* serializer(parent_colname => \&serializer_sub);

You can set a specific serializing function for your pseudo columns.

 use Storable ();
 __PACKAGE__->serializer(properties => \&Storable::nfreeze);

The default serializer is Data::Dumper::Dumper (when you don't specify).

* deserializer(parent_coluname => \&deserializer_sub);

You can set a specific deserializing function for your pseudo columns.

 use Storable ();
 __PACKAGE__->deserializer(properties => \&Storable::thaw);

The default deserializer calls eval() (when you don't specify) for the dumped optical hashref string.

NOTE: The subref for serializer/deserializer must return a really ``storable'' string for your database. example of above works under a MySQL environment, but you have to change to use some another ``storable'' filter (like MIME::Base64) under SQLite environment (see t/05_serializer.t)

AUTHOR

Top

Koichi Taniguchi <taniguchi@livedoor.jp>

COPYRIGHT

Top

Copyright (c) 2006 Koichi Taniguchi. Japan. All rights reserved.

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

SEE ALSO

Top

Class::DBI, Data::Dumper

Class-DBI-Plugin-PseudoColumns documentation Contained in the Class-DBI-Plugin-PseudoColumns distribution. 
package Class::DBI::Plugin::PseudoColumns;

use strict;
use warnings;
use Carp;
use Data::Dumper ();
use vars qw($VERSION);
$VERSION = 0.03;

sub import {
    my $class = shift;
    my $pkg   = caller;

    return unless $pkg->isa('Class::DBI');
    if ($pkg->isa('Class::DBI')) {
        $pkg->mk_classdata('_p_column_groups');
        $pkg->mk_classdata('_serializer');
    }

    no strict 'refs';

    *{"$pkg\::pseudo_columns"} = sub {
        my $class = shift;
        croak "You must set table before call pseudo_columns()"
            unless defined $class->table;
        my $parent_column = shift;
        my $p_col_groups = $class->_p_column_groups;
        if (defined $_[0]) {
            my @colnames = @_;
            $p_col_groups->{$class}->{$parent_column} = \@colnames;
            $class->_p_column_groups($p_col_groups);
            for my $p_column (@colnames) {
                *{"$class\::$p_column"} = sub {
                    my $self = shift;
                    my $property = $self->__deserialize($parent_column);
                    if (@_) {
                        $property->{$p_column} = shift;
                        my $serialized =
                            $self->__serialize($parent_column => $property);
                        $self->$parent_column($serialized);
                    }
                    return $property->{$p_column};
                };
            }
        }
        elsif (defined $parent_column) {
            return unless ref($p_col_groups) eq 'HASH' &&
                ref($p_col_groups->{$class}) eq 'HASH' &&
                    ref($p_col_groups->{$class}->{$parent_column}) eq 'ARRAY';
            return @{$p_col_groups->{$class}->{$parent_column}};
        }
        else {
            return unless ref($p_col_groups) eq 'HASH' &&
                ref($p_col_groups->{$class}) eq 'HASH';
            my @pseudo_cols = ();
            for my $col (keys %{$p_col_groups->{$class}}) {
                next unless ref($p_col_groups->{$class}->{$col}) eq 'ARRAY';
                push @pseudo_cols, @{$p_col_groups->{$class}->{$col}};
            }
            return @pseudo_cols;
        }
    };

    my $super_create = $pkg->can('create');
    croak "create() method can not be called in $pkg" unless $super_create;
    *{"$pkg\::create"} = sub {
        my($class, $hashref) = @_;
        croak "create needs a hashref" unless ref($hashref) eq 'HASH';
        croak "You must set table before call create()"
            unless defined $class->table;
        my %cols_check = map { $_ => 1 } $class->pseudo_columns;
        my %p_values = ();
        for my $col (keys %$hashref) {
            next unless $cols_check{$col};
            $p_values{$col} = delete $hashref->{$col};
        }
        my $row = $class->$super_create($hashref); # create()
        if (%p_values) {
            for my $col (keys %p_values) {
                $row->$col($p_values{$col});
            }
            $row->update;
        }
        return $row;
    };

    my $super_set = $pkg->can('set');
    croak "set() method can not be called in $pkg" unless $super_set;
    *{"$pkg\::set"} = sub {
        my $self = shift;
        my $column_values = {@_};
        my $class = ref($self) || $self;
        my %cols_check = map { $_ => 1 } $class->pseudo_columns;
        my %p_values = ();
        for my $col (keys %$column_values) {
            next unless $cols_check{$col};
            $p_values{$col} = delete $column_values->{$col};
        }
        $self->$super_set(%$column_values) if %$column_values;
        if (%p_values) {
            for my $col (keys %p_values) {
                $self->$col($p_values{$col});
            }
        }
    };

    for my $export (qw(__serialize __deserialize serializer deserializer)) {
        *{"$pkg\::$export"} = \&$export;
    }
}

sub serializer {
    my($class, $parent_column, $subref) = @_;
    croak "You must set table before call serializer()"
        unless defined $class->table;
    my $serializer = $class->_serializer;
    if (ref($subref) eq 'CODE') {
        $serializer->{serializer} = { $parent_column => $subref };
        $class->_serializer($serializer);
    }
    else {
        carp "Usage: __PACKAGE__->serializer(parent_column => \$subref)";
    }
}

sub deserializer {
    my($class, $parent_column, $subref) = @_;
    croak "You must set table before call deserializer()"
        unless defined $class->table;
    my $serializer = $class->_serializer;
    if (ref($subref) eq 'CODE') {
        $serializer->{deserializer} = { $parent_column => $subref };
        $class->_serializer($serializer);
    }
    else {
        carp "Usage: __PACKAGE__->deserializer(parent_column => \$subref)";
    }
}

sub __serialize {
    my($self, $column, $var) = @_;
    my $class = ref($self) || $self;
    croak "Can't lookup the table name via table() method."
        unless defined $class->table;
    my $serializer = $class->_serializer;
    if (ref($serializer->{serializer}) eq 'HASH' &&
        exists $serializer->{serializer}->{$column} &&
            ref($serializer->{serializer}->{$column}) eq 'CODE') {
        return $serializer->{serializer}->{$column}->($var);
    }
    else {
        local $Data::Dumper::Terse  = 1;
        local $Data::Dumper::Indent = 0;
        return Data::Dumper::Dumper($var);
    }
}

sub __deserialize {
    my($self, $column) = @_;
    my $class = ref($self) || $self;
    croak "Can't lookup the table name via table() method."
        unless defined $class->table;
    my $prop;
    my $dumped = $self->$column;
    if (defined $dumped) {
        my $serializer = $class->_serializer;
        if (ref($serializer->{deserializer}) eq 'HASH' &&
            exists $serializer->{deserializer}->{$column} &&
                ref($serializer->{deserializer}->{$column}) eq 'CODE') {
            $prop = $serializer->{deserializer}->{$column}->($dumped);
        }
        else {
            $prop = eval qq{ $dumped };
        }
    }
    return $prop if defined $prop && ref($prop) eq 'HASH';
    return {};
}

1;

__END__