The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package DBIx::Class::InflateColumn::DateTime::Duration;

=head1 NAME

DBIx::Class::InflateColumn::DateTime::Duration - Auto create 
DateTime::Duration objects from columns

=head1 SYNOPSIS

Load this component and then declare one or more columns as duration columns.

  package Holiday;
  __PACKAGE__->load_components(qw/InflateColumn::DateTime::Duration Core/);
  __PACKAGE__->add_columns(
      length => {
          datatype      => 'varchar',
          size          => 255,
          is_nullable   => 1,
          is_duration   => 1,
      },
  );

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

  print 'days: ', $holiday->length->delta_days, "\n";
  print 'hours: ', $holiday->length->delta_hours, "\n";

=head1 DESCRIPTION

This module inflates/deflates designated columns into L<DateTime::Duration> objects.

=cut

use strict;
use warnings;

our $VERSION = '0.01002';

use base qw(DBIx::Class);

use Try::Tiny;
use DateTime::Format::Duration::XSD;

=head1 METHODS

=head2 register_column

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

=cut

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

    return unless defined $info->{is_duration};

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

                if ($value) {
                    my $parser = DateTime::Format::Duration::XSD->new;

                    try {
                        $duration = $parser->parse_duration($value);
                    }
                    catch {
                        $self->throw_exception('Could not parse duration from ' . $value);
                    }
                }

                return $duration;
            },
            deflate => sub {
                my ($value, $obj) = @_;

                return unless (ref $value eq 'DateTime::Duration');

                my $parser = DateTime::Format::Duration::XSD->new;

                return $parser->format_duration($value);
            },
        }
    );
}

=head1 SEE ALSO

L<DateTime::Duration>,
L<DBIx::Class::InflateColumn>,
L<DBIx::Class>.

=head1 AUTHOR

Pete Smith, E<lt>pete@cubabit.netE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2010 by Pete Smith

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.1 or,
at your option, any later version of Perl 5 you may have available.

=cut

1;