line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Text::Distill; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
13121
|
use 5.006001; |
|
1
|
|
|
|
|
2
|
|
4
|
1
|
|
|
1
|
|
3
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
18
|
|
5
|
1
|
|
|
1
|
|
3
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
19
|
|
6
|
1
|
|
|
1
|
|
380
|
use Digest::JHash; |
|
1
|
|
|
|
|
414
|
|
|
1
|
|
|
|
|
40
|
|
7
|
1
|
|
|
1
|
|
169
|
use XML::LibXML; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
use XML::LibXSLT; |
9
|
|
|
|
|
|
|
use Text::Extract::Word; |
10
|
|
|
|
|
|
|
use HTML::TreeBuilder; |
11
|
|
|
|
|
|
|
use OLE::Storage_Lite; |
12
|
|
|
|
|
|
|
use Text::Unidecode v1.27; |
13
|
|
|
|
|
|
|
use Unicode::Normalize v1.25; |
14
|
|
|
|
|
|
|
use Encode::Detect; |
15
|
|
|
|
|
|
|
use Encode; |
16
|
|
|
|
|
|
|
use Archive::Zip qw( :ERROR_CODES :CONSTANTS ); |
17
|
|
|
|
|
|
|
use Carp; |
18
|
|
|
|
|
|
|
use LWP::UserAgent; |
19
|
|
|
|
|
|
|
use JSON::XS; |
20
|
|
|
|
|
|
|
use File::Temp; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
Archive::Zip::setErrorHandler(sub{}); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
our (@ISA, @EXPORT_OK); |
25
|
|
|
|
|
|
|
BEGIN { |
26
|
|
|
|
|
|
|
require Exporter; |
27
|
|
|
|
|
|
|
@ISA = qw(Exporter); |
28
|
|
|
|
|
|
|
@EXPORT_OK = qw( |
29
|
|
|
|
|
|
|
Distill |
30
|
|
|
|
|
|
|
LikeSoundex |
31
|
|
|
|
|
|
|
TextToGems |
32
|
|
|
|
|
|
|
DetectBookFormat |
33
|
|
|
|
|
|
|
ExtractSingleZipFile |
34
|
|
|
|
|
|
|
CheckIfTXT |
35
|
|
|
|
|
|
|
CheckIfFB2 |
36
|
|
|
|
|
|
|
CheckIfFB3 |
37
|
|
|
|
|
|
|
CheckIfDocx |
38
|
|
|
|
|
|
|
CheckIfEPub |
39
|
|
|
|
|
|
|
CheckIfDoc |
40
|
|
|
|
|
|
|
CheckIfTXTZip |
41
|
|
|
|
|
|
|
CheckIfFB2Zip |
42
|
|
|
|
|
|
|
CheckIfDocxZip |
43
|
|
|
|
|
|
|
CheckIfEPubZip |
44
|
|
|
|
|
|
|
CheckIfDocZip |
45
|
|
|
|
|
|
|
ExtractTextFromEPUBFile |
46
|
|
|
|
|
|
|
ExtractTextFromDOCXFile |
47
|
|
|
|
|
|
|
ExtractTextFromDocFile |
48
|
|
|
|
|
|
|
ExtractTextFromTXTFile |
49
|
|
|
|
|
|
|
ExtractTextFromFB2File |
50
|
|
|
|
|
|
|
ExtractTextFromFB3File |
51
|
|
|
|
|
|
|
GetFB2GemsFromFile |
52
|
|
|
|
|
|
|
GemsValidate |
53
|
|
|
|
|
|
|
); # symbols to export on request |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
my $XSL_FB2_2_String = q{ |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
xmlns:fb="http://www.gribuser.ru/xml/fictionbook/2.0"> |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
fb:title| |
67
|
|
|
|
|
|
|
fb:subtitle| |
68
|
|
|
|
|
|
|
fb:p| |
69
|
|
|
|
|
|
|
fb:epigraph| |
70
|
|
|
|
|
|
|
fb:cite| |
71
|
|
|
|
|
|
|
fb:text-author| |
72
|
|
|
|
|
|
|
fb:date| |
73
|
|
|
|
|
|
|
fb:poem| |
74
|
|
|
|
|
|
|
fb:stanza| |
75
|
|
|
|
|
|
|
fb:v| |
76
|
|
|
|
|
|
|
fb:image[parent::fb:body]| |
77
|
|
|
|
|
|
|
fb:code"> |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
}; |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
my $XSL_FB3_2_String = q{ |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
xmlns:fb="http://www.fictionbook.org/FictionBook3/body" |
86
|
|
|
|
|
|
|
xmlns:fbd="http://www.fictionbook.org/FictionBook3/description"> |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
fb:p| |
94
|
|
|
|
|
|
|
fb:li| |
95
|
|
|
|
|
|
|
fb:page-break-type"> |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
- |
103
|
|
|
|
|
|
|
}; |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
my $XSL_Docx_2_Txt = q{ |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
xmlns:w="http://schemas.openxmlformats.org/wordprocessingml/2006/main"> |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
}; |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
our $MinPartSize = 150; |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
# Гласные и прочие буквы \w, которые нас, тем не менее, не волнуют |
130
|
|
|
|
|
|
|
my $SoundexExpendable = qr/уеёыаоэяиюьъaehiouwy/i; |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
# Статистически подобранные "буквосочетания", бьющие тексты на на куски по ~20к |
133
|
|
|
|
|
|
|
# отбиралось по языкам: ru en it de fr es pl be cs sp lv |
134
|
|
|
|
|
|
|
# в теории этот набор должен более-менее ровно нарезать любой текст на куски по ~2к |
135
|
|
|
|
|
|
|
our @SplitChars = qw(3856 6542 4562 6383 4136 2856 4585 5512 |
136
|
|
|
|
|
|
|
2483 5426 2654 3286 5856 4245 4135 4515 4534 8312 5822 5316 1255 8316 5842); |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
my @DetectionOrder = qw /epub.zip epub docx.zip docx doc.zip doc fb2.zip fb2 fb3 txt.zip txt/; |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
my $Detectors = { |
142
|
|
|
|
|
|
|
'fb2.zip' => \&CheckIfFB2Zip, |
143
|
|
|
|
|
|
|
'fb2' => \&CheckIfFB2, |
144
|
|
|
|
|
|
|
'fb3' => \&CheckIfFB3, |
145
|
|
|
|
|
|
|
'doc.zip' => \&CheckIfDocZip, |
146
|
|
|
|
|
|
|
'doc' => \&CheckIfDoc, |
147
|
|
|
|
|
|
|
'docx.zip' => \&CheckIfDocxZip, |
148
|
|
|
|
|
|
|
'docx' => \&CheckIfDocx, |
149
|
|
|
|
|
|
|
'epub.zip' => \&CheckIfEPubZip, |
150
|
|
|
|
|
|
|
'epub' => \&CheckIfEPub, |
151
|
|
|
|
|
|
|
'txt.zip' => \&CheckIfTXTZip, |
152
|
|
|
|
|
|
|
'txt' => \&CheckIfTXT |
153
|
|
|
|
|
|
|
}; |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
our $Extractors = { |
156
|
|
|
|
|
|
|
'fb2' => \&ExtractTextFromFB2File, |
157
|
|
|
|
|
|
|
'fb3' => \&ExtractTextFromFB3File, |
158
|
|
|
|
|
|
|
'txt' => \&ExtractTextFromTXTFile, |
159
|
|
|
|
|
|
|
'doc' => \&ExtractTextFromDocFile, |
160
|
|
|
|
|
|
|
'docx' => \&ExtractTextFromDOCXFile, |
161
|
|
|
|
|
|
|
'epub' => \&ExtractTextFromEPUBFile, |
162
|
|
|
|
|
|
|
}; |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
our $rxFormats = join '|', keys %$Detectors; |
165
|
|
|
|
|
|
|
$rxFormats =~ s/\./\\./g; |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
use constant FB3_META_REL => 'http://www.fictionbook.org/FictionBook3/relationships/Book'; |
168
|
|
|
|
|
|
|
use constant FB3_BODY_REL => 'http://www.fictionbook.org/FictionBook3/relationships/body'; |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=head1 NAME |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
Text::Distill - Quick texts compare, plagiarism and common parts detection |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=head1 VERSION |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
Version 0.07 |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=cut |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
our $VERSION = '0.07'; |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=head1 SYNOPSIS |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
use Text::Distill qw(Distill); |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
my $DistilledText1 = Distill($text1); |
189
|
|
|
|
|
|
|
my $DistilledText2 = Distill($text2); |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
$DistilledText1 eq $DistilledText2 ? print("Equal") : print("Not equal"); |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
or |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
use Text::Distill; |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
my $FileFormat = Text::Distill::DetectBookFormat($FilePath); |
198
|
|
|
|
|
|
|
die "Not a fb2.zip file" if $FileFormat ne 'fb2.zip'; |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
my $Text = Text::Distill::ExtractTextFromFB2File($FilePath); |
201
|
|
|
|
|
|
|
my $Gems = TextToGems($Text); |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
my $VURL = 'http://partnersdnld.litres.ru/copyright_check_by_gems/'; |
204
|
|
|
|
|
|
|
my $TextInfo = Text::Distill::GemsValidate($Gems,$VURL); |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
die "Copyright-protected content" if $TextInfo->{verdict} eq 'protected'; |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=head1 Distilling gems from text |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=head2 TextToGems($UTF8TextString) |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
Transforms a text (valid UTF8 expected) into an array of 32-bit hash-summs |
213
|
|
|
|
|
|
|
(Jenkins's Hash). Text is at first flattened the hard |
214
|
|
|
|
|
|
|
way (something like soundex, see Distill below), than splitted into fragments by statistically |
215
|
|
|
|
|
|
|
choosen sequences. First and the last fragments are rejected, short fragments are |
216
|
|
|
|
|
|
|
rejected as well, from remaining strings calc hashes and |
217
|
|
|
|
|
|
|
returns reference to them in the array. |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
What you really need to know is that TextToGem's from exactly the same texts are |
220
|
|
|
|
|
|
|
eqlal, texts with small changes have similar "gems" as well. And |
221
|
|
|
|
|
|
|
if two texts have 3+ common gems - they share some text parts, for sure. This is somewhat |
222
|
|
|
|
|
|
|
close to "Edit distance", but fast on calc and indexable. So you can effectively |
223
|
|
|
|
|
|
|
search for citings or plagiarism. Choosen split-method makes average detection |
224
|
|
|
|
|
|
|
segment about 2k of text (1-2 paper pages), so this package will not normally detect |
225
|
|
|
|
|
|
|
a single equal paragraph. If you need more precise match extended |
226
|
|
|
|
|
|
|
@Text::Distill::SplitChars with some |
227
|
|
|
|
|
|
|
sequences from SeqNumStats.xlsx on GitHub, I guiess you can get down to parts of |
228
|
|
|
|
|
|
|
about 300 chars without problems. Just don't forget to lower |
229
|
|
|
|
|
|
|
$Text::Distill::MinPartSize as well and keep in mind GemsValidate will break |
230
|
|
|
|
|
|
|
if you play with $MinPartSize and @SplitChars. |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
Should return about one 32-bit jHash from every 2kb of source text |
233
|
|
|
|
|
|
|
(may vary depending on the text thou). |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
my $Gems = TextToGems($String); |
236
|
|
|
|
|
|
|
print join(',',@$Gems); |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
=pod |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
=head2 Distill($UTF8TextString) |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
Transforming the text (valid UTF8 expected) into a sequence of 1-8 numbers |
244
|
|
|
|
|
|
|
(string as well). Internally used by TextToGems, but you may use it's output |
245
|
|
|
|
|
|
|
with standart "edit distance" algorithm, like L. Distilled string |
246
|
|
|
|
|
|
|
is shorter, so you math will go much faster. |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
At the end works somewhat close to 'soundex' with addition of some basic rules |
249
|
|
|
|
|
|
|
for cyrillic chars, pre- and post-cleanup and utf normalization. Drops strange |
250
|
|
|
|
|
|
|
sequences, drops short words as well (how are you going to make you plagiarism |
251
|
|
|
|
|
|
|
without copying the long words, huh?) |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
$Distilled = Distill($Text); # $Distilled should be ~60% shorter than $Text |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=head1 Remote validation |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
There is at least one open service to check your text against |
258
|
|
|
|
|
|
|
known text database, docs are here: L. |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
=head2 GemsValidate(\@Gems, $Url) |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
Checks your gems against remote database, returns overall verdict |
263
|
|
|
|
|
|
|
and a structure with info on found titles |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
=cut |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
sub GemsValidate { |
268
|
|
|
|
|
|
|
my $Gems = shift; |
269
|
|
|
|
|
|
|
my $Url = shift; |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
my $ua = new LWP::UserAgent; |
272
|
|
|
|
|
|
|
$ua->timeout(5); |
273
|
|
|
|
|
|
|
my $Response = $ua->post( $Url, {gems => join ",",@$Gems}); |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
my $Result; |
276
|
|
|
|
|
|
|
if ($Response->is_success) { |
277
|
|
|
|
|
|
|
return decode_json( $Response->decoded_content ); |
278
|
|
|
|
|
|
|
} else { |
279
|
|
|
|
|
|
|
die $Response->status_line; |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
# EXTRACT BLOCK |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
=head1 Service functions |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
=head2 ExtractTextFromFB2File($FilePath) |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
Function receives a path to the fb2-file and returns all significant text from the file as a string |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
=cut |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
sub ExtractTextFromFB2File { |
295
|
|
|
|
|
|
|
my $FN = shift; |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
my $parser = XML::LibXML->new(); |
298
|
|
|
|
|
|
|
my $xslt = XML::LibXSLT->new(); |
299
|
|
|
|
|
|
|
my $source = $parser->parse_file($FN); |
300
|
|
|
|
|
|
|
my $style_doc = $parser->load_xml(string => $XSL_FB2_2_String); |
301
|
|
|
|
|
|
|
my $stylesheet = $xslt->parse_stylesheet($style_doc); |
302
|
|
|
|
|
|
|
my $results = $stylesheet->transform($source); |
303
|
|
|
|
|
|
|
my $Out = $stylesheet->output_string($results); |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
return $Out; |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
=head2 ExtractTextFromFB2File($FilePath) |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
Function receives a path to the fb3-file and returns all significant text from the file as a string |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
=cut |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
sub ExtractTextFromFB3File { |
315
|
|
|
|
|
|
|
my $FN = shift; |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
unless( -e $FN ) { |
318
|
|
|
|
|
|
|
Carp::confess( "$FN doesn't exist" ); |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
# Prepare XML parser, XSLT stylesheet and XPath Context beforehand |
322
|
|
|
|
|
|
|
my $XML = XML::LibXML->new; |
323
|
|
|
|
|
|
|
my $StyleDoc = $XML->load_xml( string => $XSL_FB3_2_String ); |
324
|
|
|
|
|
|
|
my $Stylesheet = XML::LibXSLT->new->parse_stylesheet( $StyleDoc ); |
325
|
|
|
|
|
|
|
my $XC = XML::LibXML::XPathContext->new; |
326
|
|
|
|
|
|
|
$XC->registerNs( opcr => 'http://schemas.openxmlformats.org/package/2006/relationships' ); |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
# FB3 is ZIP archive following Open Packaging Conventions. Let's find FB3 Body in it |
329
|
|
|
|
|
|
|
my $Zip = Archive::Zip->new(); |
330
|
|
|
|
|
|
|
my $ReadStatus = $Zip->read( $FN ); |
331
|
|
|
|
|
|
|
unless( $ReadStatus == AZ_OK ) { |
332
|
|
|
|
|
|
|
Carp::confess "[Archive::Zip error] $!"; |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
# First we must find package Rels file |
335
|
|
|
|
|
|
|
my $PackageRelsXML = $Zip->contents( '_rels/.rels' ) |
336
|
|
|
|
|
|
|
or do{ $! = 11; Carp::confess 'Broken OPC package, no package Rels file (/_rels/.rels)' }; |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
# Next find FB3 meta relation(s) |
339
|
|
|
|
|
|
|
my $PackageRelsDoc = eval{ XML::LibXML->load_xml( string => $PackageRelsXML ) } |
340
|
|
|
|
|
|
|
or do{ $! = 11; Carp::confess "Invalid XML: $@" }; |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
my @RelationNodes = $XC->findnodes( |
343
|
|
|
|
|
|
|
'/opcr:Relationships/opcr:Relationship[@Type="'.FB3_META_REL.'"]', |
344
|
|
|
|
|
|
|
$PackageRelsDoc |
345
|
|
|
|
|
|
|
); |
346
|
|
|
|
|
|
|
unless( @RelationNodes ) { |
347
|
|
|
|
|
|
|
$! = 11; |
348
|
|
|
|
|
|
|
Carp::confess 'No relation to FB3 meta'; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
# There could be more than one book packed in FB3, so continue by parsing all the books found |
352
|
|
|
|
|
|
|
my $Result = ''; |
353
|
|
|
|
|
|
|
for my $RelationNode ( @RelationNodes ) { |
354
|
|
|
|
|
|
|
# Get FB3 meta name from relation |
355
|
|
|
|
|
|
|
my $MetaName = OPCPartAbsoluteNameFromRelative( $RelationNode->getAttribute('Target'), '/' ); |
356
|
|
|
|
|
|
|
# Name in zip has no leading slash and name in OPC has it. Remove leading slash from OPC name |
357
|
|
|
|
|
|
|
$MetaName =~ s:^/::; |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
# Get FB3 meta Rels file name |
360
|
|
|
|
|
|
|
my $MetaRelsName = $MetaName; |
361
|
|
|
|
|
|
|
$MetaRelsName =~ s:^(.*/)?([^/]*)$:${1}_rels/${2}.rels:; |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
my $MetaRelsXML = $Zip->contents( $MetaRelsName ) |
364
|
|
|
|
|
|
|
or do{ $! = 11; Carp::confess "No FB3 meta Rels file (expecting $MetaRelsName)" }; |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
# Next we get relation to FB3 body from FB3 meta Rels file |
367
|
|
|
|
|
|
|
my $MetaRelsDoc = eval{ $XML->load_xml( string => $MetaRelsXML ) } |
368
|
|
|
|
|
|
|
or do{ $! = 11; Carp::confess "Invalid XML: $@" }; |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
my( $BodyRelation ) = $XC->findnodes( |
371
|
|
|
|
|
|
|
'/opcr:Relationships/opcr:Relationship[@Type="'.FB3_BODY_REL.'"]', |
372
|
|
|
|
|
|
|
$MetaRelsDoc |
373
|
|
|
|
|
|
|
); |
374
|
|
|
|
|
|
|
unless( $BodyRelation ) { |
375
|
|
|
|
|
|
|
$! = 11; |
376
|
|
|
|
|
|
|
Carp::confess "No relation to FB3 body in $MetaRelsName"; |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
# Get FB3 body name from relation |
380
|
|
|
|
|
|
|
my $CurrentDir = $MetaName; |
381
|
|
|
|
|
|
|
$CurrentDir =~ s:/?[^/]*$::; |
382
|
|
|
|
|
|
|
my $BodyName = OPCPartAbsoluteNameFromRelative( |
383
|
|
|
|
|
|
|
$BodyRelation->getAttribute('Target'), |
384
|
|
|
|
|
|
|
"/$CurrentDir" # add leading slash (zip name to opc) |
385
|
|
|
|
|
|
|
); |
386
|
|
|
|
|
|
|
$BodyName =~ s:^/::; # remove leading slash (opc name to zip) |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
# Get FB3 body text |
389
|
|
|
|
|
|
|
my $BodyXML = $Zip->contents( $BodyName ) |
390
|
|
|
|
|
|
|
or do{ $! = 11; Carp::confess "No FB3 body (expecting $BodyName)" }; |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
# Transform it into plain text |
393
|
|
|
|
|
|
|
my $BodyDoc = $XML->load_xml( string => $BodyXML ); |
394
|
|
|
|
|
|
|
my $TransformResults = $Stylesheet->transform( $BodyDoc ); |
395
|
|
|
|
|
|
|
$Result .= $Stylesheet->output_string( $TransformResults ); |
396
|
|
|
|
|
|
|
} |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
return $Result; |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
=head2 ExtractTextFromTXTFile($FilePath) |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
Function receives a path to the text-file and returns all significant text from the file as a string |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
=cut |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
sub ExtractTextFromTXTFile { |
408
|
|
|
|
|
|
|
my $FN = shift; |
409
|
|
|
|
|
|
|
open(TEXTFILE, "<$FN"); |
410
|
|
|
|
|
|
|
my $String = join('', ); |
411
|
|
|
|
|
|
|
close TEXTFILE; |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
require Encode::Detect; |
414
|
|
|
|
|
|
|
return Encode::decode('Detect', $String); |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
=head2 ExtractTextFromDocFile($FilePath) |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
Function receives a path to the doc-file and returns all significant text from the file as a string |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
=cut |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
sub ExtractTextFromDocFile { |
425
|
|
|
|
|
|
|
my $FilePath = shift; |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
my $File = Text::Extract::Word->new($FilePath); |
428
|
|
|
|
|
|
|
my $Text = $File->get_text(); |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
return $Text; |
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
=head2 ExtractTextFromDOCXFile($FilePath) |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
Function receives a path to the docx-file and returns all significant text from the file as a string |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
=cut |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
sub ExtractTextFromDOCXFile { |
440
|
|
|
|
|
|
|
my $FN = shift; |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
my $Result; |
443
|
|
|
|
|
|
|
my $arch = Archive::Zip->new(); |
444
|
|
|
|
|
|
|
if ( $arch->read($FN) == AZ_OK ) { |
445
|
|
|
|
|
|
|
if (my $DocumentMember = $arch->memberNamed( 'word/document.xml' )) { |
446
|
|
|
|
|
|
|
my $XMLDocument = $DocumentMember->contents(); |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
my $xml = XML::LibXML->new(); |
449
|
|
|
|
|
|
|
my $xslt = XML::LibXSLT->new(); |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
my $Document; |
452
|
|
|
|
|
|
|
eval { $Document = $xml->parse_string($XMLDocument); }; |
453
|
|
|
|
|
|
|
if ($@) { |
454
|
|
|
|
|
|
|
$! = 11; |
455
|
|
|
|
|
|
|
Carp::confess("[libxml2 error ". $@->code() ."] ". $@->message()); |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
my $StyleDoc = $xml->load_xml(string => $XSL_Docx_2_Txt); |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
my $StyleSheet = $xslt->parse_stylesheet($StyleDoc); |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
my $TransformResult = $StyleSheet->transform($Document); |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
$Result = $StyleSheet->output_string($TransformResult); |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
} else { |
467
|
|
|
|
|
|
|
Carp::confess("[Archive::Zip error] $!"); |
468
|
|
|
|
|
|
|
} |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
return $Result; |
471
|
|
|
|
|
|
|
} |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
=head2 ExtractTextFromEPUBFile($FilePath) |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
Function receives a path to the epub-file and returns all significant text from the file as a string |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
=cut |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
sub ExtractTextFromEPUBFile { |
480
|
|
|
|
|
|
|
my $FN = shift; |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
my $Result; |
483
|
|
|
|
|
|
|
my $arch = Archive::Zip->new(); |
484
|
|
|
|
|
|
|
if ( $arch->read($FN) == AZ_OK ) { |
485
|
|
|
|
|
|
|
my $requiredMember = 'META-INF/container.xml'; |
486
|
|
|
|
|
|
|
if (my $ContainerMember = $arch->memberNamed( $requiredMember )) { |
487
|
|
|
|
|
|
|
my $XMLContainer = $ContainerMember->contents(); |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
my $xml = XML::LibXML->new; |
490
|
|
|
|
|
|
|
my $xpc = XML::LibXML::XPathContext->new(); |
491
|
|
|
|
|
|
|
$xpc->registerNs('opf', 'urn:oasis:names:tc:opendocument:xmlns:container'); |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
my $Container; |
494
|
|
|
|
|
|
|
eval { $Container = $xml->parse_string($XMLContainer); }; |
495
|
|
|
|
|
|
|
if ($@) { |
496
|
|
|
|
|
|
|
$! = 11; |
497
|
|
|
|
|
|
|
Carp::confess("[libxml2 error ". $@->code() ."] ". $@->message()); |
498
|
|
|
|
|
|
|
} |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
my ($ContainerNode) = $xpc->findnodes('//opf:container/opf:rootfiles/opf:rootfile', $Container); |
501
|
|
|
|
|
|
|
my $ContentPath = $ContainerNode->getAttributeNode('full-path')->string_value; |
502
|
|
|
|
|
|
|
if (my $ContentMember = $arch->memberNamed( $ContentPath )) { |
503
|
|
|
|
|
|
|
my $XMLContent = $ContentMember->contents(); |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
$xpc->unregisterNs('opf'); |
506
|
|
|
|
|
|
|
$xpc->registerNs('opf', 'http://www.idpf.org/2007/opf'); |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
my $Content; |
509
|
|
|
|
|
|
|
eval { $Content = $xml->parse_string($XMLContent); }; |
510
|
|
|
|
|
|
|
if ($@) { |
511
|
|
|
|
|
|
|
$! = 11; |
512
|
|
|
|
|
|
|
Carp::confess("[libxml2 error ". $@->code() ."] ". $@->message()); |
513
|
|
|
|
|
|
|
} |
514
|
|
|
|
|
|
|
my @ContentNodes = $xpc->findnodes('//opf:package/opf:manifest/opf:item[ |
515
|
|
|
|
|
|
|
@media-type="application/xhtml+xml" |
516
|
|
|
|
|
|
|
and |
517
|
|
|
|
|
|
|
starts-with(@id, "content") |
518
|
|
|
|
|
|
|
]', |
519
|
|
|
|
|
|
|
$Content |
520
|
|
|
|
|
|
|
); |
521
|
|
|
|
|
|
|
my $HTMLTree = HTML::TreeBuilder->new(); |
522
|
|
|
|
|
|
|
foreach my $ContentNode (@ContentNodes) { |
523
|
|
|
|
|
|
|
my $HTMLContentPath = $ContentNode->getAttributeNode('href')->string_value; |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
if (my $HTMLContentMember = $arch->memberNamed( $HTMLContentPath )) { |
526
|
|
|
|
|
|
|
my $HTMLContent = $HTMLContentMember->contents(); |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
$HTMLTree->parse_content($HTMLContent); |
529
|
|
|
|
|
|
|
} else { |
530
|
|
|
|
|
|
|
Carp::confess("[Archive::Zip error] $HTMLContentPath not found in ePub ZIP container"); |
531
|
|
|
|
|
|
|
} |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
$Result = DecodeUtf8($HTMLTree->as_text); |
534
|
|
|
|
|
|
|
} else { |
535
|
|
|
|
|
|
|
Carp::confess("[Archive::Zip error] $ContentPath not found in ePub ZIP container"); |
536
|
|
|
|
|
|
|
} |
537
|
|
|
|
|
|
|
} else { |
538
|
|
|
|
|
|
|
Carp::confess("[Archive::Zip error] $requiredMember not found in ePub ZIP container"); |
539
|
|
|
|
|
|
|
} |
540
|
|
|
|
|
|
|
} else { |
541
|
|
|
|
|
|
|
Carp::confess("[Archive::Zip error] $!"); |
542
|
|
|
|
|
|
|
} |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
return $Result; |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
sub OPCPartAbsoluteNameFromRelative { |
548
|
|
|
|
|
|
|
my $Name = shift; |
549
|
|
|
|
|
|
|
my $Dir = shift; |
550
|
|
|
|
|
|
|
$Dir =~ s:/$::; # remove trailing slash |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
my $FullName = ( $Name =~ m:^/: ) ? $Name : # $Name has absolute path |
553
|
|
|
|
|
|
|
"$Dir/$Name"; # $Name has relative path |
554
|
|
|
|
|
|
|
$FullName = do{ |
555
|
|
|
|
|
|
|
use bytes; # A-Za-z are case insensitive |
556
|
|
|
|
|
|
|
lc $FullName; |
557
|
|
|
|
|
|
|
}; |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
# parse all . and .. in name |
560
|
|
|
|
|
|
|
my @CleanedSegments; |
561
|
|
|
|
|
|
|
my @OriginalSegments = split m:/:, $FullName; |
562
|
|
|
|
|
|
|
for my $Part ( @OriginalSegments ) { |
563
|
|
|
|
|
|
|
if( $Part eq '.' ) { |
564
|
|
|
|
|
|
|
# just skip |
565
|
|
|
|
|
|
|
} elsif( $Part eq '..' ) { |
566
|
|
|
|
|
|
|
pop @CleanedSegments; |
567
|
|
|
|
|
|
|
} else { |
568
|
|
|
|
|
|
|
push @CleanedSegments, $Part; |
569
|
|
|
|
|
|
|
} |
570
|
|
|
|
|
|
|
} |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
return join '/', @CleanedSegments; |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
sub ExtractSingleZipFile { |
577
|
|
|
|
|
|
|
my $FN = shift; |
578
|
|
|
|
|
|
|
my $Ext = shift; |
579
|
|
|
|
|
|
|
my $Zip = Archive::Zip->new(); |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
return unless ( $Zip->read( $FN ) == Archive::Zip::AZ_OK ); |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
my @Files = $Zip->members(); |
584
|
|
|
|
|
|
|
return unless (scalar @Files == 1 && $Files[0]->{fileName} =~ /(\.$Ext)$/); |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
my $TmpDir = File::Temp::tempdir(cleanup=>1); |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
my $OutFile = $TmpDir.'/check_' . $$ . '_' . $Files[0]->{fileName}; |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
return $Zip->extractMember( $Files[0], $OutFile ) == Archive::Zip::AZ_OK ? $OutFile : undef; |
591
|
|
|
|
|
|
|
} |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
=head2 DetectBookFormat($FilePath, $Format) |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
Function detects format of an e-book and returns it. You |
596
|
|
|
|
|
|
|
may suggest the format to start with, this wiil speed up the process a bit |
597
|
|
|
|
|
|
|
(not required). |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
$Format can be 'fb2.zip', 'fb2', 'doc.zip', 'doc', 'docx.zip', |
600
|
|
|
|
|
|
|
'docx', 'epub.zip', 'epub', 'txt.zip', 'txt', 'fb3', 'fb3' |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
=cut |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
sub DetectBookFormat { |
605
|
|
|
|
|
|
|
my $File = shift; |
606
|
|
|
|
|
|
|
my $Format = shift; |
607
|
|
|
|
|
|
|
if (defined $Format && $Format =~/^($rxFormats)$/) { |
608
|
|
|
|
|
|
|
$Format = $1; |
609
|
|
|
|
|
|
|
} else { |
610
|
|
|
|
|
|
|
$Format = ''; |
611
|
|
|
|
|
|
|
} |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
#$Format первым пойдет |
614
|
|
|
|
|
|
|
my @Formats = ($Format || (), grep{ $_ ne $Format } @DetectionOrder); |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
foreach( @Formats ) { |
617
|
|
|
|
|
|
|
return $_ if $Detectors->{$_}->($File); |
618
|
|
|
|
|
|
|
} |
619
|
|
|
|
|
|
|
return; |
620
|
|
|
|
|
|
|
} |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
our $SplitRegexp = join ('|',@SplitChars); |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
$SplitRegexp = qr/$SplitRegexp/o; |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
# Кластеризация согласных - глухие к глухим, звонкие к звонким |
628
|
|
|
|
|
|
|
#my %SoundexClusters = ( |
629
|
|
|
|
|
|
|
# '1' => 'бпфвbfpv', |
630
|
|
|
|
|
|
|
# '2' => 'сцзкгхcgjkqsxz', |
631
|
|
|
|
|
|
|
# '3' => 'тдdt', |
632
|
|
|
|
|
|
|
# '4' => 'лйl', |
633
|
|
|
|
|
|
|
# '5' => 'мнmn', |
634
|
|
|
|
|
|
|
# '6' => 'рr', |
635
|
|
|
|
|
|
|
# '7' => 'жшщч' |
636
|
|
|
|
|
|
|
#); |
637
|
|
|
|
|
|
|
#my $SoundexTranslatorFrom; |
638
|
|
|
|
|
|
|
#my $SoundexTranslatorTo; |
639
|
|
|
|
|
|
|
#for (keys %SoundexClusters){ |
640
|
|
|
|
|
|
|
# $SoundexTranslatorFrom .= $SoundexClusters{$_}; |
641
|
|
|
|
|
|
|
# $SoundexTranslatorTo .= $_ x length($SoundexClusters{$_}); |
642
|
|
|
|
|
|
|
#} |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
sub TextToGems{ |
645
|
|
|
|
|
|
|
my $SrcText = Distill(shift) || return; |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
my @DistilledParts = split /$SplitRegexp/, $SrcText; |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
# Началу и концу верить всё равно нельзя |
650
|
|
|
|
|
|
|
shift @DistilledParts; |
651
|
|
|
|
|
|
|
pop @DistilledParts; |
652
|
|
|
|
|
|
|
my @Hashes; |
653
|
|
|
|
|
|
|
my %SeingHashes; |
654
|
|
|
|
|
|
|
for (@DistilledParts){ |
655
|
|
|
|
|
|
|
# Если отрывок текста короткий - мы его проигнорируем |
656
|
|
|
|
|
|
|
next if length($_)< $MinPartSize; |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
# Используется Хеш-функция Дженкинса, хорошо распределенный хэш на 32 бита |
659
|
|
|
|
|
|
|
my $Hash = Digest::JHash::jhash($_); |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
# Если один хэш дважды - нам второго не нужно |
662
|
|
|
|
|
|
|
push @Hashes, $Hash unless $SeingHashes{$Hash}++; |
663
|
|
|
|
|
|
|
} |
664
|
|
|
|
|
|
|
return \@Hashes; |
665
|
|
|
|
|
|
|
} |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
# Безжалостная мужланская функция, но в нашем случае чем топорней - тем лучше |
668
|
|
|
|
|
|
|
sub LikeSoundex { |
669
|
|
|
|
|
|
|
my $S = shift; |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
# Гласные долой, в них вечно очепятки |
672
|
|
|
|
|
|
|
$S =~ s/[$SoundexExpendable]+//gi; |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
# Заменяем согласные на их кластер |
675
|
|
|
|
|
|
|
# eval "\$String =~ tr/$SoundexTranslatorFrom/$SoundexTranslatorTo/"; |
676
|
|
|
|
|
|
|
$S =~ tr/рrлйlбпфвbfpvтдdtжшщчсцзкгхcgjkqsxzмнmn/664441111111133337777222222222222225555/; |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
return $S; |
679
|
|
|
|
|
|
|
} |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
sub Distill { |
683
|
|
|
|
|
|
|
my $String = shift; |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
#Нормализация юникода |
686
|
|
|
|
|
|
|
$String = Unicode::Normalize::NFKC($String); |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
#Переводим в lowercase |
689
|
|
|
|
|
|
|
$String = lc($String); |
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
#Конструкции вида слово.слово разбиваем пробелом |
692
|
|
|
|
|
|
|
$String =~ s/(\w[.,;:&?!*#%+\^\\\/])(\w)/$1 $2/g; |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
# Понятные нам знаки причешем до упрощенного вида |
695
|
|
|
|
|
|
|
$String =~ tr/ЁёÉÓÁéóáĀāĂ㥹ĆćĈĉĊċČčĎďĐđĒēĔĕĖėĘęĚěĜĝĞğĠġĢģĤĥĦħĨĩĪīĬĭĮįİıIJijĴĵĶķĸĹĺĻļĽľĿŀŁłŃńŅņŇňʼnŊŋŌōŎŏŐőŒœŔŕŖŗŘřŚŜśŝŞşŠšŢţŤťŦŧŨũŪūŬŭŮůŰűŲųŴŵŶŷŸŹźŻżŽžſƒǺǻǼǽǾǿђѓєѕіїјљњћќўџҐґẀẁẂẃẄẅỲỳ/ЕеЕОАеоаAaAaAaCcCcCcCcDdDdEeEeEeEeEeGgGgGgGgHhHhIiIiIiIiIiiiJjKkкLlLlLlLlLlNnNnNnnNnOoOoOoCCRrRrRrSSssSsŠšTtTtTtUuUuUuUuUuUuWwYyYZzZzZzffAaAaOohгеsiijлнhкyuГгWWWWWWYy/; |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
# в словах вида папа-ёж глотаем тире (и любой другой мусор) |
698
|
|
|
|
|
|
|
$String =~ s/(\w)([^\w\s]|_)+(\w)/$1$3/; |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
# Короткие слова долой |
701
|
|
|
|
|
|
|
# Короткие русские слова долой (у нас в русском и 6 знаков короткое) |
702
|
|
|
|
|
|
|
$String =~ s/(\s|^)(\S{1,5}|[а-я]{6})\b/$1/g; |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
# странные конструкции вида -=[мусорсрач]=- долой, ими легко засорить |
705
|
|
|
|
|
|
|
# текст - глаз заигнорит, а робот будет думать что текст о другом. Не будем |
706
|
|
|
|
|
|
|
# облегчать атакующим жизнь |
707
|
|
|
|
|
|
|
$String =~ s/(^|\s)[^\w\s]+\s?\w+\s*[^\w\s]+($|\s)/$1$2/g; |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
$String =~ s/([^\w\s]|_)+//g; |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
return '' if $String !~ /\w/; |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
$String = LikeSoundex($String); |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
# Все буквы, которых мы не знаем - перегоняем в транслит, говорят оно даж китайщину жрёт |
716
|
|
|
|
|
|
|
if ($String =~ /[^\d\s]/){ |
717
|
|
|
|
|
|
|
$String = lc Text::Unidecode::unidecode($String); |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
# Уборка - II, уже для транслитерированной строки |
720
|
|
|
|
|
|
|
$String = LikeSoundex($String); |
721
|
|
|
|
|
|
|
} |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
# Убираем повторы |
724
|
|
|
|
|
|
|
$String =~ s/(\w)\1+/$1/gi; |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
# слишком длинные слова подрежем (оставив меточку 8, что поработали ножницами) |
727
|
|
|
|
|
|
|
$String =~ s/(\s|^)(\S{4})\S+\b/${2}8/g; |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
# Всё, мы закончили, теперь пробелы убираем, да и до кучи что там еще было |
730
|
|
|
|
|
|
|
$String =~ s/\D//g; |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
return $String; |
733
|
|
|
|
|
|
|
} |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
# CHECK BLOCK |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
=head1 Internals: |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
Receives a path to the file and checks whether this file is ... |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
B - MS Word .doc in zip-archive |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
B - Electronic Publication .epub in zip-archive |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
B - MS Word 2007 .docx in zip-archive |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
B - FictionBook2 (FB2) in zip-archive |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
B - text-file in zip-archive |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
B - Electronic Publication .epub |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
B - MS Word 2007 .docx |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
B - MS Word .doc |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
B - FictionBook2 (FB2) |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
B - FictionBook3 (FB3) |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
B - text-file |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
=cut |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
sub CheckIfDocZip { |
766
|
|
|
|
|
|
|
my $FN = shift; |
767
|
|
|
|
|
|
|
my $IntFile = ExtractSingleZipFile( $FN, 'doc' ) || return; |
768
|
|
|
|
|
|
|
my $Result = CheckIfDoc( $IntFile ); |
769
|
|
|
|
|
|
|
return $Result; |
770
|
|
|
|
|
|
|
} |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
sub CheckIfEPubZip { |
773
|
|
|
|
|
|
|
my $FN = shift; |
774
|
|
|
|
|
|
|
my $IntFile = ExtractSingleZipFile( $FN, 'epub' ) || return; |
775
|
|
|
|
|
|
|
my $Result = CheckIfEPub( $IntFile ); |
776
|
|
|
|
|
|
|
return $Result; |
777
|
|
|
|
|
|
|
} |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
sub CheckIfDocxZip { |
780
|
|
|
|
|
|
|
my $FN = shift; |
781
|
|
|
|
|
|
|
my $IntFile = ExtractSingleZipFile( $FN, 'docx' ) || return; |
782
|
|
|
|
|
|
|
my $Result = CheckIfDocx( $IntFile ); |
783
|
|
|
|
|
|
|
return $Result; |
784
|
|
|
|
|
|
|
} |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
sub CheckIfFB2Zip { |
787
|
|
|
|
|
|
|
my $FN = shift; |
788
|
|
|
|
|
|
|
my $IntFile = ExtractSingleZipFile( $FN, 'fb2' ) || return; |
789
|
|
|
|
|
|
|
my $Result = CheckIfFB2( $IntFile ); |
790
|
|
|
|
|
|
|
return $Result; |
791
|
|
|
|
|
|
|
} |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
sub CheckIfTXTZip { |
794
|
|
|
|
|
|
|
my $FN = shift; |
795
|
|
|
|
|
|
|
my $IntFile = ExtractSingleZipFile( $FN, 'txt' ) || return; |
796
|
|
|
|
|
|
|
my $Result = CheckIfTXT( $IntFile ); |
797
|
|
|
|
|
|
|
return $Result; |
798
|
|
|
|
|
|
|
} |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
sub CheckIfEPub { |
801
|
|
|
|
|
|
|
my $FN = shift; |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
my $arch = Archive::Zip->new(); |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
if ( $arch->read($FN) == AZ_OK ) { |
806
|
|
|
|
|
|
|
if (my $ContainerMember = $arch->memberNamed( 'META-INF/container.xml' )) { |
807
|
|
|
|
|
|
|
my $XMLContainer = $ContainerMember->contents(); |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
my $xml = XML::LibXML->new; |
810
|
|
|
|
|
|
|
my $xpc = XML::LibXML::XPathContext->new(); |
811
|
|
|
|
|
|
|
$xpc->registerNs('opf', 'urn:oasis:names:tc:opendocument:xmlns:container'); |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
my $Container; |
814
|
|
|
|
|
|
|
eval { $Container = $xml->parse_string($XMLContainer); }; |
815
|
|
|
|
|
|
|
return if ($@ || !$Container); |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
my ($ContainerNode) = $xpc->findnodes('//opf:container/opf:rootfiles/opf:rootfile', $Container); |
818
|
|
|
|
|
|
|
my $ContentPath = $ContainerNode->getAttributeNode('full-path')->string_value; |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
if (my $ContentMember = $arch->memberNamed( $ContentPath )) { |
821
|
|
|
|
|
|
|
my $XMLContent = $ContentMember->contents(); |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
$xpc->unregisterNs('opf'); |
824
|
|
|
|
|
|
|
$xpc->registerNs('opf', 'http://www.idpf.org/2007/opf'); |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
my $Content; |
827
|
|
|
|
|
|
|
eval { $Content = $xml->parse_string($XMLContent); }; |
828
|
|
|
|
|
|
|
return if ($@ || !$Content); |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
my @ContentNodes = $xpc->findnodes('//opf:package/opf:manifest/opf:item[ |
831
|
|
|
|
|
|
|
@media-type="application/xhtml+xml" |
832
|
|
|
|
|
|
|
and |
833
|
|
|
|
|
|
|
starts-with(@id, "content") |
834
|
|
|
|
|
|
|
and |
835
|
|
|
|
|
|
|
"content" = translate(@id, "0123456789", "") |
836
|
|
|
|
|
|
|
]', |
837
|
|
|
|
|
|
|
$Content |
838
|
|
|
|
|
|
|
); |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
my $existedContentMembers = 0; |
841
|
|
|
|
|
|
|
foreach my $ContentNode (@ContentNodes) { |
842
|
|
|
|
|
|
|
my $HTMLContentPath = $ContentNode->getAttributeNode('href')->string_value; |
843
|
|
|
|
|
|
|
$existedContentMembers++ if $arch->memberNamed( $HTMLContentPath ); |
844
|
|
|
|
|
|
|
} |
845
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
return 1 if (@ContentNodes == $existedContentMembers); |
847
|
|
|
|
|
|
|
} |
848
|
|
|
|
|
|
|
} |
849
|
|
|
|
|
|
|
} |
850
|
|
|
|
|
|
|
return; |
851
|
|
|
|
|
|
|
} |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
sub CheckIfDocx { |
854
|
|
|
|
|
|
|
my $FN = shift; |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
my $arch = Archive::Zip->new(); |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
return unless ( $arch->read($FN) == AZ_OK ); |
859
|
|
|
|
|
|
|
return 1 if $arch->memberNamed( 'word/document.xml' ); |
860
|
|
|
|
|
|
|
} |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
sub CheckIfDoc { |
863
|
|
|
|
|
|
|
my $FilePath = shift; |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
my $ofs = OLE::Storage_Lite->new($FilePath); |
866
|
|
|
|
|
|
|
my $name = Encode::encode("UCS-2LE", "WordDocument"); |
867
|
|
|
|
|
|
|
return $ofs->getPpsSearch([$name], 1, 1); |
868
|
|
|
|
|
|
|
} |
869
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
sub CheckIfFB2 { |
871
|
|
|
|
|
|
|
my $FN = shift; |
872
|
|
|
|
|
|
|
my $parser = XML::LibXML->new; |
873
|
|
|
|
|
|
|
my $XML = eval{ $parser->parse_file($FN) }; |
874
|
|
|
|
|
|
|
return if( $@ || !$XML ); |
875
|
|
|
|
|
|
|
return 1; |
876
|
|
|
|
|
|
|
} |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
sub CheckIfFB3 { |
879
|
|
|
|
|
|
|
my $FN = shift; |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
my $Zip = Archive::Zip->new(); |
882
|
|
|
|
|
|
|
my $XC = XML::LibXML::XPathContext->new; |
883
|
|
|
|
|
|
|
$XC->registerNs( opcr => 'http://schemas.openxmlformats.org/package/2006/relationships' ); |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
my( $RelsXML, $RelsDoc ); |
886
|
|
|
|
|
|
|
if( $Zip->read($FN) == AZ_OK |
887
|
|
|
|
|
|
|
and $RelsXML = $Zip->contents( '_rels/.rels' ) |
888
|
|
|
|
|
|
|
and $RelsDoc = eval{ XML::LibXML->load_xml( string => $RelsXML ) } |
889
|
|
|
|
|
|
|
and $XC->exists( '/opcr:Relationships/opcr:Relationship[@Type="'.FB3_META_REL.'"]', $RelsDoc )) { |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
return 1; |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
} else { |
894
|
|
|
|
|
|
|
return 0; |
895
|
|
|
|
|
|
|
} |
896
|
|
|
|
|
|
|
} |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
sub CheckIfTXT { |
899
|
|
|
|
|
|
|
my $FN = shift; |
900
|
|
|
|
|
|
|
my $String = ExtractTextFromTXTFile($FN); |
901
|
|
|
|
|
|
|
return $String !~ /[\x00-\x08\x0B\x0C\x0E-\x1F]/g; #всякие непечатные Control characters говорят, что у нас тут бинарник |
902
|
|
|
|
|
|
|
} |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
sub DecodeUtf8 { |
905
|
|
|
|
|
|
|
my $Out = shift; |
906
|
|
|
|
|
|
|
if ($Out && !Encode::is_utf8($Out)) { |
907
|
|
|
|
|
|
|
$Out = Encode::decode_utf8($Out); |
908
|
|
|
|
|
|
|
} |
909
|
|
|
|
|
|
|
return $Out; |
910
|
|
|
|
|
|
|
} |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
=head1 REQUIRED MODULES |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
Digest::JHash; |
915
|
|
|
|
|
|
|
XML::LibXML; |
916
|
|
|
|
|
|
|
XML::LibXSLT; |
917
|
|
|
|
|
|
|
Encode::Detect; |
918
|
|
|
|
|
|
|
Text::Extract::Word; |
919
|
|
|
|
|
|
|
HTML::TreeBuilder; |
920
|
|
|
|
|
|
|
OLE::Storage_Lite; |
921
|
|
|
|
|
|
|
Text::Unidecode (v1.27 or later); |
922
|
|
|
|
|
|
|
Unicode::Normalize (v1.25 or later); |
923
|
|
|
|
|
|
|
Archive::Zip |
924
|
|
|
|
|
|
|
Encode; |
925
|
|
|
|
|
|
|
Carp; |
926
|
|
|
|
|
|
|
LWP::UserAgent; |
927
|
|
|
|
|
|
|
JSON::XS; |
928
|
|
|
|
|
|
|
File::Temp; |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
=head1 SCRIPTS |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
=head2 plagiarism_check.pl - checks your ebook againts known texts database |
933
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
Script uses check_by_gems API (L). You can |
935
|
|
|
|
|
|
|
select any "check service" provider with CHECKURL (see below), |
936
|
|
|
|
|
|
|
by default text checked with LitRes copyright-check service: |
937
|
|
|
|
|
|
|
L |
938
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
B |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
> plagiarism_check.pl FILEPATH [CHECKURL] [--full-info] [--help] |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
B |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
> plagiarism_check.pl /home/file.epub --full-info |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
B |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
B> path to file for check |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
B> url of validating API to check file with. By default: |
952
|
|
|
|
|
|
|
http://partnersdnld.litres.ru/copyright_check_by_gems/ |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
B> show full info of checked |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
B> show this information |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
B |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
Ebook statuses explained: |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
B> there are either copyrights on this book or it is |
963
|
|
|
|
|
|
|
forbidden for distribution by some other reason (racist content, etc) |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
B> ebook content owner distributes it for free (but |
966
|
|
|
|
|
|
|
content may still be protected from certan kind use) |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
B> this it public domain, no restrictions at all |
969
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
B> service have has no valid info on this text |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
=head1 AUTHOR |
974
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
Litres.ru, C<< >> |
976
|
|
|
|
|
|
|
Get the latest code from L |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
=head1 BUGS |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
Please report any bugs or feature requests to L. |
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
=head1 SUPPORT |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
perldoc Text::Distill |
987
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
You can also look for information at: |
990
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
=over 4 |
992
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here) |
994
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
L |
996
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
998
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
L |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
=item * CPAN Ratings |
1002
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
L |
1004
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
=item * Search CPAN |
1006
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
L |
1008
|
|
|
|
|
|
|
|
1009
|
|
|
|
|
|
|
=back |
1010
|
|
|
|
|
|
|
|
1011
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
Copyright (C) 2016 Litres.ru |
1014
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
The GNU Lesser General Public License version 3.0 |
1016
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
Text::Distill is free software: you can redistribute it and/or modify it |
1018
|
|
|
|
|
|
|
under the terms of the GNU Lesser General Public License as published by |
1019
|
|
|
|
|
|
|
the Free Software Foundation, either version 3.0 of the License. |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
Text::Distill is distributed in the hope that it will be useful, but |
1022
|
|
|
|
|
|
|
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY |
1023
|
|
|
|
|
|
|
or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public |
1024
|
|
|
|
|
|
|
License for more details. |
1025
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
Full text of License L. |
1027
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
=cut |
1029
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
1; # End of Text::Distill |