[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / InflateColumn / DateTime.pm

package DBIx::Class::InflateColumn::DateTime;

use strict;
use warnings;
use base qw/DBIx::Class/;
use Carp::Clan qw/^DBIx::Class/;
use Try::Tiny;
use namespace::clean;

=head1 NAME

DBIx::Class::InflateColumn::DateTime - Auto-create DateTime objects from date and datetime columns.

=head1 SYNOPSIS

Load this component and then declare one or more
columns to be of the datetime, timestamp or date datatype.

  package Event;
  use base 'DBIx::Class::Core';

  __PACKAGE__->load_components(qw/InflateColumn::DateTime/);
  __PACKAGE__->add_columns(
    starts_when => { data_type => 'datetime' }
    create_date => { data_type => 'date' }
  );

Then you can treat the specified column as a L<DateTime> object.

  print "This event starts the month of ".
    $event->starts_when->month_name();

If you want to set a specific timezone and locale for that field, use:

  __PACKAGE__->add_columns(
    starts_when => { data_type => 'datetime', timezone => "America/Chicago", locale => "de_DE" }
  );

If you want to inflate no matter what data_type your column is,
use inflate_datetime or inflate_date:

  __PACKAGE__->add_columns(
    starts_when => { data_type => 'varchar', inflate_datetime => 1 }
  );

  __PACKAGE__->add_columns(
    starts_when => { data_type => 'varchar', inflate_date => 1 }
  );

It's also possible to explicitly skip inflation:

  __PACKAGE__->add_columns(
    starts_when => { data_type => 'datetime', inflate_datetime => 0 }
  );

NOTE: Don't rely on C<InflateColumn::DateTime> to parse date strings for you.
The column is set directly for any non-references and C<InflateColumn::DateTime>
is completely bypassed.  Instead, use an input parser to create a DateTime
object. For instance, if your user input comes as a 'YYYY-MM-DD' string, you can
use C<DateTime::Format::ISO8601> thusly:

  use DateTime::Format::ISO8601;
  my $dt = DateTime::Format::ISO8601->parse_datetime('YYYY-MM-DD');

=head1 DESCRIPTION

This module figures out the type of DateTime::Format::* class to
inflate/deflate with based on the type of DBIx::Class::Storage::DBI::*
that you are using.  If you switch from one database to a different
one your code should continue to work without modification (though note
that this feature is new as of 0.07, so it may not be perfect yet - bug
reports to the list very much welcome).

If the data_type of a field is C<date>, C<datetime> or C<timestamp> (or
a derivative of these datatypes, e.g. C<timestamp with timezone>), this
module will automatically call the appropriate parse/format method for
deflation/inflation as defined in the storage class. For instance, for
a C<datetime> field the methods C<parse_datetime> and C<format_datetime>
would be called on deflation/inflation. If the storage class does not
provide a specialized inflator/deflator, C<[parse|format]_datetime> will
be used as a fallback. See L<DateTime::Format> for more information on
date formatting.

For more help with using components, see L<DBIx::Class::Manual::Component/USING>.

=cut

__PACKAGE__->load_components(qw/InflateColumn/);

=head2 register_column

Chains with the L<DBIx::Class::Row/register_column> method, and sets
up datetime columns appropriately.  This would not normally be
directly called by end users.

In the case of an invalid date, L<DateTime> will throw an exception.  To
bypass these exceptions and just have the inflation return undef, use
the C<datetime_undef_if_invalid> option in the column info:

    "broken_date",
    {
        data_type => "datetime",
        default_value => '0000-00-00',
        is_nullable => 1,
        datetime_undef_if_invalid => 1
    }

=cut

sub register_column {
  my ($self, $column, $info, @rest) = @_;
  $self->next::method($column, $info, @rest);
  return unless defined($info->{data_type});

  my $type;

  for (qw/date datetime timestamp/) {
    my $key = "inflate_${_}";

    next unless exists $info->{$key};
    return unless $info->{$key};

    $type = $_;
    last;
  }

  unless ($type) {
    $type = lc($info->{data_type});
    if ($type eq "timestamp with time zone" || $type eq "timestamptz") {
      $type = "timestamp";
      $info->{_ic_dt_method} ||= "timestamp_with_timezone";
    } elsif ($type eq "timestamp without time zone") {
      $type = "timestamp";
      $info->{_ic_dt_method} ||= "timestamp_without_timezone";
    } elsif ($type eq "smalldatetime") {
      $type = "datetime";
      $info->{_ic_dt_method} ||= "smalldatetime";
    }
  }

  if ( defined $info->{extra}{timezone} ) {
    carp "Putting timezone into extra => { timezone => '...' } has been deprecated, ".
         "please put it directly into the '$column' column definition.";
    $info->{timezone} = $info->{extra}{timezone} unless defined $info->{timezone};
  }

  if ( defined $info->{extra}{locale} ) {
    carp "Putting locale into extra => { locale => '...' } has been deprecated, ".
         "please put it directly into the '$column' column definition.";
    $info->{locale} = $info->{extra}{locale} unless defined $info->{locale};
  }

  my $undef_if_invalid = $info->{datetime_undef_if_invalid};

  if ($type eq 'datetime' || $type eq 'date' || $type eq 'timestamp') {
    # This shallow copy of %info avoids t/52_cycle.t treating
    # the resulting deflator as a circular reference.
    my %info = ( '_ic_dt_method' => $type , %{ $info } );

    if (defined $info->{extra}{floating_tz_ok}) {
      carp "Putting floating_tz_ok into extra => { floating_tz_ok => 1 } has been deprecated, ".
           "please put it directly into the '$column' column definition.";
      $info{floating_tz_ok} = $info->{extra}{floating_tz_ok};
    }

    $self->inflate_column(
      $column =>
        {
          inflate => sub {
            my ($value, $obj) = @_;

            my $dt = try
              { $obj->_inflate_to_datetime( $value, \%info ) }
              catch {
                $self->throw_exception ("Error while inflating ${value} for ${column} on ${self}: $_")
                  unless $undef_if_invalid;
                undef;  # rv
              };

            return (defined $dt)
              ? $obj->_post_inflate_datetime( $dt, \%info )
              : undef
            ;
          },
          deflate => sub {
            my ($value, $obj) = @_;

            $value = $obj->_pre_deflate_datetime( $value, \%info );
            $obj->_deflate_from_datetime( $value, \%info );
          },
        }
    );
  }
}

sub _flate_or_fallback
{
  my( $self, $value, $info, $method_fmt ) = @_;

  my $parser = $self->_datetime_parser;
  my $preferred_method = sprintf($method_fmt, $info->{ _ic_dt_method });
  my $method = $parser->can($preferred_method) ? $preferred_method : sprintf($method_fmt, 'datetime');
  return $parser->$method($value);
}

sub _inflate_to_datetime {
  my( $self, $value, $info ) = @_;
  return $self->_flate_or_fallback( $value, $info, 'parse_%s' );
}

sub _deflate_from_datetime {
  my( $self, $value, $info ) = @_;
  return $self->_flate_or_fallback( $value, $info, 'format_%s' );
}

sub _datetime_parser {
  shift->result_source->storage->datetime_parser (@_);
}

sub _post_inflate_datetime {
  my( $self, $dt, $info ) = @_;

  $dt->set_time_zone($info->{timezone}) if defined $info->{timezone};
  $dt->set_locale($info->{locale}) if defined $info->{locale};

  return $dt;
}

sub _pre_deflate_datetime {
  my( $self, $dt, $info ) = @_;

  if (defined $info->{timezone}) {
    carp "You're using a floating timezone, please see the documentation of"
      . " DBIx::Class::InflateColumn::DateTime for an explanation"
      if ref( $dt->time_zone ) eq 'DateTime::TimeZone::Floating'
          and not $info->{floating_tz_ok}
          and not $ENV{DBIC_FLOATING_TZ_OK};

    $dt->set_time_zone($info->{timezone});
  }

  $dt->set_locale($info->{locale}) if defined $info->{locale};

  return $dt;
}

1;
__END__

=head1 USAGE NOTES

If you have a datetime column with an associated C<timezone>, and subsequently
create/update this column with a DateTime object in the L<DateTime::TimeZone::Floating>
timezone, you will get a warning (as there is a very good chance this will not have the
result you expect). For example:

  __PACKAGE__->add_columns(
    starts_when => { data_type => 'datetime', timezone => "America/Chicago" }
  );

  my $event = $schema->resultset('EventTZ')->create({
    starts_at => DateTime->new(year=>2007, month=>12, day=>31, ),
  });

The warning can be avoided in several ways:

=over

=item Fix your broken code

When calling C<set_time_zone> on a Floating DateTime object, the timezone is simply
set to the requested value, and B<no time conversion takes place>. It is always a good idea
to be supply explicit times to the database:

  my $event = $schema->resultset('EventTZ')->create({
    starts_at => DateTime->new(year=>2007, month=>12, day=>31, time_zone => "America/Chicago" ),
  });

=item Suppress the check on per-column basis

  __PACKAGE__->add_columns(
    starts_when => { data_type => 'datetime', timezone => "America/Chicago", floating_tz_ok => 1 }
  );

=item Suppress the check globally

Set the environment variable DBIC_FLOATING_TZ_OK to some true value.

=back

Putting extra attributes like timezone, locale or floating_tz_ok into extra => {} has been
B<DEPRECATED> because this gets you into trouble using L<DBIx::Class::Schema::Versioned>.
Instead put it directly into the columns definition like in the examples above. If you still
use the old way you'll see a warning - please fix your code then!

=head1 SEE ALSO

=over 4

=item More information about the add_columns method, and column metadata,
      can be found in the documentation for L<DBIx::Class::ResultSource>.

=item Further discussion of problems inherent to the Floating timezone:
      L<Floating DateTimes|DateTime/Floating_DateTimes>
      and L<< $dt->set_time_zone|DateTime/"Set" Methods >>

=back

=head1 AUTHOR

Matt S. Trout <mst@shadowcatsystems.co.uk>

=head1 CONTRIBUTORS

Aran Deltac <bluefeet@cpan.org>

=head1 LICENSE

You may distribute this code under the same terms as Perl itself.
Commit	Line	Data
445e5e31	1	package DBIx::Class::InflateColumn::DateTime;
	2
	3	use strict;
	4	use warnings;
	5	use base qw/DBIx::Class/;
341d5ede	6	use Carp::Clan qw/^DBIx::Class/;
ed7ab0f4	7	use Try::Tiny;
fd323bf1	8	use namespace::clean;
445e5e31	9
0b375b68	10	=head1 NAME
0b375b68	11
5d0a2955	12	DBIx::Class::InflateColumn::DateTime - Auto-create DateTime objects from date and datetime columns.
0b375b68	13
	14	=head1 SYNOPSIS
	15
fd323bf1	16	Load this component and then declare one or more
679a304a	17	columns to be of the datetime, timestamp or date datatype.
0b375b68	18
0b375b68	19	package Event;
d88ecca6	20	use base 'DBIx::Class::Core';
	21
	22	__PACKAGE__->load_components(qw/InflateColumn::DateTime/);
0b375b68	23	__PACKAGE__->add_columns(
0b375b68	24	starts_when => { data_type => 'datetime' }
9c71b5e2	25	create_date => { data_type => 'date' }
0b375b68	26	);
	27
	28	Then you can treat the specified column as a L<DateTime> object.
	29
	30	print "This event starts the month of ".
	31	$event->starts_when->month_name();
	32
8d689133	33	If you want to set a specific timezone and locale for that field, use:
dda9af55	34
dda9af55	35	__PACKAGE__->add_columns(
92ed0695	36	starts_when => { data_type => 'datetime', timezone => "America/Chicago", locale => "de_DE" }
dda9af55	37	);
dda9af55	38
a97fe7e0	39	If you want to inflate no matter what data_type your column is,
	40	use inflate_datetime or inflate_date:
	41
	42	__PACKAGE__->add_columns(
	43	starts_when => { data_type => 'varchar', inflate_datetime => 1 }
	44	);
d4daee7b	45
a97fe7e0	46	__PACKAGE__->add_columns(
	47	starts_when => { data_type => 'varchar', inflate_date => 1 }
	48	);
	49
ff8a6e3b	50	It's also possible to explicitly skip inflation:
d4daee7b	51
ff8a6e3b	52	__PACKAGE__->add_columns(
	53	starts_when => { data_type => 'datetime', inflate_datetime => 0 }
	54	);
	55
8bf37b16	56	NOTE: Don't rely on C<InflateColumn::DateTime> to parse date strings for you.
	57	The column is set directly for any non-references and C<InflateColumn::DateTime>
	58	is completely bypassed. Instead, use an input parser to create a DateTime
	59	object. For instance, if your user input comes as a 'YYYY-MM-DD' string, you can
	60	use C<DateTime::Format::ISO8601> thusly:
d6aed638	61
	62	use DateTime::Format::ISO8601;
	63	my $dt = DateTime::Format::ISO8601->parse_datetime('YYYY-MM-DD');
	64
0b375b68	65	=head1 DESCRIPTION
0b375b68	66
fd323bf1	67	This module figures out the type of DateTime::Format::* class to
	68	inflate/deflate with based on the type of DBIx::Class::Storage::DBI::*
	69	that you are using. If you switch from one database to a different
5d0a2955	70	one your code should continue to work without modification (though note
	71	that this feature is new as of 0.07, so it may not be perfect yet - bug
	72	reports to the list very much welcome).
0b375b68	73
9c71b5e2	74	If the data_type of a field is C<date>, C<datetime> or C<timestamp> (or
f59e543b	75	a derivative of these datatypes, e.g. C<timestamp with timezone>), this
9c71b5e2	76	module will automatically call the appropriate parse/format method for
	77	deflation/inflation as defined in the storage class. For instance, for
	78	a C<datetime> field the methods C<parse_datetime> and C<format_datetime>
	79	would be called on deflation/inflation. If the storage class does not
	80	provide a specialized inflator/deflator, C<[parse\|format]_datetime> will
	81	be used as a fallback. See L<DateTime::Format> for more information on
	82	date formatting.
	83
943f93f2	84	For more help with using components, see L<DBIx::Class::Manual::Component/USING>.
de78905b	85
0b375b68	86	=cut
0b375b68	87
445e5e31	88	__PACKAGE__->load_components(qw/InflateColumn/);
445e5e31	89
9b83fccd	90	=head2 register_column
	91
	92	Chains with the L<DBIx::Class::Row/register_column> method, and sets
	93	up datetime columns appropriately. This would not normally be
	94	directly called by end users.
	95
33a126ef	96	In the case of an invalid date, L<DateTime> will throw an exception. To
	97	bypass these exceptions and just have the inflation return undef, use
	98	the C<datetime_undef_if_invalid> option in the column info:
d4daee7b	99
33a126ef	100	"broken_date",
	101	{
	102	data_type => "datetime",
	103	default_value => '0000-00-00',
	104	is_nullable => 1,
	105	datetime_undef_if_invalid => 1
	106	}
	107
9b83fccd	108	=cut
9b83fccd	109
445e5e31	110	sub register_column {
	111	my ($self, $column, $info, @rest) = @_;
	112	$self->next::method($column, $info, @rest);
c209c4fd	113	return unless defined($info->{data_type});
bb90689c	114
	115	my $type;
	116
abc914bd	117	for (qw/date datetime timestamp/) {
bb90689c	118	my $key = "inflate_${_}";
	119
	120	next unless exists $info->{$key};
	121	return unless $info->{$key};
	122
	123	$type = $_;
	124	last;
	125	}
	126
	127	unless ($type) {
	128	$type = lc($info->{data_type});
6c99a3ee	129	if ($type eq "timestamp with time zone" \|\| $type eq "timestamptz") {
	130	$type = "timestamp";
	131	$info->{_ic_dt_method} \|\|= "timestamp_with_timezone";
65b386df	132	} elsif ($type eq "timestamp without time zone") {
	133	$type = "timestamp";
	134	$info->{_ic_dt_method} \|\|= "timestamp_without_timezone";
4a80eede	135	} elsif ($type eq "smalldatetime") {
4a80eede	136	$type = "datetime";
fb95dc4d	137	$info->{_ic_dt_method} \|\|= "smalldatetime";
6c99a3ee	138	}
bb90689c	139	}
bb90689c	140
8d689133	141	if ( defined $info->{extra}{timezone} ) {
341d5ede	142	carp "Putting timezone into extra => { timezone => '...' } has been deprecated, ".
6c9d0c63	143	"please put it directly into the '$column' column definition.";
c3ed0bde	144	$info->{timezone} = $info->{extra}{timezone} unless defined $info->{timezone};
dda9af55	145	}
dda9af55	146
8d689133	147	if ( defined $info->{extra}{locale} ) {
341d5ede	148	carp "Putting locale into extra => { locale => '...' } has been deprecated, ".
6c9d0c63	149	"please put it directly into the '$column' column definition.";
c3ed0bde	150	$info->{locale} = $info->{extra}{locale} unless defined $info->{locale};
8d689133	151	}
d4daee7b	152
dceeddc7	153	my $undef_if_invalid = $info->{datetime_undef_if_invalid};
dceeddc7	154
abc914bd	155	if ($type eq 'datetime' \|\| $type eq 'date' \|\| $type eq 'timestamp') {
ab969dd4	156	# This shallow copy of %info avoids t/52_cycle.t treating
	157	# the resulting deflator as a circular reference.
	158	my %info = ( '_ic_dt_method' => $type , %{ $info } );
	159
92ed0695	160	if (defined $info->{extra}{floating_tz_ok}) {
341d5ede	161	carp "Putting floating_tz_ok into extra => { floating_tz_ok => 1 } has been deprecated, ".
6c9d0c63	162	"please put it directly into the '$column' column definition.";
b1e4a1df	163	$info{floating_tz_ok} = $info->{extra}{floating_tz_ok};
92ed0695	164	}
45147005	165
445e5e31	166	$self->inflate_column(
	167	$column =>
	168	{
	169	inflate => sub {
	170	my ($value, $obj) = @_;
40f75181	171
9780718f	172	my $dt = try
	173	{ $obj->_inflate_to_datetime( $value, \%info ) }
	174	catch {
	175	$self->throw_exception ("Error while inflating ${value} for ${column} on ${self}: $_")
	176	unless $undef_if_invalid;
	177	undef; # rv
	178	};
	179
	180	return (defined $dt)
	181	? $obj->_post_inflate_datetime( $dt, \%info )
	182	: undef
	183	;
445e5e31	184	},
	185	deflate => sub {
	186	my ($value, $obj) = @_;
f856fe01	187
f856fe01	188	$value = $obj->_pre_deflate_datetime( $value, \%info );
ab969dd4	189	$obj->_deflate_from_datetime( $value, \%info );
445e5e31	190	},
	191	}
	192	);
	193	}
	194	}
	195
ab969dd4	196	sub _flate_or_fallback
	197	{
	198	my( $self, $value, $info, $method_fmt ) = @_;
	199
	200	my $parser = $self->_datetime_parser;
	201	my $preferred_method = sprintf($method_fmt, $info->{ _ic_dt_method });
	202	my $method = $parser->can($preferred_method) ? $preferred_method : sprintf($method_fmt, 'datetime');
	203	return $parser->$method($value);
	204	}
	205
	206	sub _inflate_to_datetime {
	207	my( $self, $value, $info ) = @_;
	208	return $self->_flate_or_fallback( $value, $info, 'parse_%s' );
	209	}
	210
	211	sub _deflate_from_datetime {
	212	my( $self, $value, $info ) = @_;
	213	return $self->_flate_or_fallback( $value, $info, 'format_%s' );
	214	}
abc914bd	215
445e5e31	216	sub _datetime_parser {
f568d83b	217	shift->result_source->storage->datetime_parser (@_);
445e5e31	218	}
445e5e31	219
f856fe01	220	sub _post_inflate_datetime {
	221	my( $self, $dt, $info ) = @_;
	222
c3ed0bde	223	$dt->set_time_zone($info->{timezone}) if defined $info->{timezone};
c3ed0bde	224	$dt->set_locale($info->{locale}) if defined $info->{locale};
f856fe01	225
	226	return $dt;
	227	}
	228
	229	sub _pre_deflate_datetime {
	230	my( $self, $dt, $info ) = @_;
	231
c3ed0bde	232	if (defined $info->{timezone}) {
f856fe01	233	carp "You're using a floating timezone, please see the documentation of"
	234	. " DBIx::Class::InflateColumn::DateTime for an explanation"
	235	if ref( $dt->time_zone ) eq 'DateTime::TimeZone::Floating'
	236	and not $info->{floating_tz_ok}
	237	and not $ENV{DBIC_FLOATING_TZ_OK};
	238
c3ed0bde	239	$dt->set_time_zone($info->{timezone});
f856fe01	240	}
f856fe01	241
c3ed0bde	242	$dt->set_locale($info->{locale}) if defined $info->{locale};
f856fe01	243
	244	return $dt;
	245	}
	246
445e5e31	247	1;
0b375b68	248	__END__
0b375b68	249
45147005	250	=head1 USAGE NOTES
45147005	251
97983826	252	If you have a datetime column with an associated C<timezone>, and subsequently
45147005	253	create/update this column with a DateTime object in the L<DateTime::TimeZone::Floating>
	254	timezone, you will get a warning (as there is a very good chance this will not have the
	255	result you expect). For example:
	256
	257	__PACKAGE__->add_columns(
92ed0695	258	starts_when => { data_type => 'datetime', timezone => "America/Chicago" }
45147005	259	);
	260
	261	my $event = $schema->resultset('EventTZ')->create({
	262	starts_at => DateTime->new(year=>2007, month=>12, day=>31, ),
	263	});
	264
	265	The warning can be avoided in several ways:
	266
	267	=over
	268
	269	=item Fix your broken code
	270
	271	When calling C<set_time_zone> on a Floating DateTime object, the timezone is simply
	272	set to the requested value, and B<no time conversion takes place>. It is always a good idea
	273	to be supply explicit times to the database:
	274
	275	my $event = $schema->resultset('EventTZ')->create({
	276	starts_at => DateTime->new(year=>2007, month=>12, day=>31, time_zone => "America/Chicago" ),
	277	});
	278
	279	=item Suppress the check on per-column basis
	280
	281	__PACKAGE__->add_columns(
92ed0695	282	starts_when => { data_type => 'datetime', timezone => "America/Chicago", floating_tz_ok => 1 }
45147005	283	);
	284
	285	=item Suppress the check globally
	286
	287	Set the environment variable DBIC_FLOATING_TZ_OK to some true value.
	288
	289	=back
	290
92ed0695	291	Putting extra attributes like timezone, locale or floating_tz_ok into extra => {} has been
	292	B<DEPRECATED> because this gets you into trouble using L<DBIx::Class::Schema::Versioned>.
	293	Instead put it directly into the columns definition like in the examples above. If you still
	294	use the old way you'll see a warning - please fix your code then!
45147005	295
0b375b68	296	=head1 SEE ALSO
	297
	298	=over 4
	299
fd323bf1	300	=item More information about the add_columns method, and column metadata,
0b375b68	301	can be found in the documentation for L<DBIx::Class::ResultSource>.
0b375b68	302
45147005	303	=item Further discussion of problems inherent to the Floating timezone:
fd323bf1	304	L<Floating DateTimes\|DateTime/Floating_DateTimes>
45147005	305	and L<< $dt->set_time_zone\|DateTime/"Set" Methods >>
45147005	306
0b375b68	307	=back
	308
	309	=head1 AUTHOR
	310
	311	Matt S. Trout <mst@shadowcatsystems.co.uk>
	312
	313	=head1 CONTRIBUTORS
	314
	315	Aran Deltac <bluefeet@cpan.org>
	316
	317	=head1 LICENSE
	318
	319	You may distribute this code under the same terms as Perl itself.
	320