File Coverage

blib/lib/Hades/Myths.pm
Criterion Covered Total %
statement 48 55 87.2
branch 13 24 54.1
condition 5 13 38.4
subroutine 10 12 83.3
pod 2 2 100.0
total 78 106 73.5


line stmt bran cond sub pod time code
1             package Hades::Myths;
2 14     14   68043 use strict;
  14         37  
  14         419  
3 14     14   82 use warnings;
  14         43  
  14         378  
4 14     14   7311 use POSIX qw/locale_h/;
  14         88049  
  14         77  
5             our $VERSION = 0.19;
6             our ($STASH);
7              
8             sub new {
9 4 100   4 1 7478 my ( $cls, %args ) = ( shift(), scalar @_ == 1 ? %{ $_[0] } : @_ );
  3         12  
10 4         10 my $self = bless {}, $cls;
11 4         8 my %accessors = ();
12 4         12 for my $accessor ( keys %accessors ) {
13             my $param
14             = defined $args{$accessor}
15             ? $args{$accessor}
16 0 0       0 : $accessors{$accessor}->{default};
17             my $value
18             = $self->$accessor( $accessors{$accessor}->{builder}
19 0 0       0 ? $accessors{$accessor}->{builder}->( $self, $param )
20             : $param );
21 0 0 0     0 unless ( !$accessors{$accessor}->{required} || defined $value ) {
22 0         0 die "$accessor accessor is required";
23             }
24             }
25 4         24 return $self;
26             }
27              
28             sub import {
29 16     16   738 my ( $self, $locales, @additional ) = @_;
30 16 100       70 if ( defined $locales ) {
31 15 100 100     103 if ( ( ref($locales) || "" ) ne "HASH" ) {
32 2         22 die
33             qq{Optional[HashRef]: invalid value $locales for variable \$locales in method import};
34             }
35             }
36 14         42 my $caller = caller();
37 14   50     97 $STASH = delete $locales->{stash} || 'Hades::Myths::Object';
38 14         830 eval "require $STASH";
39             my ( $locale, $lang, $fb ) = $STASH->convert_locale(
40             delete $locales->{locale} || setlocale(LC_CTYPE),
41             , delete $locales->{fb},
42 14   33     232 );
43 14         41 my $as_keyword = delete $locales->{as_keywords};
44 14 50 33     67 $locales = undef if ( !ref $locales || !scalar keys %{$locales} );
  14         69  
45 14 50       101 my ($new) = $STASH->new(
    50          
    50          
    50          
46             ( defined $fb ? ( fb => $fb ) : () ),
47             ( defined $lang ? ( language => $lang ) : () ),
48             ( defined $locale ? ( locale => $locale ) : () ),
49             ( defined $locales ? ( locales => $locales ) : () ),
50             @additional
51             );
52             {
53 14     14   26449 no strict "refs";
  14         33  
  14         672  
  14         31  
54 14     14   96 no warnings "redefine";
  14         27  
  14         1357  
55 14     0   71 *{"${caller}::locales"} = sub {$new};
  14         86  
  0         0  
56 14 100       66 if ($as_keyword) {
57 13         25 for my $key ( keys %{ $new->locales } ) {
  13         51  
58 14     14   100 no strict "refs";
  14         29  
  14         481  
59 14     14   79 no warnings "redefine";
  14         25  
  14         2792  
60 650     912   1987 *{"${caller}::${key}"} = sub { $new->string( $key, @_ ); };
  650         4485  
  912         2415  
61             }
62             }
63             };
64             }
65              
66             sub new_object {
67 0     0 1   my ( $self, %object ) = @_;
68              
69 0           return $STASH->new(%object);
70              
71             }
72              
73             1;
74              
75             __END__
76              
77             =head1 NAME
78              
79             Hades::Myths - error handling for hades.
80              
81             =head1 VERSION
82              
83             Version 0.01
84              
85             =cut
86              
87             =head1 SYNOPSIS
88              
89             use Hades::Myths;
90              
91             say stranger;
92             die locales->stranger;
93              
94             =head1 SUBROUTINES/METHODS
95              
96             =head2 new
97              
98             Instantiate a new Hades::Myths object.
99              
100             Hades::Myths->new
101              
102             =head2 import
103              
104             call import method. Expects param $locales to be a Optional[HashRef], param @additional to be any value including undef.
105              
106             $obj->import($locales, @additional)
107              
108             =head2 new_object
109              
110             Accepts a list of arguments that are used to build a new Hades::Myths::Object.
111            
112              
113             Hades::Myths::Object->new_object(
114             locale => $locale,
115             locales => {
116             %locales
117             }
118             );
119            
120              
121             =head1 AUTHOR
122              
123             LNATION, C<< <email at lnation.org> >>
124              
125             =head1 BUGS
126              
127             Please report any bugs or feature requests to C<bug-hades::myths at rt.cpan.org>, or through
128             the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Hades-Myths>. I will be notified, and then you'll
129             automatically be notified of progress on your bug as I make changes.
130              
131             =head1 SUPPORT
132              
133             You can find documentation for this module with the perldoc command.
134              
135             perldoc Hades::Myths
136              
137             You can also look for information at:
138              
139             =over 4
140              
141             =item * RT: CPAN's request tracker (report bugs here)
142              
143             L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Hades-Myths>
144              
145             =item * AnnoCPAN: Annotated CPAN documentation
146              
147             L<http://annocpan.org/dist/Hades-Myths>
148              
149             =item * CPAN Ratings
150              
151             L<https://cpanratings.perl.org/d/Hades-Myths>
152              
153             =item * Search CPAN
154              
155             L<https://metacpan.org/release/Hades-Myths>
156              
157             =back
158              
159             =head1 ACKNOWLEDGEMENTS
160              
161             =head1 LICENSE AND COPYRIGHT
162              
163             This software is Copyright (c) 2020 by LNATION.
164              
165             This is free software, licensed under:
166              
167             The Artistic License 2.0 (GPL Compatible)
168              
169             =cut
170              
171