File Coverage

blib/lib/Acme/Nyaa.pm
Criterion Covered Total %
statement 96 128 75.0
branch 30 58 51.7
condition 8 20 40.0
subroutine 15 20 75.0
pod 5 13 38.4
total 154 239 64.4


line stmt bran cond sub pod time code
1             package Acme::Nyaa;
2 3     3   111376 use strict;
  3         7  
  3         103  
3 3     3   14 use warnings;
  3         5  
  3         73  
4 3     3   1099 use utf8;
  3         18  
  3         18  
5 3     3   124 use 5.010001;
  3         9  
  3         113  
6 3     3   2855 use Encode;
  3         25760  
  3         290  
7 3     3   3964 use Module::Load;
  3         3621  
  3         22  
8              
9 3     3   2482 use version; our $VERSION = qv('0.0.10');
  3         7006  
  3         20  
10             my $Default = 'ja';
11              
12             sub new {
13             # Constructor of Acme::Nyaa
14 5     5 1 2368 my $class = shift;
15 5         18 my $argvs = { @_ };
16              
17 5 100       34 return $class if ref $class eq __PACKAGE__;
18 3         11 $argvs->{'objects'} = [];
19 3   66     22 $argvs->{'language'} ||= $Default;
20 3         10 $argvs->{'loaded-languages'} = [];
21 3         124 $argvs->{'objectid'} = int rand 2**24;
22 3         11 $argvs->{'encoding'} = q();
23 3         9 $argvs->{'utf8flag'} = undef;
24              
25 3         24 my $nyaan = bless $argvs, __PACKAGE__;
26 3         25 my $klass = $nyaan->loadmodule( $argvs->{'language'} );
27 3         15 my $this1 = $nyaan->findobject( $klass, 1 );
28              
29 3         8 $nyaan->{'subclass'} = $klass;
30 3         11 return $nyaan;
31             }
32              
33             sub subclass {
34 2     2 0 2 my $self = shift;
35 2         16 return $self->{'subclass'};
36             }
37              
38             sub language {
39 5     5 0 889 my $self = shift;
40 5   66     29 my $lang = shift // $self->{'language'};
41              
42 5 100       39 return $self->{'language'} if $lang eq $self->{'language'};
43 2 100       16 return $self->{'language'} unless $lang =~ m/\A[a-zA-Z]{2}\z/;
44              
45 1         2 my $nekoobject = undef;
46 1         5 my $referclass = $self->loadmodule( $lang );
47 1 50       5 return $self->{'language'} unless length $referclass;
48 1 50       5 return $self->{'language'} if $referclass eq $self->subclass;
49              
50 0         0 $nekoobject = $self->findobject( $referclass, 1 );
51 0 0       0 return $self->{'language'} unless ref $nekoobject eq $referclass;
52              
53 0         0 $self->{'language'} = $lang;
54 0         0 $self->{'subclass'} = $referclass;
55 0         0 return $self->{'language'};
56             }
57              
58             sub objects {
59 2     2 0 4419 my $self = shift;
60 2   50     11 $self->{'objects'} ||= [];
61 2         10 return $self->{'objects'};
62             }
63              
64             sub cat {
65 0     0 1 0 my $self = shift;
66 0   0     0 my $text = shift // return q();
67 0         0 my $neko = $self->findobject( $self->subclass, 1 );
68              
69 0 0       0 return $text unless ref $neko;
70 0         0 return $neko->cat( $text );
71             }
72              
73             sub neko {
74 0     0 1 0 my $self = shift;
75 0   0     0 my $text = shift // return q();
76 0         0 my $neko = $self->findobject( $self->subclass, 1 );
77              
78 0 0       0 return $text unless ref $neko;
79 0         0 return $neko->neko( $text );
80             }
81              
82             sub nyaa {
83 0     0 1 0 my $self = shift;
84 0   0     0 my $text = shift // q();
85 0         0 my $neko = $self->findobject( $self->subclass, 1 );
86              
87 0 0       0 return $text unless ref $neko;
88 0         0 return $neko->nyaa( $text );
89             }
90              
91             sub straycat {
92 0     0 1 0 my $self = shift;
93 0   0     0 my $text = shift // return q();
94 0         0 my $neko = $self->findobject( $self->subclass, 1 );
95              
96 0 0       0 return $text unless ref $neko;
97 0         0 return $neko->straycat( $text );
98             }
99              
100             sub loadmodule {
101 4     4 0 9 my $self = shift;
102 4         5 my $lang = shift;
103 4         9 my $list = $self->{'loaded-languages'};
104              
105 4         18 my $referclass = __PACKAGE__.'::'.ucfirst( lc $lang );
106 4         11 my $alterclass = __PACKAGE__.'::'.ucfirst( $Default );
107              
108 4 50       33 return q() unless length $lang;
109 4 50       15 return $referclass if( grep { lc $lang eq $_ } @$list );
  1         6  
110              
111 4         6 eval {
112 4         19 Module::Load::load $referclass;
113 3         182 push @$list, lc $lang;
114             };
115              
116 4 100       1629 return $referclass unless $@;
117 1 50       3 return $alterclass if( grep { 'ja' eq $_ } @$list );
  1         12  
118              
119 0         0 Module::Load::load $alterclass;
120 0         0 push @$list, $Default;
121 0         0 return $alterclass;
122             }
123              
124             sub findobject {
125 5     5 0 451 my $self = shift;
126 5         8 my $name = shift;
127 5   100     17 my $new1 = shift || 0;
128 5         9 my $this = undef;
129 5   50     18 my $objs = $self->{'objects'} || [];
130              
131 5 50       15 return unless length $name;
132              
133 5         11 for my $e ( @$objs ) {
134              
135 2 50       11 next unless ref($e) eq $name;
136 2         5 $this = $e;
137             }
138 5 100       17 return $this if ref $this;
139 3 50       11 return unless $new1;
140              
141 3         24 $this = $name->new;
142 3         7 push @$objs, $this;
143 3         7 return $this;
144             }
145              
146             sub reckon {
147             # Implement at sub class
148 0     0 0 0 my $self = shift;
149 0         0 return $self->{'encoding'};
150             }
151              
152             sub toutf8 {
153 609     609 0 725 my $self = shift;
154 609         822 my $argv = shift;
155 609         741 my $text = undef;
156              
157 609 50       1361 $text = ref $argv ? $$argv : $argv;
158 609 50       1201 return $text unless length $text;
159              
160 609         1723 $self->reckon( \$text );
161 609 100       1886 return $text if $self->{'utf8flag'};
162 388 50       812 return $text unless $self->{'encoding'};
163              
164 388 50       3098 if( not $self->{'encoding'} =~ m/(?:ascii|utf8)/ ) {
165 0         0 Encode::from_to( $text, $self->{'encoding'}, 'utf8' );
166             }
167              
168 388 50       1933 $text = Encode::decode_utf8 $text unless utf8::is_utf8 $text;
169 388         7970 return $text;
170             }
171              
172             sub utf8to {
173 570     570 0 903 my $self = shift;
174 570         2124 my $argv = shift;
175 570         765 my $text = undef;
176              
177 570 50       1063 $text = ref $argv ? $$argv : $argv;
178 570 50       1405 return $text unless $self->{'encoding'};
179 570 50       1319 return $text unless length $text;
180              
181 570 50       2423 $text = Encode::encode_utf8 $text if utf8::is_utf8 $text;
182 570 50       3698 if( $self->{'encoding'} ne 'utf8' ) {
183 0         0 Encode::from_to( $text, 'utf8', $self->{'encoding'} );
184             }
185              
186 570         3002 return $text;
187             }
188              
189             1;
190             __END__