SPOPS::Tool::DBI::DiscoverField - SPOPS::ClassFactory rule implementing autofield discovery

SPOPS documentation Contained in the SPOPS distribution.

Index

Code Index:

NAME

Top

SPOPS::Tool::DBI::DiscoverField - SPOPS::ClassFactory rule implementing autofield discovery

SYNOPSIS

Top

  my $config = {
        myobject => { class          => 'My::Object',
                      isa            => [ 'SPOPS::DBI' ],
                      field          => [], # just for show...
                      rules_from     => [ 'My::DiscoverField' ],
                      field_discover => 'yes',
                      base_table     => 'mydata',
                      ...  },
  };
  my $class_list = SPOPS::Initialize->process({ config => $config });

  # All fields in 'mydata' table now available as object properties

DESCRIPTION

Top

Simple behavior rule to dynamically find all fields in a particular database table and set them in our object.

Configuration is easy, just put:

 rules_from => [ 'My::DiscoverField' ],

in your object configuration, or add 'My::DiscoverField' to an already-existing 'rules_from' list. Then add:

 field_discover => 'yes',

to your object configuration. Initialize the class and everything in 'field' will be overwritten.

GOTCHAS

Top

These fields are only discovered once, when the class is created. If you modify the schema of a table (such as with an 'ALTER TABLE' statement while a process (like a webserver) is running with SPOPS definitions the field modifications will not be reflected in the object class definition. (This is actually true of all SPOPS::DBI objects, but probably more apt to pop up here.)

COPYRIGHT

Top

Copyright (c) 2001-2004 intes.net, inc.. All rights reserved.

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

AUTHORS

Top

Chris Winters <chris@cwinters.com>

SPOPS documentation Contained in the SPOPS distribution. 
package SPOPS::Tool::DBI::DiscoverField;

# $Id: DiscoverField.pm,v 3.6 2004/06/02 00:48:24 lachoy Exp $

use strict;
use Log::Log4perl qw( get_logger );
use SPOPS;
use SPOPS::ClassFactory qw( ERROR OK NOTIFY );

my $log = get_logger();

$SPOPS::Tool::DBI::DiscoverField::VERSION = sprintf("%d.%02d", q$Revision: 3.6 $ =~ /(\d+)\.(\d+)/);

sub behavior_factory {
    my ( $class ) = @_;
    $log->is_info &&
        $log->info( "Installing field discovery for ($class)" );
    return { manipulate_configuration => \&discover_fields };
}

sub discover_fields {
    my ( $class ) = @_;
    my $CONFIG = $class->CONFIG;
    return ( OK, undef ) unless ( $CONFIG->{field_discover} eq 'yes' );
    my $dbh = $class->global_datasource_handle( $CONFIG->{datasource} );
    unless ( $dbh ) {
        $CONFIG->{field}      = undef;
        $CONFIG->{field_list} = undef;
        return ( NOTIFY, "Cannot discover fields because no DBI database " .
                         "handle available to class ($class)" );
    }
    my $sql = $class->sql_fetch_types( $CONFIG->{base_table} );
    my ( $sth );
    eval {
        $sth = $dbh->prepare( $sql );
        $sth->execute;
    };
    if ( $@ ) {
        $CONFIG->{field} = undef;
        return ( NOTIFY, "Cannot discover fields: $@" );
    }
    $CONFIG->{field}     = [ map { lc $_ } @{ $sth->{NAME} } ];
    $CONFIG->{field_raw} = [ @{ $sth->{NAME} } ];
    $log->is_info &&
        $log->info( "Table: ($CONFIG->{base_table}); ",
			          "Fields: (", join( ', ', @{ $CONFIG->{field} } ), ")" );
    return ( OK, undef );
}

1;

__END__