File Coverage

blib/lib/DateTimeX/Format/CustomPattern.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package DateTimeX::Format::CustomPattern;
2 1     1   6417 use Moose::Role;
  0            
  0            
3              
4             use strict;
5             use warnings;
6              
7             use Carp;
8              
9             use namespace::clean -except => 'meta';
10              
11             has 'pattern' => (
12             isa => 'Maybe[Str]'
13             , is => 'rw'
14             , required => 1
15             , predicate => 'has_pattern'
16             );
17              
18             around 'parse_datetime' => sub {
19             my ( $sub, $self, $time, $env, @args ) = @_;
20              
21             croak "The key 'override' is not present in the env HashRef"
22             unless exists $env->{override}
23             ;
24             croak '"time" is a required argument "time" for ->parse_datetime($time ...);'
25             unless defined $time;
26             ;
27              
28             ## Set Pattern: from args, then from object
29             my $pattern;
30             if ( defined $env->{override}{pattern} ) {
31             $pattern = $env->{override}{pattern}
32             }
33             elsif ( $self->has_pattern ) {
34             $pattern = $self->pattern;
35             }
36             else {
37             croak "No pattern supplied to constructor or the call to parse_datetime"
38             }
39              
40             $env->{ pattern } = $pattern;
41            
42             ## Calls the sub ( time, env, addtl args )
43             my $dt = $self->$sub( $time , $env , @args );
44              
45             };
46              
47             ## KEEP IT HERE -- Roles in this care *ARE* order specific
48             with 'DateTimeX::Format';
49              
50             1;
51              
52             __END__
53              
54             =head1 NAME
55              
56             DateTimeX::Format::CustomPattern - A Moose::Role for building DateTime Formats that require patterns
57              
58             =head1 DESCRIPTION
59              
60             It adds an attribute "pattern", and behavies consistant with the call-overriding environment of L<DateTimeX::Format>.
61              
62             =head1 SYNOPSIS
63            
64             package DateTimeX::Format::RequiresPattern;
65             use Moose;
66             with 'DateTimeX::Format::CustomPattern';
67              
68             package main;
69              
70             my $dt = DateTimeX::Format::RequiresPattern->new({
71             locale => $locale
72             , time_zone => $timezone
73             , pattern => '%H:%M:%S'
74             , debug => 0|1
75             , defaults => 0|1
76             });
77              
78             $dt->parse_datetime( $time, {pattern => '%H:%M'} );
79              
80             =head1 OBJECT ENVIRONMENT
81              
82             All of these slots correspond to your object environment: they can be supplied in the constructor, or through accessors.
83              
84             =over 4
85              
86             =item * pattern( $str )
87              
88             Can be overridden in the call to ->parse_datetime.
89              
90             =back