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