package DBIx::Class::Helper::ResultSet::DateMethods1;
$DBIx::Class::Helper::ResultSet::DateMethods1::VERSION = '2.028000';
# ABSTRACT: Work with dates in your RDBMS nicely
use parent 'DBIx::Class::ResultSet';
use strict;
use warnings;
use DBI qw(:sql_types);
use DBIx::Introspector;
use Safe::Isa;
sub _flatten_thing {
my ($self, $thing) = @_;
die 'you dummy' unless defined $thing;
my $ref = ref $thing;
return ('?', $thing) if !$ref;
if ($ref eq 'HASH' && exists $thing->{'-ident'}) {
my $thing = $thing->{'-ident'};
$thing = $self->current_source_alias . $thing if $thing =~ m/^\./;
return $self->result_source->storage->sql_maker->_quote($thing)
}
return ${$thing} if $ref eq 'SCALAR';
# FIXME: this should have the right bind type
return ('?', $self->utc($thing)) if $thing->$_isa('DateTime');
return @{${$thing}};
}
sub _introspector {
my $d = DBIx::Introspector->new(drivers => '2013-12.01');
$d->decorate_driver_unconnected(MSSQL => now_utc_sql => 'GETUTCDATE()');
$d->decorate_driver_unconnected(SQLite => now_utc_sql => q<DATETIME('now')>);
$d->decorate_driver_unconnected(mysql => now_utc_sql => 'UTC_TIMESTAMP()');
$d->decorate_driver_unconnected(Oracle => now_utc_sql => 'sys_extract_utc(SYSTIMESTAMP)');
$d->decorate_driver_unconnected(Pg => now_utc_sql => 'CURRENT_TIMESTAMP');
MSSQL: {
my %part_map = (
year => 'year',
quarter => 'quarter',
month => 'month',
day_of_year => 'dayofyear',
day_of_month => 'day',
week => 'week',
day_of_week => 'ISO_WEEK',
hour => 'hour',
minute => 'minute',
second => 'second',
millisecond => 'millisecond',
nanosecond => 'nanosecond',
non_iso_day_of_week => 'weekday',
timezone_as_minutes => 'TZoffset',
);
$d->decorate_driver_unconnected(MSSQL => datepart_sql => sub {
sub {
my ($date_sql, $part) = @_;
my ($sql, @args) = @$date_sql;
return [
"DATEPART($part_map{$part}, $sql)",
@args
]
}
});
my %diff_part_map = %part_map;
$diff_part_map{day} = delete $diff_part_map{day_of_year};
delete $diff_part_map{day_of_month};
delete $diff_part_map{day_of_week};
$d->decorate_driver_unconnected(MSSQL => dateadd_sql => sub {
sub {
my ($date_sql, $unit, $amount_sql) = @_;
my ($d_sql, @d_args) = @{$date_sql};
my ($a_sql, @a_args) = @{$amount_sql};
return [
"DATEADD($diff_part_map{$unit}, CAST($a_sql AS int), $d_sql)",
@a_args, @d_args,
];
}
});
}
SQLITE: {
my %part_map = (
month => 'm',
day_of_month => 'd',
year => 'Y',
hour => 'H',
day_of_year => 'j',
minute => 'M',
second => 'S',
day_of_week => 'w',
week => 'W',
# maybe don't support these or prefix them with 'sqlite.'?
julian_day => 'J',
seconds_since_epoch => 's',
fractional_seconds => 'f',
);
$d->decorate_driver_unconnected(SQLite => datepart_sql => sub {
sub {
my ($date_sql, $part) = @_;
my ($sql, @args) = @$date_sql;
return [
"STRFTIME('%$part_map{$part}', $sql)",
@args
]
}
});
my %diff_part_map = (
day => 'days',
hour => 'hours',
minute => 'minutes',
second => 'seconds',
month => 'months',
year => 'years',
);
$d->decorate_driver_unconnected(SQLite => dateadd_sql => sub {
sub {
my ($date_sql, $unit, $amount_sql) = @_;
my ($d_sql, @d_args) = @{$date_sql};
my ($a_sql, @a_args) = @{$amount_sql};
die "unknown part $unit" unless $diff_part_map{$unit};
return [
"DATETIME($d_sql, $a_sql || ?)",
@d_args, @a_args, " $diff_part_map{$unit}"
];
}
});
}
PG: {
my %part_map = (
century => 'century',
decade => 'decade',
day_of_month => 'day',
day_of_week => 'dow',
day_of_year => 'doy',
seconds_since_epoch => 'epoch',
hour => 'hour',
iso_day_of_week => 'isodow',
iso_year => 'isoyear',
microsecond => 'microseconds',
millenium => 'millenium',
millisecond => 'milliseconds',
minute => 'minute',
month => 'month',
quarter => 'quarter',
second => 'second',
timezone => 'timezone',
timezone_hour => 'timezone_hour',
timezone_minute => 'timezone_minute',
week => 'week',
year => 'year',
);
my %diff_part_map = %part_map;
delete $diff_part_map{qw(
day_of_week day_of_year iso_day_of_week iso_year millenium quarter
seconds_since_epoch timezone timezone_hour timezone_minute
)};
$diff_part_map{day} = delete $diff_part_map{day_of_month};
$d->decorate_driver_unconnected(Pg => datepart_sql => sub {
sub {
my ($date_sql, $part) = @_;
my ($sql, @args) = @$date_sql;
@args = ([{ dbd_attrs => SQL_TIMESTAMP }, $args[0]])
if $sql eq '?' && @args == 1;
return [
"date_part(?, $sql)",
$part_map{$part}, @args
]
}
});
$d->decorate_driver_unconnected(Pg => dateadd_sql => sub {
sub {
my ($date_sql, $unit, $amount_sql) = @_;
my ($d_sql, @d_args) = @{$date_sql};
my ($a_sql, @a_args) = @{$amount_sql};
@d_args = ([{ dbd_attrs => SQL_TIMESTAMP }, $d_args[0]])
if $d_sql eq '?' && @d_args == 1;
die "unknown part $unit" unless $diff_part_map{$unit};
return [
"($d_sql + $a_sql * interval '1 $diff_part_map{$unit}')",
@d_args, @a_args,
];
}
});
}
MYSQL: {
my %part_map = (
microsecond => 'MICROSECOND',
second => 'SECOND',
minute => 'MINUTE',
hour => 'HOUR',
day_of_month => 'DAY',
week => 'WEEK',
month => 'MONTH',
quarter => 'QUARTER',
year => 'YEAR',
second_microsecond => 'SECOND_MICROSECOND',
minute_microsecond => 'MINUTE_MICROSECOND',
minute_second => 'MINUTE_SECOND',
hour_microsecond => 'HOUR_MICROSECOND',
hour_second => 'HOUR_SECOND',
hour_minute => 'HOUR_MINUTE',
day_microsecond => 'DAY_MICROSECOND',
day_second => 'DAY_SECOND',
day_minute => 'DAY_MINUTE',
day_hour => 'DAY_HOUR',
year_month => 'YEAR_MONTH',
);
my %diff_part_map = %part_map;
$diff_part_map{day} = delete $diff_part_map{day_of_month};
delete $diff_part_map{qw(
second_microsecond minute_microsecond minute_second
hour_microsecond hour_second hour_minute day_microsecond
day_second day_minute day_hour year_month
)};
$d->decorate_driver_unconnected(mysql => datepart_sql => sub {
sub {
my ($date_sql, $part) = @_;
my ($sql, @args) = @$date_sql;
return [
"EXTRACT($part_map{$part} FROM $sql)", @args
]
}
});
$d->decorate_driver_unconnected(mysql => dateadd_sql => sub {
sub {
my ($date_sql, $unit, $amount_sql) = @_;
my ($d_sql, @d_args) = @{$date_sql};
my ($a_sql, @a_args) = @{$amount_sql};
die "unknown part $unit" unless $diff_part_map{$unit};
return [
"DATE_ADD($d_sql, INTERVAL $a_sql $diff_part_map{$unit})",
@d_args, @a_args,
];
}
});
}
ORACLE: {
my %part_map = (
second => 'SECOND',
minute => 'MINUTE',
hour => 'HOUR',
day_of_month => 'DAY',
month => 'MONTH',
year => 'YEAR',
);
$d->decorate_driver_unconnected(Oracle => datepart_sql => sub {
sub {
my ($date_sql, $part) = @_;
my ($sql, @args) = @$date_sql;
return [
"EXTRACT($part_map{$part} FROM TO_TIMESTAMP($sql))", @args
]
}
});
my %diff_part_map = %part_map;
$diff_part_map{day} = delete $diff_part_map{day_of_month};
delete $diff_part_map{$_} for qw(year month);
$d->decorate_driver_unconnected(Oracle => dateadd_sql => sub {
sub {
my ($date_sql, $unit, $amount_sql) = @_;
my ($d_sql, @d_args) = @{$date_sql};
my ($a_sql, @a_args) = @{$amount_sql};
die "unknown unit $unit" unless $diff_part_map{$unit};
return [
"(TO_TIMESTAMP($d_sql) + NUMTODSINTERVAL($a_sql, ?))",
@d_args, @a_args, $diff_part_map{$unit}
];
}
});
}
return $d;
}
use namespace::clean;
sub utc {
my ($self, $datetime) = @_;
my $tz_name = $datetime->time_zone->name;
die "floating dates are not allowed"
if $tz_name eq 'floating';
$datetime = $datetime->clone->set_time_zone('UTC')
unless $tz_name eq 'UTC';
$_[0]->result_source->storage->datetime_parser->format_datetime($datetime)
}
sub dt_before {
my ($self, $l, $r) = @_;
my ($l_sql, @l_args) = _flatten_thing($self, $l);
my ($r_sql, @r_args) = _flatten_thing($self, $r);
return $self->search(\[
"$l_sql < $r_sql", @l_args, @r_args
]);
}
sub dt_on_or_before {
my ($self, $l, $r) = @_;
my ($l_sql, @l_args) = _flatten_thing($self, $l);
my ($r_sql, @r_args) = _flatten_thing($self, $r);
$self->search(\[
"$l_sql <= $r_sql", @l_args, @r_args
]);
}
sub dt_on_or_after {
my ($self, $l, $r) = @_;
my ($l_sql, @l_args) = _flatten_thing($self, $l);
my ($r_sql, @r_args) = _flatten_thing($self, $r);
return $self->search(\[
"$l_sql >= $r_sql", @l_args, @r_args
]);
}
sub dt_after {
my ($self, $l, $r) = @_;
my ($l_sql, @l_args) = _flatten_thing($self, $l);
my ($r_sql, @r_args) = _flatten_thing($self, $r);
return $self->search(\[
"$l_sql > $r_sql", @l_args, @r_args
]);
}
my $d;
sub utc_now {
my $self = shift;
my $storage = $self->result_source->storage;
$storage->ensure_connected;
$d ||= _introspector();
return \( $d->get($storage->dbh, undef, 'now_utc_sql') );
}
sub dt_SQL_add {
my ($self, $thing, $unit, $amount) = @_;
my $storage = $self->result_source->storage;
$storage->ensure_connected;
$d ||= _introspector();
return \(
$d->get($storage->dbh, undef, 'dateadd_sql')->(
[ _flatten_thing($self, $thing) ],
$unit,
[ _flatten_thing($self, $amount) ],
)
);
}
sub dt_SQL_pluck {
my ($self, $thing, $part) = @_;
my $storage = $self->result_source->storage;
$storage->ensure_connected;
$d ||= _introspector();
return \(
$d->get($storage->dbh, undef, 'datepart_sql')->(
[ _flatten_thing($self, $thing) ],
$part,
)
);
}
1;
__END__
=pod
=head1 NAME
DBIx::Class::Helper::ResultSet::DateMethods1 - Work with dates in your RDBMS nicely
=head1 SYNOPSIS
package MySchema::ResultSet::Bar;
use strict;
use warnings;
use parent 'DBIx::Class::ResultSet';
__PACKAGE__->load_components('Helper::ResultSet::DateMethods1');
# in code using resultset
# get count per year/month
$rs->search(undef, {
columns => {
count => '*',
year => $rs->dt_SQL_pluck({ -ident => '.start' }, 'year'),
month => $rs->dt_SQL_pluck({ -ident => '.start' }, 'month'),
},
group_by => [
$rs->dt_SQL_pluck({ -ident => '.start' }, 'year'),
$rs->dt_SQL_pluck({ -ident => '.start' }, 'month'),
],
});
# mysql
(SELECT `me`.*, EXTRACT(MONTH FROM `me`.`start`), EXTRACT(YEAR FROM `me`.`start`) FROM `HasDateOps` `me` GROUP BY EXTRACT(YEAR FROM `me`.`start`), EXTRACT(MONTH FROM `me`.`start`))
# SQLite
(SELECT "me".*, STRFTIME('%m', "me"."start"), STRFTIME('%Y', "me"."start") FROM "HasDateOps" "me" GROUP BY STRFTIME('%Y', "me"."start"), STRFTIME('%m', "me"."start"))
=head1 DESCRIPTION
See L<DBIx::Class::Helper::ResultSet/NOTE> for a nice way to apply it
to your entire schema.
This ResultSet component gives the user tools to do B<mostly> portable date
manipulation in the database. Before embarking on a cross database project,
take a look at L</IMPLEMENTATION> to see what might break on switching
databases.
This package has a few types of methods.
=over
=item Search Shortcuts
These, like typical ResultSet methods, return another ResultSet. See
L</dt_before>, L</dt_on_or_before>, L</dt_on_or_after>, and L</dt_after>.
=item The date helper
There is only one: L</utc>. Makes searching with dates a little easier.
=item SQL generators
These help generate more complex queries. The can be used in many different
parts of L<DBIx::Class::ResultSet/search>. See L</utc_now>, L</dt_SQL_pluck>,
and L</dt_SQL_add>.
=back
=head1 TYPES
Because these methods are so limited in scope they can be a bit more smart
than typical C<SQL::Abstract> trees.
There are "smart types" that this package supports.
=over
=item * vanilla scalars (C<1>, C<2012-12-12 12:12:12>)
bound directly as untyped values
=item * hashrefs with an C<-ident> (C<< { -ident => '.foo' } >>)
As usual this gets flattened into a column. The one special feature in this
module is that columns starting with a dot will automatically be prefixed with
L<DBIx::Class::ResultSet/current_source_alias>.
=item * L<DateTime> objects
C<DateTime> objects work as if they were passed to L</utc>.
=item * C<ScalarRef> (C<< \'NOW()' >>)
As usual in C<DBIx::Class>, C<ScalarRef>'s will be flattened into regular SQL.
=item * C<ArrayRefRef> (C<< \["SELECT foo FROM bar WHERE id = ?", [{}, 1]] >>)
As usual in C<DBIx::Class>, C<ArrayRefRef>'s will be flattened into SQL with
bound values.
=back
Anything not mentioned in the above list will explode, one way or another.
=head1 IMPLEMENTATION
=encoding utf8
The exact details for the functions your database engine provides.
If a piece of functionality is flagged with ⚠, it means that the feature in
question is not portable at all, and only supported on that engine.
=head2 C<SQL Server>
=over
=item * L</utc_now> - L<GETUTCDATE|http://msdn.microsoft.com/en-us/library/ms178635.aspx>
=item * L</dt_SQL_pluck> - L<DATEPART|http://msdn.microsoft.com/en-us/library/ms174420.aspx>
Supported units
=over
=item * year
=item * quarter
=item * month
=item * day_of_year
=item * day_of_month
=item * week
=item * day_of_week
=item * hour
=item * minute
=item * second
=item * millisecond
=item * nanosecond ⚠
=item * non_iso_day_of_week
SQL Server offers both C<ISO_WEEK> and C<weekday>. For interop reasons
C<weekday> uses the C<ISO_WEEK> version.
=item * timezone_as_minutes ⚠
=back
=item * L</dt_SQL_add> - L<DATEADD|http://msdn.microsoft.com/en-us/library/ms186819.aspx>
Supported units
=over
=item * year
=item * quarter
=item * month
=item * day
=item * week
=item * hour
=item * minute
=item * second
=item * millisecond
=item * nanosecond ⚠
=item * iso_day_of_week
=item * timezone_as_minutes ⚠
=back
=back
=head2 C<SQLite>
=over
=item * L</utc_now> - L<DATETIME('now')|https://www.sqlite.org/lang_datefunc.html>
=item * L</dt_SQL_pluck> - L<STRFTIME|https://www.sqlite.org/lang_datefunc.html>
Note: C<SQLite>'s pluck implementation pads numbers with zeros, because it is
implemented on based on a formatting function. If you want your code to work
on SQLite you'll need to strip off (or just numify) what you get out of the
database first.
Available units
=over
=item * month
=item * day_of_month
=item * year
=item * hour
=item * day_of_year
=item * minute
=item * second
=item * day_of_week
=item * week
=item * julian_day ⚠
=item * seconds_since_epoch
=item * fractional_seconds ⚠
=back
=item * L</dt_SQL_add> - L<DATETIME|https://www.sqlite.org/lang_datefunc.html>
Available units
=over
=item * day
=item * hour
=item * minute
=item * second
=item * month
=item * year
=back
=back
=head2 C<PostgreSQL>
=over
=item * L</utc_now> - L<CURRENT_TIMESTAMP|http://www.postgresql.org/docs/current/static/functions-datetime.html#FUNCTIONS-DATETIME-CURRENT>
=item * L</dt_SQL_pluck> - L<date_part|http://www.postgresql.org/docs/current/static/functions-datetime.html#FUNCTIONS-DATETIME-EXTRACT>
Available units
=over
=item * century ⚠
=item * decade ⚠
=item * day_of_month
=item * day_of_week
=item * day_of_year
=item * seconds_since_epoch
=item * hour
=item * iso_day_of_week
=item * iso_year
=item * microsecond
=item * millenium ⚠
=item * millisecond
=item * minute
=item * month
=item * quarter
=item * second
=item * timezone ⚠
=item * timezone_hour ⚠
=item * timezone_minute ⚠
=item * week
=item * year
=back
=item * L</dt_SQL_add> - Addition and L<interval|http://www.postgresql.org/docs/current/static/functions-datetime.html#OPERATORS-DATETIME-TABLE>
To be clear, it ends up looking like:
C<< ("some_column" + 5 * interval '1 minute') >>
Available units
=over
=item * century ⚠
=item * decade ⚠
=item * day
=item * hour
=item * microsecond ⚠
=item * millisecond
=item * minute
=item * month
=item * second
=item * week
=item * year
=back
=back
=head2 C<MySQL>
=over
=item * L</utc_now> - L<UTC_TIMESTAMP|https://dev.mysql.com/doc/refman/5.1/en/date-and-time-functions.html#function_utc-timestamp>
=item * L</dt_SQL_pluck> - L<EXTRACT|https://dev.mysql.com/doc/refman/5.1/en/date-and-time-functions.html#function_extract>
Available units
=over
=item * microsecond
=item * second
=item * minute
=item * hour
=item * day_of_month
=item * week
=item * month
=item * quarter
=item * year
=item * second_microsecond ⚠
=item * minute_microsecond ⚠
=item * minute_second ⚠
=item * hour_microsecond ⚠
=item * hour_second ⚠
=item * hour_minute ⚠
=item * day_microsecond ⚠
=item * day_second ⚠
=item * day_minute ⚠
=item * day_hour ⚠
=item * year_month ⚠
=back
=item * L</dt_SQL_add> - L<DATE_ADD|https://dev.mysql.com/doc/refman/5.1/en/date-and-time-functions.html#function_date-add>
Available units
=over
=item * microsecond
=item * second
=item * minute
=item * hour
=item * day
=item * week
=item * month
=item * quarter
=item * year
=back
=back
=head2 C<Oracle>
B<< ORACLE USERS BEWARE >>: I run all the tests on all of the databases
B<except> C<Oracle>. If you have time to help make
L<dockerprove|https://github.com/frioux/DBIx-Class-Helpers/blob/master/dockerprove>
and/or L<travisci|https://github.com/frioux/DBIx-Class-Helpers/blob/master/.travis.yml>
test against C<Oracle> I'll gladly take those patches. For hints look at
L<https://index.docker.io/u/wnameless/oracle-xe-11g/> and
L<https://github.com/dbsrgits/dbix-class/commit/003e97c53e065e7497a4946c29d5a94e7cf34389>.
=over
=item * L</utc_now> - L<sys_extract_utc(SYSTIMESTAMP)|http://docs.oracle.com/cd/B19306_01/server.102/b14200/functions167.htm>
=item * L</dt_SQL_pluck> - L<EXTRACT|docs.oracle.com/cd/B19306_01/server.102/b14200/functions050.htm>
Available units
=over
=item * second
=item * minute
=item * hour
=item * day_of_month
=item * month
=item * year
=back
=item * L</dt_SQL_add> - Addition and L<NUMTODSINTERVAL|http://docs.oracle.com/cd/B19306_01/server.102/b14200/functions103.htm>
To be clear, it ends up looking like:
C<< ("some_column" + NUMTODSINTERVAL(4, 'MINUTE') >>
Available units
=over
=item * second
=item * minute
=item * hour
=item * day
=back
=back
=head1 CONTRIBUTORS
These people worked on the original implementation, and thus deserve some
credit for at least providing me a reference to implement this based off of:
=over
=item Alexander Hartmaier (abraxxa) for Oracle implementation details
=item Devin Austin (dhoss) for Pg implementation details
=item Rafael Kitover (caelum) for providing a test environment with lots of DBs
=back
=head1 WHENCE dt_SQL_diff?
The original implementation of these date helpers (originally dubbed date
operators) included a third operator called C<"diff">. It existed to
subtract one date from another and return a duration. After using it a few
times and getting bitten every time, I decided to stop using it and instead
compare against actual dates always. If someone can come up with a good use
case I am interested in re-implementing C<dt_SQL_diff>, but I worry that it
will be very unportable and generally not very useful.
=head1 METHODS
=head2 utc
$rs->search({
'some_date' => $rs->utc($datetime),
})->all
Takes a L<DateTime> object, updates the C<time_zone> to C<UTC>, and formats it
according to whatever database engine you are using.
Dies if you pass it a date with a C<< floating time_zone >>.
=head2 utc_now
Returns a C<ScalarRef> representing the way to get the current date and time
in C<UTC> for whatever database engine you are using.
=head2 dt_before
$rs->dt_before({ -ident => '.start' }, { -ident => '.end' })->all
Takes two values, each an expression of L</TYPES>.
=head2 dt_on_or_before
$rs->dt_on_or_before({ -ident => '.start' }, DateTime->now)->all
Takes two values, each an expression of L</TYPES>.
=head2 dt_on_or_after
$rs->dt_on_or_after(DateTime->now, { ident => '.end' })->all
Takes two values, each an expression of L</TYPES>.
=head2 dt_after
$rs->dt_after({ ident => '.end' }, $rs->get_column('datecol')->as_query)->all
Takes two values, each an expression of L</TYPES>.
=head2 dt_SQL_add
# which ones start in 3 minutes?
$rs->dt_on_or_after(
{ ident => '.start' },
$rs->dt_SQL_add($rs->utc_now, 'minute', 3)
)->all
Takes three arguments: a date conforming to L</TYPES>, a unit, and an amount.
The idea is to add the given unit to the datetime. See your L</IMPLEMENTATION>
for what units are accepted.
=head2 dt_SQL_pluck
# get count per year
$rs->search(undef, {
columns => {
count => '*',
year => $rs->dt_SQL_pluck({ -ident => '.start' }, 'year'),
},
group_by => [$rs->dt_SQL_pluck({ -ident => '.start' }, 'year')],
})->hri->all
Takes two arguments: a date conforming to L</TYPES> and a unit. The idea
is to pluck a given unit from the datetime. See your L</IMPLEMENTATION>
for what units are accepted.
=head1 AUTHOR
Arthur Axel "fREW" Schmidt <frioux+cpan@gmail.com>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015 by Arthur Axel "fREW" Schmidt.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut