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__ |