root/lang/perl/DBIx-Class-DateTimeColumns/trunk/lib/DBIx/Class/DateTimeColumns.pm @ 16128

package DBIx::Class::DateTimeColumns;
use strict;
use warnings;

use base 'DBIx::Class';
use Scalar::Util qw/blessed/;

our $VERSION = "0.01";

__PACKAGE__->mk_classdata( _datetime_class   => 'DateTime' );
__PACKAGE__->mk_classdata( datetime_timezone => 'local'    );
__PACKAGE__->mk_classdata( _auto_create_datetime_columns => [qw/created_on created_at/] );
__PACKAGE__->mk_classdata( _auto_update_datetime_columns => [qw/updated_on updated_at/] );

=head1 NAME

DBIx::Class::DateTimeColumns - datetime handler on columns

=head1 SYNOPSIS

  package Artist;
  __PACKAGE__->load_components(qw/DateTimeColumns::MySQL Core/);
  __PACKAGE__->datetime_columns(qw/created_on updated_on/);

  my $artist = Artist->find($id);
  $artist->created_on->ymd;
  $artist->updated_on->hms;

=head1 DESCRIPTION

datetime handlers on columns

=head1 METHODS

=head2 auto_create_datetime_columns

special name columns(by default, they're *created_on* and *created_at*)
are set automatically when you insert a new record into database.

  package Artist;
  use base 'DBIx::Class';
  __PACKAGE__->load_components(qw/DateTimeColumns::MySQL Core/);
  __PACKAGE__->datetime_columns(qw/created_on saved_on/);

  my $artist = Artist->new;
  $artist->set_columns({
    name => 'John',
    age  => 30,
  });
  $artist->insert;
  # then automatically set current datetime for *created_on*

if you wanna change the special columns' name, of course, you can.

  package Artist;
  use base 'DBIx::Class';
  __PACKAGE__->load_components(qw/DateTimeColumns::MySQL Core/);
  __PACKAGE__->auto_create_datetime_columns(qw/saved_on/);
  __PACKAGE__->datetime_columns(qw/created_on saved_on/);

  my $artist = Artist->new;
  $artist->set_columns({
    name => 'John',
    age  => 30,
  });
  $artist->insert;
  # then automatically set current datetime for *saved_on*

=cut

sub auto_create_datetime_columns {
  my $self = shift;
  for (@_) {
    $self->throw_exception("column $_ doesn't exist")
      unless $self->has_column($_);
  }
  $self->_auto_create_datetime_columns(\@_) if @_;
  $self->_auto_create_datetime_columns;
}

=head2 auto_update_datetime_columns

special name columns(by default, they're *updated_on* and *updated_at*)
are set automatically when you update records.

  package Artist;
  use base 'DBIx::Class';
  __PACKAGE__->load_components(qw/DateTimeColumns::MySQL Core/);
  __PACKAGE__->datetime_columns(qw/updated_on saved_on/);

  my $artist = Artist->find($id);
  $artist->set_columns({
    name => 'John',
    age  => 30,
  });
  $artist->update;
  # then automatically set current datetime for *updated_on*

if you wanna change the special columns' name, of course, you can.

  package Artist;
  use base 'DBIx::Class';
  __PACKAGE__->load_components(qw/DateTimeColumns::MySQL Core/);
  __PACKAGE__->auto_update_datetime_columns(qw/saved_on/);
  __PACKAGE__->datetime_columns(qw/updated_on saved_on/);

  my $artist = Artist->find($id);
  $artist->set_columns({
    name => 'John',
    age  => 30,
  });
  $artist->update;
  # then automatically set current datetime for *saved_on*

=cut

sub auto_update_datetime_columns {
  my $self = shift;
  for (@_) {
    $self->throw_exception("column $_ doesn't exist")
      unless $self->has_column($_);
  }
  $self->_auto_update_datetime_columns(\@_) if @_;
  $self->_auto_update_datetime_columns;
}

=head2 datetime_class

You can set your own class extends DateTime.

  package Artist;
  __PACKAGE__->load_components(qw/DateTimeColumns::MySQL Core/);
  __PACKAGE__->datetime_class('DateTime::SubClass');

=head2 datetime_timezone

You can set default timezone for datetime columns.
'local' is set by default.

  package Artist;
  __PACKAGE__->load_components(qw/DateTimeColumns::MySQL Core/);
  __PACKAGE__->datetime_timezone('Asia/Tokyo');

=cut

sub datetime_class {
  my ($self, $class) = @_;
  if ($class) {
    if (!eval "require $class") {
      $self->throw_exception("$class could not be loaded: $@");
    } elsif (!$class->isa('DateTime')) {
      $self->throw_exception("$class is not DateTime or it's subclass");
    } else {
      $self->_datetime_class($class);
    }
  }
  return $self->_datetime_class;
}

=head2 insert

=cut

sub insert {
  my $self = shift;
  for my $column (@{$self->auto_create_datetime_columns},
    @{$self->auto_update_datetime_columns}) {
    if ( $self->has_column($column)
      && $self->column_info($column)->{_inflate_info}) {
      $self->store_column($column, $self->get_current_datetime);
    }
  }
  $self->next::method(@_);
}

=head2 update

=cut

sub update {
  my $self = shift;
  for my $column (@{$self->auto_update_datetime_columns}) {
    warn($column);
    if ( $self->has_column($column)
      && $self->column_info($column)->{_inflate_info}) {
      my $ret = $self->store_column($column, $self->get_current_datetime);
      $self->{_dirty_columns}{$column} = 1;
    }
  }
  $self->next::method(@_);
}

=head2 get_current_datetime

=cut

sub get_current_datetime {
  my $self = shift;
  return $self->datetime_class->now(time_zone => $self->datetime_timezone);
}

=head2 datetime_columns(@columns)

=head2 date_columns(@columns)

=head2 timestamp_columns(@columns)

=head2 timestamptz_columns(@columns)

=head2 time_columns(@columns)

=head2 timetz_columns(@columns)

=head2 duration_columns(@columns)

=head2 interval_columns(@columns)

=head2 epoch_columns(@columns)

=cut

# define these methods in subclass
sub datetime_columns    { die "virtual method!" }
sub date_columns        { die "virtual method!" }
sub timestamp_columns   { die "virtual method!" }
sub timestamptz_columns { die "virtual method!" }
sub time_columns        { die "virtual method!" }
sub timetz_columns      { die "virtual method!" }
sub duration_columns    { die "virtual method!" }
sub interval_columns    { die "virtual method!" }

sub epoch_columns {
  my ($self, @columns) = @_;
  for my $column (@columns) {
    $self->inflate_column($column, {
      inflate => sub {
        my $data = shift;
        return $data if blessed($data) && $data->isa('DateTime');
        $self->datetime_class->from_epoch(
          epoch     => $data,
          time_zone => $self->datetime_timezone,
        );
      },
      deflate => sub { shift->epoch },
    });
  }
}

=head1 AUTHOR

Lyo Kato, C<lyo.kato@gmail.com> 

=head1 COPYRIGHT AND LICENSE

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

=cut

1;