File Coverage

blib/lib/DateTimeX/Format/CustomPattern.pm
Criterion Covered Total %
statement 18 18 100.0
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 24 24 100.0


line stmt bran cond sub pod time code
1             package DateTimeX::Format::CustomPattern;
2 1     1   2285 use Moose::Role;
  1         1  
  1         7  
3              
4 1     1   3436 use strict;
  1         1  
  1         18  
5 1     1   3 use warnings;
  1         2  
  1         23  
6              
7 1     1   2 use Carp;
  1         1  
  1         46  
8              
9 1     1   4 use namespace::clean -except => 'meta';
  1         1  
  1         7  
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\n"
22             unless exists $env->{override}
23             ;
24              
25             ## Set Pattern: from args, then from object
26             my $pattern = $env->{ override }->{ pattern }
27             // $self->has_pattern
28             ? $self->pattern
29             : croak "No pattern supplied to constructor or the call to parse_datetime"
30             ;
31              
32             $env->{ pattern } = $pattern;
33            
34             ## Calls the sub ( time, env, addtl args )
35             my $dt = $self->$sub( $time , $env , @args );
36              
37             };
38              
39 1     1   335 no Moose::Role;
  1         18  
  1         4  
40              
41             1;
42              
43             __END__
44              
45             =head1 NAME
46              
47             DateTimeX::Format::CustomPattern - A Moose::Role for building DateTime Formats that require patterns
48              
49             =head1 DESCRIPTION
50              
51             This role must be composed B<before> L<DateTimeX::Format>.
52              
53             It adds an attribute "pattern", and behavies consistant with the call-overriding environment of L<DateTimeX::Format>.
54              
55             =head1 SYNOPSIS
56            
57             package DateTimeX::Format::RequiresPattern;
58             with 'DateTimeX::Format::CustomPattern';
59             with 'DateTimeX::Format';
60              
61             package main;
62              
63             my $dt = DateTimeX::Format::RequiresPattern->new({
64             locale => $locale
65             , time_zone => $timezone
66             , pattern => '%H:%M:%S'
67             , debug => 0|1
68             , defaults => 0|1
69             });
70              
71             $dt->parse_datetime( $time, {pattern => '%H:%M'} );
72              
73             =head1 OBJECT ENVIRONMENT
74              
75             All of these slots correspond to your object environment: they can be supplied in the constructor, or through accessors.
76              
77             =over 4
78              
79             =item * pattern( $str )
80              
81             Can be overridden in the call to ->parse_datetime.
82              
83             =back