package Egg::Model::Session::Base::DBIC;
#
# Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
#
# $Id: DBIC.pm 256 2008-02-14 21:07:38Z lushe $
#
use strict;
use warnings;
use Carp qw/ croak /;
use Time::Piece::MySQL;

sub _setup {
	my($class, $e)= @_;
	my $c= $class->config->{dbic} ||= {};
	my $idcol  = $c->{id_field}   || 'id';
	my $datacol= $c->{data_field} || 'a_session';
	my $timecol= $c->{time_field} || 'lastmod';
	my $moniker= $c->{label_source} || die q{I want setup 'label_source'.};
	$e->is_model($c->{label_source})
	          || die qq{'$c->{label_source}' model is not found.};
	my $s_label= $c->{label_schema} || die q{I want setup 'label_schema'.};
	my $project= $e->project_name;
	no strict 'refs';  ## no critic.
	no warnings 'redefine';
	if ($e->isa('Egg::Plugin::DBIC')) {
		$e->is_model($s_label) || die qq{'$s_label' model is not found.};
		my $s_name= $s_label=~m{^dbic\:+(.+)} ? $1: $s_label;
		*{"${class}::_begin"}= sub {
			&{"${project}::begin_$s_name"}($_[0]->e);
		  };
		*{"${class}::_commit"}= sub {
			&{"${project}::commit_ok"}($_[0]->e, $s_name, 1) if $_[1];
		  };
	} else {
		my $schema= $e->model($s_label)
		    || die qq{'$s_label' model is not found.};
		if ($schema->storage->dbh->{AutoCommit}) {
			*{"${class}::_begin"} = sub { $_[0]->e->model($s_label) };
			*{"${class}::_commit"}= sub { 1 };
		} else {
			*{"${class}::_begin"}= sub {
				my $context= $_[0]->e->model($s_label);
				$context->txn_begin;
				$context;
			  };
			*{"${class}::_commit"}= sub {
				$_[1] ? $_[0]->_schema->txn_commit
				      : $_[0]->_schema->txn_rollback;
			  };
		}
	}
	*{"${class}::moniker"}= sub {
		$_[0]->attr->{dbic_moniker} ||= $_[0]->e->model($moniker);
	  };
	*{"${class}::result"}= sub {
		my $self= shift;
		return ($self->attr->{result} || 0) unless @_;
		$self->attr->{result}= shift;
	  };
	*{"${class}::id_col"}   = sub { $idcol   };
	*{"${class}::data_col"} = sub { $datacol };
	*{"${class}::time_col"} = sub { $timecol };
	$class->next::method($e);
}
sub restore {
	my $self= shift;
	my $id  = shift || $self->session_id || croak q{I want session id.};
	my $result = $self->moniker->find($id) || return 0;
	my $datacol= $self->data_col;
	\$self->result($result)->$datacol;
}
sub insert {
	my $self= shift;
	my $data= shift || croak q{I want session data.};
	my $id  = shift || $self->session_id || croak q{I want session id.};
#	$self->result(undef) if $self->result;
	$self->moniker->create({
	  $self->id_col   => $id,
	  $self->data_col => $$data,
	  $self->time_col => localtime(time)->mysql_datetime,
	  });
}
sub update {
	my $self= shift;
	my $data= shift || croak q{I want session data.};
	my $id  = shift || $self->session_id || croak q{I want session id.};
	return $self->insert($data, $id) unless $self->result;
	my($datacol, $timecol)= ($self->data_col, $self->time_col);
	$self->result->$timecol( localtime(time)->mysql_datetime );
	$self->result->$datacol( $$data );
	$self->result->update;
}
sub close {
	my($self)= @_;
	my $update_ok= $self->is_update;
	$self->next::method;
	$self->_commit($update_ok);
	$self;
}

1;

__END__

=head1 NAME

Egg::Model::Session::Base::DBIC - Session management by DBIC.

=head1 SYNOPSIS

  package MyApp::Model::Sesion;
  
  __PACKAGE__->config(
   dbic => {
     label_schema  => 'dbic_schma_label',
     label_source  => 'dbic_moniker_label',
     id_field      => 'id',
     data_field    => 'a_session',
     time_field    => 'lastmod',
     },
   );
  
  __PACKAGE__->startup(
   Base::DBIC
   Store::Base64
   ID::SHA1
   Bind::Cookie
   );

=head1 DESCRIPTION

The session data is preserved by using DBIC.

'L<Egg::Model::DBIC>' should be able to be used for use.

And, 'Base::DBIC' is added to startup of the component module generated with 
L<Egg::Helper::Model::Session>. Base::FileCache of default's It is not possible
to cooperate and delete it, please.

Moreover, it is necessary to load Store system module to treat the session data 
appropriately.

  __PACKAGE__->startup(
   Base::DBIC
   Store::Base64
   ID::SHA1
   Bind::Cookie
   );

If AutoCommit is invalid and 'L<Egg::Plugin::DBIC>' is effective in the setting
 of DBI, it is late commit.

=head1 CONFIGURATION

It sets in config of the session component module and it sets it to 'dbic' item
 with HASH.

  __PACKAGE__->config(
   dbic => {
    .......
    },
   );

=head3 label_schema

It is Ra bell name because it obtains Schame of L<Egg::Model::DBIC>.

The exception is generated in case of undefined.

=head3 label_source

Label name to obtain source object of session table from L<Egg::Model::DBIC>.

The exception is generated in case of undefined.

=head3 id_field

Name of session ID column.

'id' is used in case of undefined.

=head3 data_field

Name of session data column.

'a_session' is used in case of undefined.

=head3 time_field

Name of updated day and hour column.

'lastmod' is used in case of undefined.

=head1 METHODS

Because most of these methods is the one that L<Egg::Model::Session> internally
 uses it, it is not necessary to usually consider it on the application side.

=head2 moniker

The source object of the session table is returned from L<Egg::Model::DBIC>.

=head2 _begin

If AutoCommit is effective, the transaction is begun. If it is invalid, nothing
 is done.

=head2 _commit

If AutoCommit is effective, the transaction is shut. If it is invalid, 
committing does the rollback if 'is_update' is effective. 

If AutoCommit is invalid, nothing is done.

=head2 result

When the result of 'restore' is preserved, it is returned.

=head2 id_col

The content of 'id_filed' of the configuration is returned.

=head2 data_col

The content of 'data_filed' of the configuration is returned.

=head2 time_col

The content of 'time_field' of the configuration is returned.

=head2 restore ([SESSION_ID])

The session data obtained by received SESSION_ID is returned.

When SESSION_ID is not obtained, it acquires it in 'session_id' method.

=head2 insert ([SESSION_DATA], [SESSION_ID])

New session data is preserved.

SESSION_DATA is indispensable.

When SESSION_ID is not obtained, it acquires it in 'session_id' method.

=head2 update ([SESSION_DATA], [SESSION_ID])

Existing session data is updated.

SESSION_DATA is indispensable.

When SESSION_ID is not obtained, it acquires it in 'session_id' method.

=head2 close

After L<Egg::Model::Session::Manager::TieHash>, commit is done.

However, if 'is_update' method is invalid, rollback is issued. In a word, if 
data was not substituted for the session, the data is annulled.

=head1 SEE ALSO

L<Egg::Release>,
L<Egg::Model::Session>,
L<Egg::Model::Session::Manager::Base>,
L<Egg::Model::Session::Manager::TieHash>,
L<Egg::Model>,
L<Egg::Model::DBIC>,
L<Time::Piece::MySQL>,

=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