package Egg::Model::DBIC;
#
# Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
#
# $Id: DBIC.pm 324 2008-04-17 12:45:09Z lushe $
#
use strict;
use warnings;

our $VERSION = '3.01';

sub _setup {
	my($class, $e)= @_;
	Egg::Model::DBIC::handler->_setup($e);
	$class->next::method($e);
}

package Egg::Model::DBIC::handler;
use strict;
use UNIVERSAL::require;
use base qw/ Egg::Model /;
use Carp qw/ croak /;

sub _setup {
	my($class, $e)= @_;
	my $dbic_path= $e->path_to(qw{ lib_project Model/DBIC });
	-e $dbic_path || die __PACKAGE__. qq{ - '${dbic_path}'is not found. };
	my $schemas= $e->ixhash;
	no strict 'refs';  ## no critic.
	no warnings 'redefine';
	for (sort (grep /\.pm$/, <$dbic_path/*>)) {  ## no critic.
		m{([^\\\/\:]+)\.pm$} || next;
		my $pkg = $e->project_name. "::Model::DBIC::$1";
		my $name= lc $1;
		$pkg->require or die $@;
		my $c= $pkg->config || die __PACKAGE__. qq{ - '$pkg' config is empty. };
		$c->{dsn} || die __PACKAGE__. q{ - '$pkg' dsn is empty. };
		$c->{user}     ||= "";
		$c->{password} ||= "";
		$c->{options}  ||= {};
		my $label= lc( $c->{label_name} || "dbic::$name" );
		my $alias= $c->{label_source} || $c->{label_moniker} || {};
		   $alias= { map{ lc($_) => $alias->{$_} }keys %$alias };
		$e->model_manager->add_register(0, $label, $pkg);
		*{"${pkg}::new"}= $class->_mk_schema_closure
		     ($pkg, @{$c}{qw{ dsn user password options }});
		my $schema= $pkg->new
		     || die qq{ Schema of '$pkg' cannot be connected. };
		for my $moniker ($schema->sources) {
			my $m_class= "${pkg}::$moniker";
			my $m_label= $alias->{lc $moniker} || "${label}::$moniker";
			$e->model_manager->add_register(0, $m_label, $m_class);
			*{"${m_class}::ACCEPT_CONTEXT"}=
			    sub { $_[1]->model($label)->resultset($moniker) };
		}
		$schemas->{$label}= $pkg;
	}
	%$schemas or die __PACKAGE__. q{ - Schema module is not found. };
	$e->global->{dbic_schemas}= $schemas;
	@_;
}
sub _mk_schema_closure {
	my($class, $s_class, @source)= @_;
	my $schema;
	sub {
		return $schema if ( $schema
		  and $schema->storage->dbh->{Active}
		  and $schema->storage->dbh->ping
		  );
		$schema= $s_class->connect(@source);
	 };
}

1;

__END__

=head1 NAME

Egg::Model::DBIC - Model for DBIx::Class. 

=head1 SYNOPSIS

  my $schema= $e->model('dbic::myschema');
  
  # If the transaction is effective.
  $schema->storage->txn_begin;
  
  my $table= $schema->resultset('hoge_master');
     Or
  my $table= $e->model('dbic::myschema::hoge_master');
  
  $table->search( ... );
  
  # And.
  $schema->storage->txn_rollback;
     Or
  $schema->storage->txn_commit;

=head1 DESCRIPTION

It is MODEL to use L<DBIx::Class>.

A series of Schema module is generated by using the helper for use.

  % cd /path/to/MyApp/bin
  % ./myapp_helper.pl M::DBIC [SCHEMA_NAME] -d dbi:SQLite:dbname=dbfile -u user -p passwd

The name that can be used as Perl module name in the part of SCHEMA_NAME is 
passed.

The option to continue is not indispensable.

Details are L<Egg::Helper::Model::DBIC>. Please drink and refer to the document.

And, 'DBIC' is added to the MODEL setting of the project.

  % vi /path/to/MyApp/lib/MyApp/config.pm
  ..........
  ...
  MODEL => ['DBIC'],

Using this model by this becomes possible.

When the object of Schema is acquired from the application, as follows is done.

  my $schema= $e->model('dbic::schema_name');

The object to which L<DBIx::Class::Schema> is succeeded to by this can be 
received.

And, the object of the table does as follows.

  my $table = $e->model('dbic::schema_name::table_name');
  
  # If you have already acquired the Schema object.
  my $table = $schema->resultset('table_name');

The object to which L<DBIx::Class::ResultSet> is succeeded to by this can be 
received.

=head1 SEE ALSO

L<Egg::Release>,
L<Egg::Model>,
L<Egg::Model::DBIC::Base>,
L<Egg::Helper::Model::DBIC>,
L<DBIx::Class>,
L<DBIx::Class::Schema>,
L<DBIx::Class::ResultSet>,
L<UNIVERSAL::require>,

=head1 AUTHOR

Masatoshi Mizuno, E<lt>lusheE<64>cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008 Bee Flag, Corp. E<lt>L<http://egg.bomcity.com/>E<gt>, All Rights Reserved.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.6 or,
at your option, any later version of Perl 5 you may have available.

=cut