File Coverage

blib/lib/CGI/Application/Plugin/DBIC/Schema.pm

Criterion	Covered	Total	%
statement	12	50	24.0
branch	0	26	0.0
condition	0	10	0.0
subroutine	4	7	57.1
pod	3	3	100.0
total	19	96	19.7

package CGI::Application::Plugin::DBIC::Schema;

use strict;
use vars qw($VERSION @ISA  @EXPORT_OK);
use Carp;
require Exporter;
@ISA = qw(Exporter);

# "Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants."
# -- quote from M. Stosberg in ::Plugin::DBH
@EXPORT_OK = qw(
  schema
  dbic_config
  resultset
  rs
);

$VERSION = '0.3';

#
# This name will be used for 'default' schema (i.e., when no name is supplied.)
#
use constant DEFAULT_CONFIG_NAME => "__cgi_application_plugin_dbic_schema";

sub schema {
    my $self = shift;
    my $name = shift;

    # Establish a default config name for the cgi::app
    $self->{__DBIC_SCHEMA_DEFAULT_NAME} ||= DEFAULT_CONFIG_NAME;

    # Use the default name if no  name was supplied.
    $name ||= $self->{__DBIC_SCHEMA_DEFAULT_NAME};    # Unamed handle case.

    croak "must call dbic_config() before calling schema()."
      unless $self->{__DBIC_SCHEMA_CONFIG}{$name};

    unless ( defined( $self->{__DBIC_SCHEMA}{$name} ) ) {
        my $schema = $self->{__DBIC_SCHEMA_CONFIG}{$name}->{schema};

        #TODO Allow use of a DBI handle in place of a config
        my @con_info = @{ $self->{__DBIC_SCHEMA_CONFIG}{$name}->{connect_info} };
        eval { "require $schema;" } or die "Cannot require $schema: $@";
        $self->{__DBIC_SCHEMA}{$name} = $schema->connect(@con_info);
    }

    return $self->{__DBIC_SCHEMA}{$name};
}

sub dbic_config {
    my $self = shift;

    croak "too many parameters passed to dbic_config." if ( @_ > 2 );
    my ( $name, $config );
    if ( @_ == 2 ) {
        ( $name, $config ) = @_;
    }
    elsif ( @_ == 1 ) {
        $config = shift;
    }
    else {
        croak "no config passed to dbic_config";
    }

    # TODO Allow config to  be a DBI::db handle as alternative
    croak "config must be hashref" unless ref $config eq 'HASH';

    $self->{__DBIC_SCHEMA_DEFAULT_NAME} ||= DEFAULT_CONFIG_NAME;    # First use case.
    $name ||= $self->{__DBIC_SCHEMA_DEFAULT_NAME};    # Unamed handle case.

    croak "Calling dbic_config after the dbic has already been created"
      if ( defined $self->{__DBIC_SCHEMA}{$name} );

    $self->{__DBIC_SCHEMA_CONFIG}{$name} = $config;

}

sub resultset {
    my $c = shift;

    my $param_count = scalar(@_);
    croak "Too many parameters passed to resultset" if ( $param_count > 2 );
    croak "Too few parameters passed to resultset"  if ( $param_count == 0 );

    my ( $config_name, $resultset_name, $result );
    if ( $param_count == 2 ) {
        ( $config_name, $resultset_name ) = @_;

        # allow undef config name (use default), but require result class name
        croak "resultset class name must be defined"
          if ( !defined($resultset_name) );

        $result = $c->schema($config_name)->resultset($resultset_name);
    }
    else {
        $resultset_name = shift;
        croak "resultset class name must be defined"
          if ( !defined($resultset_name) );
        $result = $c->schema()->resultset($resultset_name);
    }
    return $result;
}

# short form
*rs = \&resultset;

1;
__END__