SPOPS::Tool::DateConvert - Convert dates to objects to/from your datastore

 # Class configuration with date convertion rule and metadata

 my $spops = {
    class               => 'This::Class',
    isa                 => [ 'SPOPS::DBI' ],
    field               => [ 'email', 'language', 'birthtime' ],
    id_field            => 'email',
    base_table          => 'test_table',
    rules_from          => [ 'SPOPS::Tool::DateConvert' ],
    convert_date_field  => [ 'birthtime' ],
    convert_date_class  => 'Time::Piece',
    convert_date_format => '%Y-%m-%d %H:%M:%S',
 };
 SPOPS::Initialize->process({ config => { test => $spops } });

 my $item = This::Class->fetch(55);
 print "Birthdate field isa: ", ref( $item->{birthtime} ), "\n";
 --> Birthdate field isa: Time::Piece

 # Format some other way

 print "Birthday occurred on day ", $item->{birthtime}->strftime( '%j' ),
       "which was a ", $item->{birthtime}->strftime( '%A' ), "\n";

 # When creating a new object, just set the correct type of object as
 # the field value

 my $newborn = This::Class->new({ email     => 'foo@bar.com',
                                  language  => 'en',
                                  birthtime => Time::Piece->new });
 $newborn->save;

package SPOPS::Tool::DateConvert;

# $Id: DateConvert.pm,v 1.10 2004/02/26 01:01:37 lachoy Exp $

use strict;
use Log::Log4perl qw( get_logger );
use SPOPS;

my $log = get_logger();

my $DEFAULT_DATE_CLASS  = 'DateTime';
my $DEFAULT_DATE_FORMAT = '%Y-%m-%d %H:%M:%S';

my %REQUIRED = ();

sub ruleset_factory {
    my ( $class, $ruleset ) = @_;
    push @{ $ruleset->{post_fetch_action} }, \&convert_to_object;
    push @{ $ruleset->{pre_save_action} }, \&convert_to_string;
    push @{ $ruleset->{post_save_action} }, \&convert_to_object;
    $log->is_info &&
        $log->info( "DateConvert added post_fetch, pre/post_save rules to [$class]" );
    return __PACKAGE__;
}

sub convert_to_object {
    my ( $self ) = @_;
    my ( $date_fields, $date_class ) = _init( $self );
    unless ( ref $date_fields eq 'ARRAY' and scalar @{ $date_fields } ) {
        $log->warn( "Using date conversion for ", ref( $self ), " but there ",
            "are no date fields in 'convert_date_field'" );
        return 1;
    }
    foreach my $field ( @{ $date_fields } ) {
        $self->{ $field } = eval {
            _create_date_object( $self, $date_class, $self->{ $field } )
        };
        return undef if ( $@ );
    }
    return 1;
}

sub _create_date_object {
    my ( $self, $date_class, $date ) = @_;
    return undef unless ( $date );
    if ( ref $date eq $date_class ) {
        return $date;
    }
    if ( $date_class eq 'Class::Date' ) {
        return Class::Date->new( $date );
    }
    elsif ( $date_class eq 'Time::Piece' ) {
        my $date_format = $self->CONFIG->{convert_date_format}
                          || $DEFAULT_DATE_FORMAT;
        return Time::Piece->strptime( $date, $date_format );
    }
    elsif ( $date_class eq 'DateTime' ) {
        my $date_format = $self->CONFIG->{convert_date_format}
                          || $DEFAULT_DATE_FORMAT;
        return DateTime::Format::Strptime->new( pattern => $date_format )
                                         ->parse_datetime( $date );
    }
    die "Given date class [$date_class] is not supported for conversion\n";
}

sub convert_to_string {
    my ( $self ) = @_;
    my ( $date_fields, $date_class ) = _init( $self );
    unless ( ref $date_fields eq 'ARRAY' and scalar @{ $date_fields } ) {
        $log->warn( "Using date conversion for ", ref( $self ), " but there ",
            "are no date fields in 'convert_date_field'" );
        return 1;
    }
    foreach my $field ( @{ $date_fields } ) {
        $self->{ $field } = _create_date_string( $self, $date_class, $self->{ $field } );
    }
    return 1;
}

sub _create_date_string {
    my ( $self, $date_class, $date_object ) = @_;

    # NULLs are ok...

    unless ( $date_object ) {
        return undef;
    }

    # Strings are semi-ok...

    unless ( ref( $date_object ) ) {
        $log->info( "Expected date object of type '$date_class' but item ",
                    "is not a reference, which probably means it's a ",
                    "string representation of a date ($date_object). ",
                    "Hope it's in the right format, it's going in as is." );
        return $date_object
    }

    # ... but getting something that's not an object when we expect
    # something is a different matter and deserves a warning

    unless ( ref( $date_object ) eq $date_class ) {
        $log->warn( "Expected date object of type '$date_class' but ",
               "got '", ref( $date_object ), "'; not converting." );
        return undef;
    }
    my $date_format = $self->CONFIG->{convert_date_format}
                      || $DEFAULT_DATE_FORMAT;
    if ( $date_class eq 'Class::Date' ) {
        return $date_object->strftime( $date_format );
    }
    elsif ( $date_class eq 'Time::Piece' ) {
        return $date_object->strftime( $date_format );
    }
    elsif ( $date_class eq 'DateTime' ) {
        return $date_object->strftime( $date_format );
    }
    die "Given date class [$date_class] is not supported for conversion\n";
}

sub _init {
    my ( $self ) = @_;
    my $date_fields = $self->CONFIG->{convert_date_field};
    return () unless ( ref $date_fields eq 'ARRAY'
                           and scalar @{ $date_fields } );
    my $date_class = $self->CONFIG->{convert_date_class}
                     || $DEFAULT_DATE_CLASS;
    unless ( $REQUIRED{ $date_class } ) {
        _require_class( $date_class );
    }
    return ( $date_fields, $date_class );
}

sub _require_class {
    my ( $date_class ) = @_;
    eval "require $date_class";
    if ( $@ ) {
        die "Cannot bring in date library $date_class: $@\n";
    }
    $REQUIRED{ $date_class }++;

    # HACK!
    if ( $date_class eq 'DateTime' ) {
        require DateTime::Format::Strptime;
        $REQUIRED{ 'DateTime::Format::Strptime' }++;
    }
}

1;

__END__