File Coverage

lib/DBIx/Class/InflateColumn/DateTime/Duration.pm
Criterion Covered Total %
statement 30 31 96.7
branch 4 6 66.6
condition n/a
subroutine 8 8 100.0
pod 1 1 100.0
total 43 46 93.4


line stmt bran cond sub pod time code
1             package DBIx::Class::InflateColumn::DateTime::Duration;
2              
3             =head1 NAME
4              
5             DBIx::Class::InflateColumn::DateTime::Duration - Auto create
6             DateTime::Duration objects from columns
7              
8             =head1 SYNOPSIS
9              
10             Load this component and then declare one or more columns as duration columns.
11              
12             package Holiday;
13             __PACKAGE__->load_components(qw/InflateColumn::DateTime::Duration Core/);
14             __PACKAGE__->add_columns(
15             length => {
16             datatype => 'varchar',
17             size => 255,
18             is_nullable => 1,
19             is_duration => 1,
20             },
21             );
22              
23             Then you can treat the specified column as a L<DateTime::Duration> object.
24              
25             print 'days: ', $holiday->length->delta_days, "\n";
26             print 'hours: ', $holiday->length->delta_hours, "\n";
27              
28             =head1 DESCRIPTION
29              
30             This module inflates/deflates designated columns into L<DateTime::Duration> objects.
31              
32             =cut
33              
34 1     1   40163 use strict;
  1         3  
  1         30  
35 1     1   9 use warnings;
  1         2  
  1         55  
36              
37             our $VERSION = '0.01002';
38              
39 1     1   7 use base qw(DBIx::Class);
  1         6  
  1         83  
40              
41 1     1   9 use Try::Tiny;
  1         1  
  1         66  
42 1     1   1260 use DateTime::Format::Duration::XSD;
  1         12679  
  1         231  
43              
44             =head1 METHODS
45              
46             =head2 register_column
47              
48             Chains with the "register_column" in L<DBIx::Class::Row> method, and sets up duration
49             columns appropriately. This would not normally be directly called by end users.
50              
51             =cut
52              
53             sub register_column {
54 3     3 1 107121 my ($self, $column, $info, @rest) = @_;
55 3         14 $self->next::method($column, $info, @rest);
56              
57 3 100       1490 return unless defined $info->{is_duration};
58              
59             $self->inflate_column(
60             $column => {
61             inflate => sub {
62 5     5   486798 my ($value, $obj) = @_;
63 5         10 my $duration;
64              
65 5 50       13 if ($value) {
66 5         32 my $parser = DateTime::Format::Duration::XSD->new;
67              
68             try {
69 5         214 $duration = $parser->parse_duration($value);
70             }
71             catch {
72 0         0 $self->throw_exception('Could not parse duration from ' . $value);
73             }
74 5         292 }
75              
76 5         987 return $duration;
77             },
78             deflate => sub {
79 1     1   2684 my ($value, $obj) = @_;
80              
81 1 50       5 return unless (ref $value eq 'DateTime::Duration');
82              
83 1         5 my $parser = DateTime::Format::Duration::XSD->new;
84              
85 1         61 return $parser->format_duration($value);
86             },
87             }
88 1         24 );
89             }
90              
91             =head1 SEE ALSO
92              
93             L<DateTime::Duration>,
94             L<DBIx::Class::InflateColumn>,
95             L<DBIx::Class>.
96              
97             =head1 AUTHOR
98              
99             Pete Smith, E<lt>pete@cubabit.netE<gt>
100              
101             =head1 COPYRIGHT AND LICENSE
102              
103             Copyright (C) 2010 by Pete Smith
104              
105             This library is free software; you can redistribute it and/or modify
106             it under the same terms as Perl itself, either Perl version 5.10.1 or,
107             at your option, any later version of Perl 5 you may have available.
108              
109             =cut
110              
111             1;
112