blib/lib/Lingua/PT/PLNbase.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 254 | 549 | 46.2 |
branch | 44 | 106 | 41.5 |
condition | 18 | 46 | 39.1 |
subroutine | 33 | 39 | 84.6 |
pod | 14 | 14 | 100.0 |
total | 363 | 754 | 48.1 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package Lingua::PT::PLNbase; | ||||||
2 | |||||||
3 | 8 | 8 | 485287 | use 5.006; | |||
8 | 81 | ||||||
4 | 8 | 8 | 40 | use strict; | |||
8 | 12 | ||||||
8 | 202 | ||||||
5 | 8 | 8 | 38 | use warnings; | |||
8 | 15 | ||||||
8 | 247 | ||||||
6 | 8 | 8 | 4319 | use Data::Dumper; | |||
8 | 48377 | ||||||
8 | 567 | ||||||
7 | 8 | 8 | 3145 | use Lingua::PT::Abbrev; | |||
8 | 7933 | ||||||
8 | 388 | ||||||
8 | |||||||
9 | require Exporter; | ||||||
10 | our @ISA = qw(Exporter); | ||||||
11 | |||||||
12 | #use POSIX qw(locale_h); | ||||||
13 | #my $llang = setlocale(LC_CTYPE, "pt_PT"); | ||||||
14 | #$llang = setlocale(LC_CTYPE, "pt_BR") unless $llang; | ||||||
15 | #use locale; | ||||||
16 | |||||||
17 | 8 | 8 | 2386 | use utf8; | |||
8 | 70 | ||||||
8 | 45 | ||||||
18 | |||||||
19 | |||||||
20 | =encoding UTF-8 | ||||||
21 | |||||||
22 | =head1 NAME | ||||||
23 | |||||||
24 | Lingua::PT::PLNbase - Perl extension for NLP of the Portuguese | ||||||
25 | |||||||
26 | =head1 SYNOPSIS | ||||||
27 | |||||||
28 | use Lingua::PT::PLNbase; | ||||||
29 | |||||||
30 | my @atomos = atomiza($texto); # tb chamada 'tokenize' | ||||||
31 | |||||||
32 | my $atomos_um_por_linha = tokeniza($texto); | ||||||
33 | my $atomos_separados_por_virgula = tokeniza({fs => ','}, $texto); | ||||||
34 | |||||||
35 | |||||||
36 | my @frases = frases($texto); | ||||||
37 | |||||||
38 | =head1 DESCRIPTION | ||||||
39 | |||||||
40 | Este módulo inclui funções básicas úteis ao processamento | ||||||
41 | computacional da língua, e em particular, da língua portuguesa. | ||||||
42 | |||||||
43 | =cut | ||||||
44 | |||||||
45 | |||||||
46 | |||||||
47 | our @EXPORT = qw( | ||||||
48 | atomiza frases separa_frases fsentences atomos | ||||||
49 | tokeniza has_accents remove_accents | ||||||
50 | xmlsentences sentences | ||||||
51 | cqptokens tokenize | ||||||
52 | ); | ||||||
53 | |||||||
54 | our $VERSION = '0.29'; | ||||||
55 | |||||||
56 | our $abrev; | ||||||
57 | |||||||
58 | our $terminador = qr{([.?!;]+[\»"'”’\«]?|<[pP]\b.*?>| |\n\h*\n+|:\s+(?=[-\«"“‘„][A-Z]))}; |
||||||
59 | |||||||
60 | our $itemmarkers1 =qr{ | ||||||
61 | (?:^|\n)\h*( | ||||||
62 | \d\d?[)]\h # 4) | ||||||
63 | | [a-z][.)]\h # a) b. | ||||||
64 | | \([a-z1-9]\)\h # (a) | ||||||
65 | | [.*►•●] # • | ||||||
66 | | \d{1,3}[.]\h # 1. | ||||||
67 | | \d{1,2}\.\d{1,2}[.)]\h # 2.3. | ||||||
68 | | \d{1,2}\.\d{1,2}\.\d{1,2}[.)]\h # 2.3.3. | ||||||
69 | ) | ||||||
70 | }x; | ||||||
71 | |||||||
72 | our $itemmarkers2 =qr{ # not used yet | ||||||
73 | \n\h*( | ||||||
74 | | \<(li|LI)\> # |
||||||
75 | | [‐‑–—\-]+ # -- | ||||||
76 | ) | ||||||
77 | }x; | ||||||
78 | |||||||
79 | our $protect = qr! | ||||||
80 | \#n\d+ | ||||||
81 | | \w+['’]\w+ | ||||||
82 | | \bn\.os?(?\![.\w]) # number | ||||||
83 | | [\w_.-]+ \@ [\w_.-]+\w # emails | ||||||
84 | | \w+\.?[ºª°]\.? # ordinals | ||||||
85 | | _sec[:+].*?_ # section marks from bookclean | ||||||
86 | | <[A-Za-z_](?:\w|:)* # | ||||||
87 | (?:\s+ | ||||||
88 | [A-Za-z_:0-9]+= # at='v' | ||||||
89 | (?: '[^']+' | ||||||
90 | | "[^"]+") | ||||||
91 | )* | ||||||
92 | \s*/?\s* | ||||||
93 | > # markup open XML SGML | ||||||
94 | | \s*[A-Za-z_0-9:]+\s*> # markup close XML SGML | ||||||
95 | | \d+(?:\/\d+)+ # dates or similar 12/21/1 | ||||||
96 | | \d+(?:[.,]\d+)+%? # numbers | ||||||
97 | | \d+(?:\.[oa])+ # ordinals numbers 12. | ||||||
98 | | (?:\d+\.)+(?=[ ]*[a-z0-9]) # numbers 12. (continuation) | ||||||
99 | | \d+\:\d+(\:\d+)? # the time 12:12:2 | ||||||
100 | | (?:\&\w+\;) # entidades XML HTML | ||||||
101 | | (?:(?:https?|ftp|gopher|oai):|www)[\w_./~:-]+\w # urls | ||||||
102 | | (?: \w+ \. )+ (?: com | org | net | pt ) # simplified urls | ||||||
103 | | \w+(-\w+)+ # dá-lo-à | ||||||
104 | | \\\\unicode\{\d+\} # unicode... | ||||||
105 | | \w+\.(?:exe|html?|zip|jpg|gif|wav|mp3|png|t?gz|pl|xml) # filenames | ||||||
106 | !xu; | ||||||
107 | |||||||
108 | |||||||
109 | our ($savit_n, %savit_p); | ||||||
110 | our %conf; | ||||||
111 | |||||||
112 | |||||||
113 | sub import { | ||||||
114 | 7 | 7 | 73 | my $class = shift; | |||
115 | 7 | 21 | our %conf = @_; | ||||
116 | 7 | 1174 | $class->export_to_level(1, undef, @EXPORT); | ||||
117 | |||||||
118 | 7 | 100 | 66 | 69 | if ($conf{abbrev} && -f $conf{abbrev}) { | ||
119 | 1 | 8 | $conf{ABBREV} = Lingua::PT::Abbrev->new($conf{abbrev}); | ||||
120 | } else { | ||||||
121 | 6 | 57 | $conf{ABBREV} = Lingua::PT::Abbrev->new(); | ||||
122 | } | ||||||
123 | |||||||
124 | 7 | 7302 | $abrev = $conf{ABBREV}->regexp(nodot=>1); | ||||
125 | } | ||||||
126 | |||||||
127 | |||||||
128 | sub _savit{ | ||||||
129 | 96 | 96 | 167 | my $a=shift; | |||
130 | 96 | 195 | $savit_p{++$savit_n}=$a ; | ||||
131 | 96 | 5834 | " __MARCA__$savit_n " | ||||
132 | } | ||||||
133 | |||||||
134 | sub _loadit{ | ||||||
135 | 53 | 53 | 77 | my $a = shift; | |||
136 | 53 | 395 | $a =~ s/ ?__MARCA__(\d+) ?/$savit_p{$1}/g; | ||||
137 | 53 | 82 | $savit_n = 0; | ||||
138 | 53 | 106 | $a; | ||||
139 | } | ||||||
140 | |||||||
141 | |||||||
142 | |||||||
143 | sub _tokenizecommon { | ||||||
144 | 8 | 8 | 11892 | use utf8::all; | |||
8 | 359957 | ||||||
8 | 41 | ||||||
145 | 39 | 39 | 73 | my $conf = { keep_quotes => 0 }; | |||
146 | 39 | 50 | 84 | if (ref($_[0]) eq "HASH") { | |||
147 | 39 | 46 | my $c = shift; | ||||
148 | 39 | 142 | $conf = {%$conf, %$c}; | ||||
149 | } | ||||||
150 | |||||||
151 | 39 | 63 | my $text = shift; | ||||
152 | |||||||
153 | 39 | 60 | for ($text) { | ||||
154 | 39 | 114 | s/<\?xml.*?\?>//s; | ||||
155 | |||||||
156 | 39 | 50 | 74 | if ($conf->{keep_quotes}) { | |||
157 | 0 | 0 | s#\"# \" #g; | ||||
158 | } else { | ||||||
159 | 39 | 76 | s/^\"/\« /g; | ||||
160 | 39 | 71 | s/ \"/ \« /g; | ||||
161 | 39 | 82 | s/\"([ .?!:;,])/ \» $1/g; | ||||
162 | 39 | 63 | s/\"$/ \»/g; | ||||
163 | } | ||||||
164 | |||||||
165 | 39 | 259 | s!(\w)(['’](s|ld|nt|ll|m|t|re))\b!"$1 " . _savit($2)!ge; # I 'm we 're can 't | ||||
3 | 8 | ||||||
166 | 39 | 79 | s!([[:alpha:]]+')(\w)! _savit($1) . " $2"!ge; | ||||
2 | 4 | ||||||
167 | |||||||
168 | 39 | 50 | 61 | if ($conf->{keep_quotes}) { | |||
169 | 0 | 0 | s#\'# \' #g; | ||||
170 | } else { | ||||||
171 | 39 | 60 | s/^\`/\« /g; | ||||
172 | 39 | 62 | s/ \`/ \« /g; | ||||
173 | |||||||
174 | 39 | 67 | s/^\'/\« /g; | ||||
175 | 39 | 69 | s/ \'/ \« /g; | ||||
176 | 39 | 63 | s/\'([ .?!:;,])/ \» $1/g; | ||||
177 | 39 | 61 | s/\'$/ \»/g; | ||||
178 | } | ||||||
179 | |||||||
180 | 39 | 4239 | s!($protect)! _savit($1)!xge; | ||||
16 | 36 | ||||||
181 | 39 | 168 | s!\b((([A-Z])\.)+)!_savit($1)!gie; | ||||
6 | 15 | ||||||
182 | |||||||
183 | 39 | 103 | s!([\»\]])!$1 !g; # » | ] | ||||
184 | 39 | 102 | s!([\«\[])! $1!g; | ||||
185 | |||||||
186 | 39 | 818 | s/(\s*\b\s*|\s+)/\n/g; | ||||
187 | |||||||
188 | # s/(.)\n-\n/$1-/g; | ||||||
189 | 39 | 293 | s/\n+/\n/g; | ||||
190 | 39 | 183 | s/\n(\.?[ºª°])\b/$1/g; | ||||
191 | |||||||
192 | |||||||
193 | 39 | 686 | s#\n($abrev)\n\.\n#\n$1\.\n#ig; | ||||
194 | |||||||
195 | 39 | 112 | s#([\]\)])([.,;:!?])#$1\n$2#g; | ||||
196 | |||||||
197 | 39 | 62 | s/\n*\n; | ||||
198 | 39 | 73 | $_ = _loadit($_); | ||||
199 | 39 | 137 | s/(\s*\n)+$/\n/; | ||||
200 | 39 | 212 | s/^(\s*\n)+//; | ||||
201 | } | ||||||
202 | $text | ||||||
203 | 39 | 99 | } | ||||
204 | |||||||
205 | =head2 Atomizadores | ||||||
206 | |||||||
207 | Este módulo inclui um método configurável para a atomização de corpus | ||||||
208 | na língua portuguesa. No entanto, é possível que possa ser usado para | ||||||
209 | outras línguas (especialmente inglês e francês. | ||||||
210 | |||||||
211 | A forma simples de uso do atomizador é usando directamente a função | ||||||
212 | C |
||||||
213 | o uso da função C |
||||||
214 | |||||||
215 | As funções disponíveis: | ||||||
216 | |||||||
217 | =over 4 | ||||||
218 | |||||||
219 | =item atomos | ||||||
220 | |||||||
221 | =item atomiza | ||||||
222 | |||||||
223 | =item tokenize | ||||||
224 | |||||||
225 | Usa um algorítmo desenvolvido no Projecto Natura. | ||||||
226 | |||||||
227 | Para que as aspas não sejam convertidas em I | ||||||
228 | aspa>, usar a opção de configuração C |
||||||
229 | |||||||
230 | Retorna texto tokenizado, um por linha (a nao ser que o 'record | ||||||
231 | separator' (rs) seja redefenido). Em ambiente lista, retorna a lista | ||||||
232 | dos átomos. | ||||||
233 | |||||||
234 | my @atomos = atomiza($texto); # tb chamada 'tokenize' | ||||||
235 | |||||||
236 | my $atomos_um_por_linha = tokeniza($texto); | ||||||
237 | my $atomos_separados_por_virgula = tokeniza({fs => ','}, $texto); | ||||||
238 | |||||||
239 | |||||||
240 | =item tokeniza | ||||||
241 | |||||||
242 | Usa um algoritmo desenvolvido no Pólo de Oslo da Linguateca. Retorna | ||||||
243 | um átomo por linha em contexto escalar, e uma lista de átomos em | ||||||
244 | contexto de lista. | ||||||
245 | |||||||
246 | =item cqptokens | ||||||
247 | |||||||
248 | Um átomo por linha de acordo com notação CWB. Pode ser alterado o | ||||||
249 | separador de frases (ou de registo) usando a opção 'irs': | ||||||
250 | |||||||
251 | cqptokens( { irs => "\n\n" }, "file" ); | ||||||
252 | |||||||
253 | outras opções: | ||||||
254 | |||||||
255 | cqptokens( { enc => ":utf8"}, "file" ); # enc => charset | ||||||
256 | # outenc => charset | ||||||
257 | |||||||
258 | =back | ||||||
259 | |||||||
260 | =cut | ||||||
261 | |||||||
262 | 0 | 0 | 1 | 0 | sub atomos { tokenize(@_) } | ||
263 | 39 | 39 | 1 | 11600 | sub atomiza { tokenize(@_) } | ||
264 | |||||||
265 | sub tokenize{ | ||||||
266 | 39 | 39 | 1 | 90 | my $conf = { rs => "\n" }; | ||
267 | 39 | 77 | my $result = ""; | ||||
268 | 39 | 60 | my $text = shift; | ||||
269 | |||||||
270 | 39 | 50 | 75 | if (ref($text) eq "HASH") { | |||
271 | 0 | 0 | $conf = { %$conf, %$text }; | ||||
272 | 0 | 0 | $text = shift; | ||||
273 | } | ||||||
274 | |||||||
275 | 39 | 50 | 80 | die __PACKAGE__ . "::tokenize called with undefined value" unless defined $text; | |||
276 | |||||||
277 | 39 | 79 | $result = _tokenizecommon($conf, $text); | ||||
278 | 39 | 92 | $result =~ s/\n$//g; | ||||
279 | |||||||
280 | 39 | 100 | 82 | if (wantarray) { | |||
281 | 14 | 130 | return split /\n+/, $result | ||||
282 | } else { | ||||||
283 | 25 | 50 | 56 | $result =~ s/\n/$conf->{rs}/g unless $conf->{rs} eq "\n"; | |||
284 | 25 | 77 | return $result; | ||||
285 | } | ||||||
286 | } | ||||||
287 | |||||||
288 | sub cqptokens{ ## | ||||||
289 | 0 | 0 | 1 | 0 | my %opt = ( irs => ">"); # irs => INPUT RECORD SEPARATOR; | ||
290 | # enc => charset | ||||||
291 | # outenc => charset | ||||||
292 | 0 | 0 | 0 | if(ref($_[0]) eq "HASH"){ %opt = (%opt , %{shift(@_)});} | |||
0 | 0 | ||||||
0 | 0 | ||||||
293 | 0 | 0 | 0 | my $file = shift || "-"; | |||
294 | |||||||
295 | 0 | 0 | local $/ = $opt{irs}; | ||||
296 | 0 | 0 | my %tag=(); | ||||
297 | 0 | 0 | my ($a,$b); | ||||
298 | 0 | 0 | open(F,"$file"); | ||||
299 | 0 | 0 | 0 | binmode(F,$opt{enc}) if $opt{enc}; | |||
300 | 0 | 0 | 0 | binmode(STDOUT,$opt{outenc}) if $opt{outenc}; | |||
301 | 0 | 0 | local $_; | ||||
302 | 0 | 0 | while( |
||||
303 | 0 | 0 | 0 | if(/<(\w+)(.*?)>/){ | |||
304 | 0 | 0 | ($a, $b) = ($1,$2); | ||||
305 | 0 | 0 | 0 | if ($b =~ /=/ ) { $tag{'v'}{$a}++ } | |||
0 | 0 | ||||||
306 | 0 | 0 | else { $tag{'s'}{$a}++ } | ||||
307 | } | ||||||
308 | 0 | 0 | print _tokenizecommon({},$_) | ||||
309 | } | ||||||
310 | 0 | 0 | return \%tag | ||||
311 | } | ||||||
312 | |||||||
313 | |||||||
314 | |||||||
315 | =head2 Segmentadores | ||||||
316 | |||||||
317 | Este módulo é uma extensão Perl para a segmentação de textos em | ||||||
318 | linguagem natural. O objectivo principal será a possibilidade de | ||||||
319 | segmentação a vários níveis, no entanto esta primeira versão permite | ||||||
320 | apenas a separação em frases (fraseação) usando uma de duas variantes: | ||||||
321 | |||||||
322 | =over 4 | ||||||
323 | |||||||
324 | =item C |
||||||
325 | |||||||
326 | =item C |
||||||
327 | |||||||
328 | @frases = frases($texto); | ||||||
329 | |||||||
330 | Esta é a implementação do Projecto Natura, que retorna uma lista de | ||||||
331 | frases. | ||||||
332 | |||||||
333 | =item C |
||||||
334 | |||||||
335 | $frases = separa_frases($texto); | ||||||
336 | |||||||
337 | Esta é a implementação da Linguateca, que retorna um texto com uma | ||||||
338 | frase por linha. | ||||||
339 | |||||||
340 | =item C |
||||||
341 | |||||||
342 | Utiliza o método C |
||||||
343 | as frases são ladeadas por ' |
||||||
344 | substituído usando o parametro opcional C |
||||||
345 | |||||||
346 | xmlsentences({st=> "tag"}, text) | ||||||
347 | |||||||
348 | =back | ||||||
349 | |||||||
350 | =cut | ||||||
351 | |||||||
352 | sub xmlsentences { | ||||||
353 | 0 | 0 | 1 | 0 | my %opt = (st => "s") ; | ||
354 | 0 | 0 | 0 | if (ref($_[0]) eq "HASH"){ %opt = (%opt , %{shift(@_)});} | |||
0 | 0 | ||||||
0 | 0 | ||||||
355 | 0 | 0 | my $par=shift; | ||||
356 | 0 | 0 | join("\n",map {"<$opt{st}>$_$opt{st}>"} (sentences($par))); | ||||
0 | 0 | ||||||
357 | } | ||||||
358 | |||||||
359 | |||||||
360 | |||||||
361 | 2 | 2 | 1 | 152 | sub frases { sentences(@_) } | ||
362 | sub sentences{ | ||||||
363 | 8 | 8 | 21004 | use utf8::all; | |||
8 | 18 | ||||||
8 | 51 | ||||||
364 | 14 | 14 | 1 | 21 | my @r; | ||
365 | 14 | 22 | my $MARCA = "\0x01"; | ||||
366 | 14 | 25 | my $par = shift; | ||||
367 | 14 | 28 | for ($par) { | ||||
368 | 14 | 1079 | s!($itemmarkers1)!_savit("$MARCA$1$MARCA")!ge; | ||||
0 | 0 | ||||||
369 | 14 | 5236 | s!($protect)! _savit($1)!xge; | ||||
27 | 63 | ||||||
370 | 14 | 753 | s!\b(($abrev)\.)! _savit($1)!ige; | ||||
26 | 42 | ||||||
371 | 14 | 93 | s!\b(([A-Z])\.)! _savit($1)!gie; # este à parte para não apanhar minúlculas (s///i) | ||||
16 | 34 | ||||||
372 | 14 | 1128 | s!($terminador)!$1$MARCA!g; | ||||
373 | 14 | 46 | $_ = _loadit($_); | ||||
374 | 14 | 346 | @r = split(/\s*(?:$MARCA\s*)/,$_); | ||||
375 | } | ||||||
376 | #if (@r && $r[-1] =~ /^\s*$/s) { | ||||||
377 | # pop(@r) | ||||||
378 | #} | ||||||
379 | 14 | 34 | return map { _trim($_) } @r; | ||||
84 | 114 | ||||||
380 | } | ||||||
381 | |||||||
382 | sub _trim { | ||||||
383 | 84 | 84 | 95 | my $x = shift; | |||
384 | 84 | 155 | $x =~ s/^[\n\r\s]+//; | ||||
385 | 84 | 335 | $x =~ s/[\n\r\s]+$//; | ||||
386 | 84 | 50 | 164 | if($x =~ /\S/){return ($x)} | |||
84 | 176 | ||||||
387 | 0 | 0 | else {return ( )} | ||||
388 | } | ||||||
389 | |||||||
390 | |||||||
391 | =head2 Segmentação a vários níveis | ||||||
392 | |||||||
393 | =over 4 | ||||||
394 | |||||||
395 | =item fsentences | ||||||
396 | |||||||
397 | A função C |
||||||
398 | vários níveis: por ficheiro, por parágrafo ou por frase. O output pode | ||||||
399 | ser realizado em vários formatos e obtendo, ou não, numeração de | ||||||
400 | segmentos. | ||||||
401 | |||||||
402 | Esta função é invocada com uma referência para um hash de configuração | ||||||
403 | e uma lista de ficheiros a processar (no caso de a lista ser vazia, | ||||||
404 | irá usar o C |
||||||
405 | |||||||
406 | O resultado do processamento é enviado para o C |
||||||
407 | a chave C | ||||||
408 | o seu valor será usado como ficheiro de resultado. | ||||||
409 | |||||||
410 | A chave C |
||||||
411 | omissão, é usada uma linha em branco. | ||||||
412 | |||||||
413 | A chave C |
||||||
414 | resultado. De momento, a única política disponível é a C |
||||||
415 | |||||||
416 | As chaves C |
||||||
417 | na política XML, para etiquetar frases, parágrafos e textos | ||||||
418 | (ficheiros), respectivamente. Por omissão, as etiquetas usadas são | ||||||
419 | C e C |
||||||
420 | |||||||
421 | É possível numerar as etiquetas, definindo as chaves C |
||||||
422 | C |
||||||
423 | |||||||
424 | =over 4 | ||||||
425 | |||||||
426 | =item '0' | ||||||
427 | |||||||
428 | Nenhuma numeração. | ||||||
429 | |||||||
430 | =item 'f' | ||||||
431 | |||||||
432 | Só pode ser usado com o C |
||||||
433 | delimitam ficheiros usará o nome do ficheiro como identificador. | ||||||
434 | |||||||
435 | =item '1' | ||||||
436 | |||||||
437 | Numeração a um nível. Cada etiqueta terá um contador diferente. | ||||||
438 | |||||||
439 | =item '2' | ||||||
440 | |||||||
441 | Só pode ser usado com o C |
||||||
442 | dois níveis (N.N). | ||||||
443 | |||||||
444 | =item '3' | ||||||
445 | |||||||
446 | Só pode ser usado com o C |
||||||
447 | |||||||
448 | =back | ||||||
449 | |||||||
450 | =back | ||||||
451 | |||||||
452 | |||||||
453 | nomes das etiquetas (s => 's', p=>'p', t=>'text') | ||||||
454 | |||||||
455 | t: 0 - nenhuma | ||||||
456 | 1 - numeracao | ||||||
457 | f - ficheiro [DEFAULT] | ||||||
458 | |||||||
459 | p: 0 - nenhuma | ||||||
460 | 1 - numeracao 1 nivel [DEFAULT] | ||||||
461 | 2 - numercao 2 niveis (N.N) | ||||||
462 | |||||||
463 | s: 0 - nenhuma | ||||||
464 | 1 - numeração 1 nível [DEFAULT] | ||||||
465 | 2 - numeração 2 níveis (N.N) | ||||||
466 | 3 - numeração 3 níveis (N.N.N) | ||||||
467 | |||||||
468 | =cut | ||||||
469 | |||||||
470 | sub fsentences { | ||||||
471 | 8 | 8 | 12889 | use utf8::all; | |||
8 | 17 | ||||||
8 | 48 | ||||||
472 | 4 | 4 | 1 | 5642 | my %opts = ( | ||
473 | o_format => 'XML', | ||||||
474 | s_tag => 's', | ||||||
475 | s_num => '1', | ||||||
476 | s_last => '', | ||||||
477 | |||||||
478 | p_tag => 'p', | ||||||
479 | p_num => '1', | ||||||
480 | p_last => '', | ||||||
481 | |||||||
482 | t_tag => 'text', | ||||||
483 | t_num => 'f', | ||||||
484 | t_last => '', | ||||||
485 | |||||||
486 | tokenize => 0, | ||||||
487 | |||||||
488 | output => \*STDOUT, | ||||||
489 | input_p_sep => '', | ||||||
490 | ); | ||||||
491 | |||||||
492 | 4 | 50 | 21 | %opts = (%opts, %{shift()}) if ref($_[0]) eq "HASH"; | |||
4 | 25 | ||||||
493 | |||||||
494 | |||||||
495 | 4 | 13 | my @files = @_; | ||||
496 | 4 | 50 | 9 | @files = (\*STDIN) unless @files; | |||
497 | |||||||
498 | 4 | 6 | my $oldselect; | ||||
499 | 4 | 50 | 10 | if (!ref($opts{output})) { | |||
500 | 4 | 50 | 309 | open OUT, ">$opts{output}" or die("Cannot open file for writting: $!\n"); | |||
501 | 4 | 26 | $oldselect = select OUT; | ||||
502 | } | ||||||
503 | |||||||
504 | 4 | 12 | for my $file (@files) { | ||||
505 | 4 | 5 | my $fh; | ||||
506 | 4 | 50 | 12 | if (ref($file)) { | |||
507 | 0 | 0 | $fh = $file; | ||||
508 | } else { | ||||||
509 | 4 | 50 | 11 | if ($opts{enc}) { | |||
510 | 0 | 0 | 0 | open $fh, "<$opts{enc}", $file or die("Cannot open file $file:$!\n"); | |||
511 | } else { | ||||||
512 | 4 | 50 | 152 | open $fh, $file or die("Cannot open file $file:$!\n"); | |||
513 | } | ||||||
514 | 4 | 19 | print _open_t_tag(\%opts, $file); | ||||
515 | } | ||||||
516 | |||||||
517 | 4 | 9 | my $par; | ||||
518 | 4 | 19 | local $/ = $opts{input_p_sep}; | ||||
519 | 4 | 119 | while ($par = <$fh>) { | ||||
520 | 12 | 40 | print _open_p_tag(\%opts); | ||||
521 | |||||||
522 | 12 | 30 | chomp($par); | ||||
523 | |||||||
524 | 12 | 27 | for my $s (sentences($par)) { | ||||
525 | 56 | 96 | print _open_s_tag(\%opts), _clean(\%opts,$s), _close_s_tag(\%opts); | ||||
526 | } | ||||||
527 | |||||||
528 | 12 | 29 | print _close_p_tag(\%opts); | ||||
529 | } | ||||||
530 | |||||||
531 | |||||||
532 | 4 | 50 | 8 | unless (ref($file)) { | |||
533 | 4 | 8 | print _close_t_tag(\%opts); | ||||
534 | 4 | 69 | close $fh | ||||
535 | } | ||||||
536 | |||||||
537 | } | ||||||
538 | |||||||
539 | 4 | 50 | 16 | if (!ref($opts{output})) { | |||
540 | 4 | 162 | close OUT; | ||||
541 | 4 | 45 | select $oldselect; | ||||
542 | } | ||||||
543 | |||||||
544 | } | ||||||
545 | |||||||
546 | sub _clean { | ||||||
547 | 56 | 56 | 69 | my $opts = shift; | |||
548 | 56 | 62 | my $str = shift; | ||||
549 | |||||||
550 | 56 | 100 | 75 | if ($opts->{tokenize}) { | |||
551 | 14 | 50 | 25 | if ($opts->{tokenize} eq "cqp") { | |||
552 | 0 | 0 | $str = "\n".join("\n", atomiza($str))."\n" | ||||
553 | } else { | ||||||
554 | 14 | 25 | $str = join(" ", atomiza($str)) | ||||
555 | } | ||||||
556 | } else { | ||||||
557 | 42 | 302 | $str =~ s/\s+/ /g; | ||||
558 | } | ||||||
559 | 56 | 127 | $str =~ s/&/&/g; | ||||
560 | 56 | 89 | $str =~ s/>/>/g; | ||||
561 | 56 | 78 | $str =~ s/</g; | ||||
562 | 56 | 107 | return $str; | ||||
563 | } | ||||||
564 | |||||||
565 | sub _open_t_tag { | ||||||
566 | 4 | 4 | 6 | my $opts = shift; | |||
567 | 4 | 50 | 14 | my $file = shift || ""; | |||
568 | 4 | 50 | 66 | 19 | if ($opts->{o_format} eq "XML" && | ||
569 | $opts->{t_tag}) { | ||||||
570 | 2 | 50 | 10 | if ($opts->{t_num} eq 0) { | |||
50 | |||||||
571 | 0 | 0 | return "<$opts->{t_tag}>\n"; | ||||
572 | } elsif ($opts->{t_num} eq 'f') { | ||||||
573 | 2 | 4 | $opts->{t_last} = $file; | ||||
574 | 2 | 4 | $opts->{p_last} = 0; | ||||
575 | 2 | 3 | $opts->{s_last} = 0; | ||||
576 | 2 | 26 | return "<$opts->{t_tag} file=\"$file\">\n"; | ||||
577 | } else { | ||||||
578 | ## t_num = 1 :-) | ||||||
579 | 0 | 0 | ++$opts->{t_last}; | ||||
580 | 0 | 0 | $opts->{p_last} = 0; | ||||
581 | 0 | 0 | $opts->{s_last} = 0; | ||||
582 | 0 | 0 | return "<$opts->{t_tag} id=\"$opts->{t_last}\">\n"; | ||||
583 | } | ||||||
584 | } | ||||||
585 | 2 | 50 | 12 | return "" if ($opts->{o_format} eq "NATools"); | |||
586 | } | ||||||
587 | |||||||
588 | sub _close_t_tag { | ||||||
589 | 4 | 4 | 7 | my $opts = shift; | |||
590 | 4 | 50 | 10 | my $file = shift || ""; | |||
591 | 4 | 50 | 66 | 16 | if ($opts->{o_format} eq "XML" && | ||
592 | $opts->{t_tag}) { | ||||||
593 | 2 | 6 | return "$opts->{t_tag}>\n"; | ||||
594 | } | ||||||
595 | 2 | 50 | 6 | return "" if ($opts->{o_format} eq "NATools"); | |||
596 | } | ||||||
597 | |||||||
598 | sub _open_p_tag { | ||||||
599 | 12 | 12 | 19 | my $opts = shift; | |||
600 | |||||||
601 | 12 | 50 | 66 | 39 | if ($opts->{o_format} eq "XML" && | ||
602 | $opts->{p_tag}) { | ||||||
603 | 6 | 50 | 17 | if ($opts->{p_num} == 0) { | |||
50 | |||||||
604 | 0 | 0 | return "<$opts->{p_tag}>\n"; | ||||
605 | } elsif ($opts->{p_num} == 1) { | ||||||
606 | 6 | 9 | ++$opts->{p_last}; | ||||
607 | 6 | 8 | $opts->{s_last} = 0; | ||||
608 | 6 | 24 | return "<$opts->{p_tag} id=\"$opts->{p_last}\">\n"; | ||||
609 | } else { | ||||||
610 | ## p_num = 2 | ||||||
611 | 0 | 0 | ++$opts->{p_last}; | ||||
612 | 0 | 0 | $opts->{s_last} = 0; | ||||
613 | 0 | 0 | return "<$opts->{p_tag} id=\"$opts->{t_last}.$opts->{p_last}\">\n"; | ||||
614 | } | ||||||
615 | } | ||||||
616 | 6 | 50 | 20 | return "" if ($opts->{o_format} eq "NATools"); | |||
617 | } | ||||||
618 | |||||||
619 | sub _close_p_tag { | ||||||
620 | 12 | 12 | 14 | my $opts = shift; | |||
621 | 12 | 50 | 30 | my $file = shift || ""; | |||
622 | 12 | 50 | 66 | 34 | if ($opts->{o_format} eq "XML" && | ||
623 | $opts->{p_tag}) { | ||||||
624 | 6 | 62 | return "$opts->{p_tag}>\n"; | ||||
625 | } | ||||||
626 | 6 | 50 | 59 | return "" if ($opts->{o_format} eq "NATools"); | |||
627 | } | ||||||
628 | |||||||
629 | |||||||
630 | sub _open_s_tag { | ||||||
631 | 56 | 56 | 64 | my $opts = shift; | |||
632 | |||||||
633 | 56 | 50 | 66 | 128 | if ($opts->{o_format} eq "XML" && | ||
634 | $opts->{s_tag}) { | ||||||
635 | 28 | 50 | 54 | if ($opts->{s_num} == 0) { | |||
50 | |||||||
0 | |||||||
636 | 0 | 0 | return "<$opts->{s_tag}>"; | ||||
637 | } elsif ($opts->{s_num} == 1) { | ||||||
638 | 28 | 31 | ++$opts->{s_last}; | ||||
639 | 28 | 72 | return "<$opts->{s_tag} id=\"$opts->{s_last}\">"; | ||||
640 | |||||||
641 | } elsif ($opts->{s_num} == 2) { | ||||||
642 | 0 | 0 | ++$opts->{s_last}; | ||||
643 | 0 | 0 | return "<$opts->{s_tag} id=\"$opts->{p_last}.$opts->{s_last}\">"; | ||||
644 | |||||||
645 | } else { | ||||||
646 | ## p_num = 3 | ||||||
647 | 0 | 0 | ++$opts->{s_last}; | ||||
648 | 0 | 0 | return "<$opts->{s_tag} id=\"$opts->{t_last}.$opts->{p_last}.$opts->{s_last}\">"; | ||||
649 | } | ||||||
650 | } | ||||||
651 | 28 | 50 | 65 | return "" if ($opts->{o_format} eq "NATools"); | |||
652 | } | ||||||
653 | |||||||
654 | sub _close_s_tag { | ||||||
655 | 56 | 56 | 69 | my $opts = shift; | |||
656 | 56 | 50 | 131 | my $file = shift || ""; | |||
657 | 56 | 50 | 66 | 121 | if ($opts->{o_format} eq "XML" && | ||
658 | $opts->{s_tag}) { | ||||||
659 | 28 | 97 | return "$opts->{s_tag}>\n"; | ||||
660 | } | ||||||
661 | 28 | 50 | 115 | return "\n\$\n" if ($opts->{o_format} eq "NATools"); | |||
662 | } | ||||||
663 | |||||||
664 | |||||||
665 | |||||||
666 | |||||||
667 | |||||||
668 | =head2 Acentuação | ||||||
669 | |||||||
670 | =over 4 | ||||||
671 | |||||||
672 | =item remove_accents | ||||||
673 | |||||||
674 | Esta função remove a acentuação do texto passado como parâmetro | ||||||
675 | |||||||
676 | =item has_accents | ||||||
677 | |||||||
678 | Esta função verifica se o texto passado como parâmetro tem caracteres acentuados | ||||||
679 | |||||||
680 | =back | ||||||
681 | |||||||
682 | =cut | ||||||
683 | |||||||
684 | sub has_accents { | ||||||
685 | 30 | 30 | 1 | 5334 | my $word = shift; | ||
686 | 30 | 100 | 145 | if ($word =~ m![çáéíóúàèìòùãõâêîôûäëïöüñ]!i) { | |||
687 | 20 | 74 | return 1 | ||||
688 | } else { | ||||||
689 | 10 | 37 | return 0 | ||||
690 | } | ||||||
691 | } | ||||||
692 | |||||||
693 | sub remove_accents { | ||||||
694 | 30 | 30 | 1 | 56 | my $word = shift; | ||
695 | 30 | 106 | $word =~ tr/çáéíóúàèìòùãõâêîôûäëïöüñ/caeiouaeiouaoaeiouaeioun/; | ||||
696 | 30 | 65 | $word =~ tr/ÇÁÉÍÓÚÀÈÌÒÙÃÕÂÊÎÔÛÄËÏÖÜÑ/CAEIOUAEIOUAOAEIOUAEIOUN/; | ||||
697 | 30 | 121 | return $word; | ||||
698 | } | ||||||
699 | |||||||
700 | |||||||
701 | |||||||
702 | |||||||
703 | |||||||
704 | ### ---------- OSLO -------- | ||||||
705 | |||||||
706 | sub tokeniza { | ||||||
707 | 8 | 8 | 27169 | use utf8::all; | |||
8 | 18 | ||||||
8 | 48 | ||||||
708 | 9 | 9 | 1 | 3959 | my $par = shift; | ||
709 | |||||||
710 | 9 | 16 | for ($par) { | ||||
711 | 9 | 41 | s/([!?]+)/ $1/g; | ||||
712 | 9 | 49 | s/([.,;\»´])/ $1/g; | ||||
713 | |||||||
714 | # separa os dois pontos só se não entre números 9:30... | ||||||
715 | 9 | 353 | s/:([^0-9])/ :$1/g; | ||||
716 | |||||||
717 | # separa os dois pontos só se não entre números e não for http:/... | ||||||
718 | 9 | 24 | s/([^0-9]):([^\/])/$1 :$2/g; | ||||
719 | |||||||
720 | # was s/([«`])/$1 /g; -- mas tava a dar problemas com o emacs :| | ||||||
721 | 9 | 16 | s!([`])!$1 !g; | ||||
722 | |||||||
723 | # só separa o parêntesis esquerdo quando não engloba números ou asterisco | ||||||
724 | 9 | 23 | s/\(([^1-9*])/\( $1/g; | ||||
725 | |||||||
726 | # só separa o parêntesis direito quando não engloba números ou asterisco ou percentagem | ||||||
727 | 9 | 23 | s/([^0-9*%])\)/$1 \)/g; | ||||
728 | |||||||
729 | # desfaz a separação dos parênteses para B) | ||||||
730 | 9 | 17 | s/> *([A-Za-z]) \)/> $1\)/g; | ||||
731 | |||||||
732 | # desfaz a separação dos parênteses para (a) | ||||||
733 | 9 | 17 | s/> *\( ([a-z]) \)/> \($1\)/g; | ||||
734 | |||||||
735 | # separação dos parênteses para ( A4 ) | ||||||
736 | 9 | 20 | s/(\( +[A-Z]+[0-9]+)\)/ $1 \)/g; | ||||
737 | |||||||
738 | # separa o parêntesis recto esquerdo desde que não [.. | ||||||
739 | 9 | 16 | s/\[([^.§])/[ $1/g; | ||||
740 | |||||||
741 | # separa o parêntesis recto direito desde que não ..] | ||||||
742 | 9 | 13 | s/([^.§])\]/$1 ]/g; | ||||
743 | |||||||
744 | # separa as reticências só se não dentro de [...] | ||||||
745 | 9 | 15 | s/([^[])§/$1 §/g; | ||||
746 | |||||||
747 | # desfaz a separação dos http: | ||||||
748 | 9 | 13 | s/http :/http:/g; | ||||
749 | |||||||
750 | # separa as aspas anteriores | ||||||
751 | 9 | 22 | s/ \"/ \« /g; | ||||
752 | |||||||
753 | # separa as aspas anteriores mesmo no inicio | ||||||
754 | 9 | 12 | s/^\"/ \« /g; | ||||
755 | |||||||
756 | # separa as aspas posteriores | ||||||
757 | 9 | 15 | s/\" / \» /g; | ||||
758 | |||||||
759 | # separa as aspas posteriores mesmo no fim | ||||||
760 | 9 | 16 | s/\"$/ \»/g; | ||||
761 | |||||||
762 | # trata dos apóstrofes | ||||||
763 | # trata do apóstrofe: só separa se for pelica | ||||||
764 | 9 | 15 | s/([^dDlL])\'([\s\',:.?!])/$1 \'$2/g; | ||||
765 | # trata do apóstrofe: só separa se for pelica | ||||||
766 | 9 | 14 | s/(\S[dDlL])\'([\s\',:.?!])/$1 \'$2/g; | ||||
767 | # separa d' do resto da palavra "d'amor"... "dest'época" | ||||||
768 | 9 | 13 | s/([A-ZÊÁÉÍÓÚÀÇÔÕÃÂa-zôõçáéíóúâêàã])\'([A-ZÊÁÉÍÓÚÀÇÔÕÃÂa-zôõçáéíóúâêàã])/$1\' $2/; | ||||
769 | |||||||
770 | #Para repor PME's | ||||||
771 | 9 | 15 | s/(\s[A-Z]+)\' s([\s,:.?!])/$1\'s$2/g; | ||||
772 | |||||||
773 | # isto é para o caso dos apóstrofos não terem sido tratados pelo COMPARA | ||||||
774 | # separa um apóstrofe final usado como inicial | ||||||
775 | 9 | 13 | s/ '([A-Za-zÁÓÚÉÊÀÂÍ])/ ' $1/g; | ||||
776 | # separa um apóstrofe final usado como inicial | ||||||
777 | 9 | 14 | s/^'([A-Za-zÁÓÚÉÊÀÂÍ])/' $1/g; | ||||
778 | |||||||
779 | # isto é para o caso dos apóstrofes (plicas) serem os do COMPARA | ||||||
780 | 9 | 14 | s/\`([^ ])/\` $1/g; | ||||
781 | 9 | 15 | s/([^ ])´/$1 ´/g; | ||||
782 | |||||||
783 | # trata dos (1) ou 1) | ||||||
784 | # separa casos como Rocha(1) para Rocha (1) | ||||||
785 | 9 | 15 | s/([a-záéãó])\(([0-9])/$1 \($2/g; | ||||
786 | # separa casos como dupla finalidade:1) | ||||||
787 | 9 | 15 | s/:([0-9]\))/ : $1/g; | ||||
788 | |||||||
789 | # trata dos hífenes | ||||||
790 | # separa casos como (Itália)-Juventus para Itália) - | ||||||
791 | 9 | 16 | s/\)\-([A-Z])/\) - $1/g; | ||||
792 | # separa casos como 1-universidade | ||||||
793 | 9 | 18 | s/([0-9]\-)([^0-9\s])/$1 $2/g; | ||||
794 | } | ||||||
795 | |||||||
796 | #trata das barras | ||||||
797 | #se houver palavras que nao sao todas em maiusculas, separa | ||||||
798 | 9 | 20 | my @barras = ($par=~m%(?:[a-z]+/)+(?:[A-Za-z][a-z]*)%g); | ||||
799 | 9 | 12 | my $exp_antiga; | ||||
800 | 9 | 14 | foreach my $exp_com_barras (@barras) { | ||||
801 | 0 | 0 | 0 | 0 | if (($exp_com_barras !~ /[a-z]+a\/o$/) and # Ambicioso/a | ||
0 | |||||||
802 | ($exp_com_barras !~ /[a-z]+o\/a$/) and # cozinheira/o | ||||||
803 | ($exp_com_barras !~ /[a-z]+r\/a$/)) { # desenhador/a | ||||||
804 | 0 | 0 | $exp_antiga=$exp_com_barras; | ||||
805 | 0 | 0 | $exp_com_barras=~s#/# / #g; | ||||
806 | 0 | 0 | $par=~s/$exp_antiga/$exp_com_barras/g; | ||||
807 | } | ||||||
808 | } | ||||||
809 | |||||||
810 | 9 | 13 | for ($par) { | ||||
811 | 9 | 17 | s# e / ou # e/ou #g; | ||||
812 | 9 | 16 | s#([Kk])m / h#$1m/h#g; | ||||
813 | 9 | 13 | s# mg / kg# mg/kg#g; | ||||
814 | 9 | 25 | s#r / c#r/c#g; | ||||
815 | 9 | 16 | s#m / f#m/f#g; | ||||
816 | 9 | 17 | s#f / m#f/m#g; | ||||
817 | } | ||||||
818 | |||||||
819 | |||||||
820 | 9 | 50 | 16 | if (wantarray) { | |||
821 | 0 | 0 | return split /\s+/, $par | ||||
822 | } else { | ||||||
823 | 9 | 83 | $par =~ s/\s+/\n/g; | ||||
824 | 9 | 32 | return $par | ||||
825 | } | ||||||
826 | } | ||||||
827 | |||||||
828 | |||||||
829 | |||||||
830 | sub tratar_pontuacao_interna { | ||||||
831 | 8 | 8 | 18230 | use utf8::all; | |||
8 | 19 | ||||||
8 | 30 | ||||||
832 | 0 | 0 | 1 | my $par = shift; | |||
833 | |||||||
834 | # print "Estou no pontuação interna... $par\n"; | ||||||
835 | |||||||
836 | 0 | for ($par) { | |||||
837 | # proteger o § | ||||||
838 | 0 | s/§/§§/g; | |||||
839 | |||||||
840 | # tratar das reticências | ||||||
841 | 0 | s/\.\.\.+/§/g; | |||||
842 | |||||||
843 | 0 | s/\+/\+\+/g; | |||||
844 | |||||||
845 | # tratar de iniciais seguidas por ponto, eventualmente com | ||||||
846 | # parênteses, no fim de uma frase | ||||||
847 | 0 | s/([A-Z])\. ([A-Z])\.(\s*[])]*\s*)$/$1+ $2+$3 /g; | |||||
848 | |||||||
849 | # iniciais com espaço no meio... | ||||||
850 | 0 | s/ a\. C\./ a+C+/g; | |||||
851 | 0 | s/ d\. C\./ d+C+/g; | |||||
852 | |||||||
853 | # tratar dos pontos nas abreviaturas | ||||||
854 | 0 | s/\.º/º+/g; | |||||
855 | 0 | s/º\./+º/g; | |||||
856 | 0 | s/\.ª/+ª/g; | |||||
857 | 0 | s/ª\./ª+/g; | |||||
858 | |||||||
859 | #só mudar se não for ambíguo com ponto final | ||||||
860 | 0 | s/º\. +([^A-ZÀÁÉÍÓÚÂÊ\«])/º+ $1/g; | |||||
861 | |||||||
862 | # formas de tratamento | ||||||
863 | 0 | s/Ex\./Ex+/g; # Ex. | |||||
864 | 0 | s/ ex\./ ex+/g; # ex. | |||||
865 | 0 | s/Exa(s*)\./Exa$1+/g; # Exa., Exas. | |||||
866 | 0 | s/ exa(s*)\./ exa$1+/g; # exa., exas | |||||
867 | 0 | s/Pe\./Pe+/g; | |||||
868 | 0 | s/Dr(a*)\./Dr$1+/g; # Dr., Dra. | |||||
869 | 0 | s/ dr(a*)\./ dr$1+/g; # dr., dra. | |||||
870 | 0 | s/ drs\./ drs+/g; # drs. | |||||
871 | 0 | s/Eng(a*)\./Eng$1+/g; # Eng., Enga. | |||||
872 | 0 | s/ eng(a*)\./ eng$1+/g; # eng., enga. | |||||
873 | 0 | s/([Ss])r(t*)a\./$1r$2a+/g; # Sra., sra., Srta., srta. | |||||
874 | 0 | s/([Ss])r(s*)\./$1r$2+/g; # Sr., sr., Srs., srs. | |||||
875 | 0 | s/ arq\./ arq+/g; # arq. | |||||
876 | 0 | s/Prof(s*)\./Prof$1+/g; # Prof., Profs. | |||||
877 | 0 | s/Profa(s*)\./Profa$1+/g; # Profa., Profas. | |||||
878 | 0 | s/ prof(s*)\./ prof$1+/g; # prof., profs. | |||||
879 | 0 | s/ profa(s*)\./ profa$1+/g; # profa., profas. | |||||
880 | 0 | s/\. Sen\./+ Sen+/g; # senador (vem sempre depois de Av. ou R. ...) | |||||
881 | 0 | s/ua Sen\./ua Sen+/g; # senador (depois [Rr]ua ...) | |||||
882 | 0 | s/Cel\./Cel+/g; # coronel | |||||
883 | 0 | s/ d\. / d+ /g; # d. Luciano | |||||
884 | |||||||
885 | # partes de nomes (pospostos) | ||||||
886 | 0 | s/ ([lL])da\./ $1da+/g; # limitada | |||||
887 | 0 | s/ cia\./ cia+/g; # companhia | |||||
888 | 0 | s/Cia\./Cia+/g; # companhia | |||||
889 | 0 | s/Jr\./Jr+/g; | |||||
890 | |||||||
891 | # moradas | ||||||
892 | 0 | s/Av\./Av+/g; | |||||
893 | 0 | s/ av\./ av+/g; | |||||
894 | 0 | s/Est(r*)\./Est$1+/g; | |||||
895 | 0 | s/Lg(o*)\./Lg$1+/g; | |||||
896 | 0 | s/ lg(o*)\./ lg$1+/g; | |||||
897 | 0 | s/T(ra)*v\./T$1v+/g; # Trav., Tv. | |||||
898 | 0 | s/([^N])Pq\./$1Pq+/g; # Parque (cuidado com CNPq) | |||||
899 | 0 | s/ pq\./ pq+/g; # parque | |||||
900 | 0 | s/Jd\./Jd+/g; # jardim | |||||
901 | 0 | s/Ft\./Ft+/g; # forte | |||||
902 | 0 | s/Cj\./Cj+/g; # conjunto | |||||
903 | 0 | s/ ([lc])j\./ $1j+/g; # conjunto ou loja | |||||
904 | # $par=~s/ al\./ al+/g; # alameda tem que ir para depois de et.al... | ||||||
905 | |||||||
906 | # Remover aqui uns warningzitos | ||||||
907 | 0 | s/Tel\./Tel+/g; # Tel. | |||||
908 | 0 | s/Tel(e[fm])\./Tel$1+/g; # Telef., Telem. | |||||
909 | 0 | s/ tel\./ tel+/g; # tel. | |||||
910 | 0 | s/ tel(e[fm])\./ tel$1+/g; # telef., telem. | |||||
911 | 0 | s/Fax\./Fax+/g; # Fax. | |||||
912 | 0 | s/ cx\./ cx+/g; # caixa | |||||
913 | |||||||
914 | # abreviaturas greco-latinas | ||||||
915 | 0 | s/ a\.C\./ a+C+/g; | |||||
916 | 0 | s/ a\.c\./ a+c+/g; | |||||
917 | 0 | s/ d\.C\./ d+C+/g; | |||||
918 | 0 | s/ d\.c\./ d+c+/g; | |||||
919 | 0 | s/ ca\./ ca+/g; | |||||
920 | 0 | s/etc\.([.,;])/etc+$1/g; | |||||
921 | 0 | s/etc\.\)([.,;])/etc+)$1/g; | |||||
922 | 0 | s/etc\. --( *[a-záéíóúâêà,])/etc+ --$1/g; | |||||
923 | 0 | s/etc\.(\)*) ([^A-ZÀÁÉÍÓÂÊ])/etc+$1 $2/g; | |||||
924 | 0 | s/ et\. *al\./ et+al+/g; | |||||
925 | 0 | s/ al\./ al+/g; # alameda | |||||
926 | 0 | s/ q\.b\./ q+b+/g; | |||||
927 | 0 | s/ i\.e\./ i+e+/g; | |||||
928 | 0 | s/ibid\./ibid+/g; | |||||
929 | 0 | s/ id\./ id+/g; # se calhar é preciso ver se não vem sempre precedido de um ( | |||||
930 | 0 | s/op\.( )*cit\./op+$1cit+/g; | |||||
931 | 0 | s/P\.S\./P+S+/g; | |||||
932 | |||||||
933 | # unidades de medida | ||||||
934 | 0 | s/([0-9][hm])\. ([^A-ZÀÁÉÍÓÚÂÊ])/$1+ $2/g; # 19h., 24m. | |||||
935 | 0 | s/([0-9][km]m)\. ([^A-ZÀÁÉÍÓÚÂÊ])/$1+ $2/g; # 20km., 24mm. | |||||
936 | 0 | s/([0-9]kms)\. ([^A-ZÀÁÉÍÓÚÂÊ])/$1+ $2/g; # kms. !! | |||||
937 | 0 | s/(\bm)\./$1+/g; # metros no MINHO | |||||
938 | |||||||
939 | # outros | ||||||
940 | 0 | s/\(([Oo]rgs*)\.\)/($1+)/g; # (orgs.) | |||||
941 | 0 | s/\(([Ee]ds*)\.\)/($1+)/g; # (eds.) | |||||
942 | 0 | s/séc\./séc+/g; | |||||
943 | 0 | s/pág(s*)\./pág$1+/g; | |||||
944 | 0 | s/pg\./pg+/g; | |||||
945 | 0 | s/pag\./pag+/g; | |||||
946 | 0 | s/ ed\./ ed+/g; | |||||
947 | 0 | s/Ed\./Ed+/g; | |||||
948 | 0 | s/ sáb\./ sáb+/g; | |||||
949 | 0 | s/ dom\./ dom+/g; | |||||
950 | 0 | s/ id\./ id+/g; | |||||
951 | 0 | s/ min\./ min+/g; | |||||
952 | 0 | s/ n\.o(s*) / n+o$1 /g; # abreviatura de numero no MLCC-DEB | |||||
953 | 0 | s/ ([Nn])o\.(s*)\s*([0-9])/ $1o+$2 $3/g; # abreviatura de numero no., No. | |||||
954 | 0 | s/ n\.(s*)\s*([0-9])/ n+$1 $2/g; # abreviatura de numero n. no ANCIB | |||||
955 | 0 | s/ num\. *([0-9])/ num+ $1/g; # abreviatura de numero num. no ANCIB | |||||
956 | 0 | s/ c\. ([0-9])/ c+ $1/g; # c. 1830 | |||||
957 | 0 | s/ p\.ex\./ p+ex+/g; | |||||
958 | 0 | s/ p\./ p+/g; | |||||
959 | 0 | s/ pp\./ pp+/g; | |||||
960 | 0 | s/ art(s*)\./ art$1+/g; | |||||
961 | 0 | s/Min\./Min+/g; | |||||
962 | 0 | s/Inst\./Inst+/g; | |||||
963 | 0 | s/vol(s*)\./vol$1+ /g; | |||||
964 | 0 | s/ v\. *([0-9])/ v+ $1/g; # abreviatura de volume no ANCIB | |||||
965 | 0 | s/\(v\. *([0-9])/\(v+ $1/g; # abreviatura de volume no ANCIB | |||||
966 | 0 | s/^v\. *([0-9])/v+ $1/g; # abreviatura de volume no ANCIB | |||||
967 | 0 | s/Obs\./Obs+/g; | |||||
968 | |||||||
969 | # Abreviaturas de meses | ||||||
970 | 0 | s/(\W)jan\./$1jan+/g; | |||||
971 | 0 | s/\Wfev\./$1fev+/g; | |||||
972 | 0 | s/(\/\s*)mar\.(\s*[0-9\/])/$1mar+$2/g; # a palavra "mar" | |||||
973 | 0 | s/(\W)mar\.(\s*[0-9]+)/$1mar\+$2/g; | |||||
974 | 0 | s/(\W)abr\./$1abr+/g; | |||||
975 | 0 | s/(\W)mai\./$1mai+/g; | |||||
976 | 0 | s/(\W)jun\./$1jun+/g; | |||||
977 | 0 | s/(\W)jul\./$1jul+/g; | |||||
978 | 0 | s/(\/\s*)ago\.(\s*[0-9\/])/$1ago+$2/g; # a palavra inglesa "ago" | |||||
979 | 0 | s/ ago\.(\s*[0-9\/])/ ago+$1/g; # a palavra inglesa "ago./" | |||||
980 | 0 | s/(\W)set\.(\s*[0-9\/])/$1set+$2/g; # a palavra inglesa "set" | |||||
981 | 0 | s/([ \/])out\.(\s*[0-9\/])/$1out+$2/g; # a palavra inglesa "out" | |||||
982 | 0 | s/(\W)nov\./$1nov+/g; | |||||
983 | 0 | s/(\/\s*)dez\.(\s*[0-9\/])/$1dez+$2/g; # a palavra "dez" | |||||
984 | 0 | s/(\/\s*)dez\./$1dez+/g; # a palavra "/dez." | |||||
985 | |||||||
986 | # Abreviaturas inglesas | ||||||
987 | 0 | s/Bros\./Bros+/g; | |||||
988 | 0 | s/Co\. /Co+ /g; | |||||
989 | 0 | s/Co\.$/Co+/g; | |||||
990 | 0 | s/Com\. /Com+ /g; | |||||
991 | 0 | s/Com\.$/Com+/g; | |||||
992 | 0 | s/Corp\. /Corp+ /g; | |||||
993 | 0 | s/Inc\. /Inc+ /g; | |||||
994 | 0 | s/Ltd\. /Ltd+ /g; | |||||
995 | 0 | s/([Mm])r(s*)\. /$1r$2+ /g; | |||||
996 | 0 | s/Ph\.D\./Ph+D+/g; | |||||
997 | 0 | s/St\. /St+ /g; | |||||
998 | 0 | s/ st\. / st+ /g; | |||||
999 | |||||||
1000 | # Abreviaturas francesas | ||||||
1001 | 0 | s/Mme\./Mme+/g; | |||||
1002 | |||||||
1003 | # Abreviaturas especiais do Diário do Minho | ||||||
1004 | 0 | s/ habilit\./ habilit+/g; | |||||
1005 | 0 | s/Hab\./Hab+/g; | |||||
1006 | 0 | s/Mot\./Mot+/g; | |||||
1007 | 0 | s/\-Ang\./-Ang+/g; | |||||
1008 | 0 | s/(\bSp)\./$1+/g; # Sporting | |||||
1009 | 0 | s/(\bUn)\./$1+/g; # Universidade | |||||
1010 | |||||||
1011 | # Abreviaturas especiais do Folha | ||||||
1012 | 0 | s/([^'])Or\./$1Or+/g; # alemanha Oriental, evitar d'Or | |||||
1013 | 0 | s/Oc\./Oc+/g; # alemanha Ocidental | |||||
1014 | |||||||
1015 | } | ||||||
1016 | |||||||
1017 | # tratar dos conjuntos de iniciais | ||||||
1018 | 0 | my @siglas_iniciais = ($par =~ /^(?:[A-Z]\. *)+[A-Z]\./); | |||||
1019 | 0 | my @siglas_finais = ($par =~ /(?:[A-Z]\. *)+[A-Z]\.$/); | |||||
1020 | 0 | my @siglas = ($par =~ m#(?:[A-Z]\. *)+(?:[A-Z]\.)(?=[]\)\s,;:!?/])#g); #trata de conjuntos de iniciais | |||||
1021 | 0 | push (@siglas, @siglas_iniciais); | |||||
1022 | 0 | push (@siglas, @siglas_finais); | |||||
1023 | 0 | my $sigla_antiga; | |||||
1024 | 0 | foreach my $sigla (@siglas) { | |||||
1025 | 0 | $sigla_antiga = $sigla; | |||||
1026 | 0 | $sigla =~ s/\./+/g; | |||||
1027 | 0 | $sigla_antiga =~ s/\./\\\./g; | |||||
1028 | # print "SIGLA antes: $sigla, $sigla_antiga\n"; | ||||||
1029 | 0 | $par =~ s/$sigla_antiga/$sigla/g; | |||||
1030 | # print "SIGLA: $sigla\n"; | ||||||
1031 | } | ||||||
1032 | |||||||
1033 | # tratar de pares de iniciais ligadas por hífen (à francesa: A.-F.) | ||||||
1034 | 0 | for ($par) { | |||||
1035 | 0 | s/ ([A-Z])\.\-([A-Z])\. / $1+-$2+ /g; | |||||
1036 | # tratar de iniciais (únicas?) seguidas por ponto | ||||||
1037 | 0 | s/ ([A-Z])\. / $1+ /g; | |||||
1038 | # tratar de iniciais seguidas por ponto | ||||||
1039 | 0 | s/^([A-Z])\. /$1+ /g; | |||||
1040 | # tratar de iniciais seguidas por ponto antes de aspas "D. João | ||||||
1041 | # VI: Um Rei Aclamado" | ||||||
1042 | 0 | s/([("\«])([A-Z])\. /$1$2+ /g; | |||||
1043 | } | ||||||
1044 | |||||||
1045 | # Tratar dos URLs (e também dos endereços de email) | ||||||
1046 | # email= url@url... | ||||||
1047 | # aceito endereços seguidos de /hgdha/hdga.html | ||||||
1048 | # seguidos de /~hgdha/hdga.html | ||||||
1049 | # @urls=($par=~/(?:[a-z][a-z0-9-]*\.)+(?:[a-z]+)(?:\/~*[a-z0-9-]+)*?(?:\/~*[a-z0-9][a-z0-9.-]+)*(?:\/[a-z.]+\?[a-z]+=[a-z0-9-]+(?:\&[a-z]+=[a-z0-9-]+)*)*/gi); | ||||||
1050 | |||||||
1051 | 0 | my @urls = ($par =~ /(?:[a-z][a-z0-9-]*\.)+(?:[a-z]+)(?:\/~*[a-z0-9][a-z0-9.-]+)*(?:\?[a-z]+=[a-z0-9-]+(?:\&[a-z]+=[a-z0-9-]+)*)*/gi); | |||||
1052 | 0 | my $url_antigo; | |||||
1053 | 0 | foreach my $url (@urls) { | |||||
1054 | 0 | $url_antigo = $url; | |||||
1055 | 0 | $url_antigo =~ s/\./\\./g; # para impedir a substituição de P.o em vez de P\.o | |||||
1056 | 0 | $url_antigo =~ s/\?/\\?/g; | |||||
1057 | 0 | $url =~ s/\./+/g; | |||||
1058 | # Se o último ponto está mesmo no fim, não faz parte do URL | ||||||
1059 | 0 | $url =~ s/\+$/./; | |||||
1060 | 0 | $url =~ s/\//\/\/\/\//g; # põe quatro //// | |||||
1061 | 0 | $par =~ s/$url_antigo/$url/; | |||||
1062 | } | ||||||
1063 | # print "Depois de tratar dos URLs: $par\n"; | ||||||
1064 | |||||||
1065 | 0 | for ($par) { | |||||
1066 | # de qualquer maneira, se for um ponto seguido de uma vírgula, é | ||||||
1067 | # abreviatura... | ||||||
1068 | 0 | s/\. *,/+,/g; | |||||
1069 | # de qualquer maneira, se for um ponto seguido de outro ponto, é | ||||||
1070 | # abreviatura... | ||||||
1071 | 0 | s/\. *\./+./g; | |||||
1072 | |||||||
1073 | # tratamento de numerais | ||||||
1074 | 0 | s/([0-9]+)\.([0-9]+)\.([0-9]+)/$1_$2_$3/g; | |||||
1075 | 0 | s/([0-9]+)\.([0-9]+)/$1_$2/g; | |||||
1076 | |||||||
1077 | # tratamento de numerais cardinais | ||||||
1078 | # - tratar dos números com ponto no início da frase | ||||||
1079 | 0 | s/^([0-9]+)\. /$1+ /g; | |||||
1080 | # - tratar dos números com ponto antes de minúsculas | ||||||
1081 | 0 | s/([0-9]+)\. ([a-záéíóúâêà])/$1+ $2/g; | |||||
1082 | |||||||
1083 | # tratamento de numerais ordinais acabados em .o | ||||||
1084 | 0 | s/([0-9]+)\.([oa]s*) /$1+$2 /g; | |||||
1085 | # ou expressos como 9a. | ||||||
1086 | 0 | s/([0-9]+)([oa]s*)\. /$1$2+ /g; | |||||
1087 | |||||||
1088 | # tratar numeracao decimal em portugues | ||||||
1089 | 0 | s/([0-9]),([0-9])/$1#$2/g; | |||||
1090 | |||||||
1091 | #print "TRATA: $par\n"; | ||||||
1092 | |||||||
1093 | # tratar indicação de horas | ||||||
1094 | # esta é tratada na tokenização - não separando 9:20 em 9 :20 | ||||||
1095 | } | ||||||
1096 | 0 | return $par; | |||||
1097 | } | ||||||
1098 | |||||||
1099 | |||||||
1100 | sub separa_frases { | ||||||
1101 | 8 | 8 | 32078 | use utf8::all; | |||
8 | 19 | ||||||
8 | 41 | ||||||
1102 | 0 | 0 | 1 | my $par = shift; | |||
1103 | |||||||
1104 | # $num++; | ||||||
1105 | |||||||
1106 | 0 | $par = &tratar_pontuacao_interna($par); | |||||
1107 | |||||||
1108 | # print "Depois de tratar_pontuacao_interna: $par\n"; | ||||||
1109 | |||||||
1110 | 0 | for ($par) { | |||||
1111 | |||||||
1112 | # primeiro junto os ) e os -- ao caracter anterior de pontuação | ||||||
1113 | 0 | s/([?!.])\s+\)/$1\)/g; # pôr "ola? )" para "ola?)" | |||||
1114 | 0 | s/([?!.])\s+\-/$1-/g; # pôr "ola? --" para "ola?--" | |||||
1115 | 0 | s/([?!.])\s+§/$1§/g; # pôr "ola? ..." para "ola?..." | |||||
1116 | 0 | s/§\s+\-/$1-/g; # pôr "ola§ --" para "ola§--" | |||||
1117 | |||||||
1118 | # junto tb o travessão -- `a pelica ' | ||||||
1119 | 0 | s/\-\- \' *$/\-\-\' /; | |||||
1120 | |||||||
1121 | # separar esta pontuação, apenas se não for dentro de aspas, ou | ||||||
1122 | # seguida por vírgulas ou parênteses o a-z estáo lá para não | ||||||
1123 | # separar /asp?id=por ... | ||||||
1124 | 0 | s/([?!]+)([^-\»'´,§?!)"a-z])/$1.$2/g; | |||||
1125 | |||||||
1126 | # Deixa-se o travessão para depois | ||||||
1127 | # print "Depois de tratar do ?!: $par"; | ||||||
1128 | |||||||
1129 | # separar as reticências entre parênteses apenas se forem seguidas | ||||||
1130 | # de nova frase, e se não começarem uma frase elas próprias | ||||||
1131 | 0 | s/([\w?!])§([\»"´']*\)) *([A-ZÁÉÍÓÚÀ])/$1§$2.$3/g; | |||||
1132 | |||||||
1133 | # print "Depois de tratar das retic. seguidas de ): $par"; | ||||||
1134 | |||||||
1135 | # separar os pontos antes de parênteses se forem seguidos de nova | ||||||
1136 | # frase | ||||||
1137 | 0 | s/([\w])\.([)]) *([A-ZÁÉÍÓÚÀ])/$1 + $2.$3/g; | |||||
1138 | |||||||
1139 | # separar os pontos ? e ! antes de parênteses se forem seguidos de | ||||||
1140 | # nova frase, possivelmente tb iniciada por abre parênteses ou | ||||||
1141 | # travessão | ||||||
1142 | 0 | s/(\w[?!]+)([)]) *((?:\( |\-\- )*[A-ZÁÉÍÓÚÀ])/$1 $2.$3/g; | |||||
1143 | |||||||
1144 | # separar as reticências apenas se forem seguidas de nova frase, e | ||||||
1145 | # se não começarem uma frase elas próprias trata também das | ||||||
1146 | # reticências antes de aspas | ||||||
1147 | 0 | s/([\w\d!?])\s*§(["\»'´]*) ([^\»"'a-záéíóúâêàäëïöü,;?!)])/$1§$2.$3/g; | |||||
1148 | 0 | s/([\w\d!?])\s*§(["\»'´]*)\s*$/$1§$2. /g; | |||||
1149 | |||||||
1150 | # aqui trata das frases acabadas por aspas, eventualmente tb | ||||||
1151 | # fechando parênteses e seguidas por reticências | ||||||
1152 | 0 | s/([\w!?]["\»'´])§(\)*) ([^\»"a-záéíóúâêàäëïöü,;?!)])/$1§$2.$3/g; | |||||
1153 | |||||||
1154 | #print "depois de tratar das reticencias seguidas de nova frase: $par\n"; | ||||||
1155 | |||||||
1156 | # tratar dos dois pontos: apenas se seguido por discurso directo | ||||||
1157 | # em maiúsculas | ||||||
1158 | 0 | s/: \«([A-ZÁÉÍÓÚÀ])/:.\«$1/g; | |||||
1159 | 0 | s/: (\-\-[ \«]*[A-ZÁÉÍÓÚÀ])/:.$1/g; | |||||
1160 | |||||||
1161 | # tratar dos dois pontos se eles acabam o parágrafo (é preciso pôr | ||||||
1162 | # um espaço) | ||||||
1163 | 0 | s/:\s*$/:. /; | |||||
1164 | |||||||
1165 | # tratar dos pontos antes de aspas | ||||||
1166 | 0 | s/\.(["\»'´])([^.])/+$1.$2/g; | |||||
1167 | |||||||
1168 | # tratar das aspas quando seguidas de novas aspas | ||||||
1169 | 0 | s/\»\s*[\«"]/\». \«/g; | |||||
1170 | |||||||
1171 | # tratar de ? e ! seguidos de aspas quando seguidos de maiúscula | ||||||
1172 | # eventualmente iniciados por abre parênteses ou por travessão | ||||||
1173 | 0 | s/([?!])([\»"'´]) ((?:\( |\-\- )*[A-ZÁÉÍÓÚÀÊÂ])/$1$2. $3/g; | |||||
1174 | |||||||
1175 | # separar os pontos ? e ! antes de parênteses e possivelmente | ||||||
1176 | # aspas se forem o fim do parágrafo | ||||||
1177 | 0 | s/(\w[?!]+)([)][\»"'´]*) *$/$1 $2./; | |||||
1178 | |||||||
1179 | # tratar dos pontos antes de aspas precisamente no fim | ||||||
1180 | 0 | s/\.([\»"'´])\s*$/+$1. /g; | |||||
1181 | |||||||
1182 | # tratar das reticências e outra pontuação antes de aspas ou | ||||||
1183 | # plicas precisamente no fim | ||||||
1184 | 0 | s/([!?§])([\»"'´]+)\s*$/$1$2. /g; | |||||
1185 | |||||||
1186 | #tratar das reticências precisamente no fim | ||||||
1187 | 0 | s/§\s*$/§. /g; | |||||
1188 | |||||||
1189 | # tratar dos pontos antes de parêntesis precisamente no fim | ||||||
1190 | 0 | s/\.\)\s*$/+\). /g; | |||||
1191 | |||||||
1192 | # aqui troco .) por .). ... | ||||||
1193 | 0 | s/\.\)\s/+\). /g; | |||||
1194 | } | ||||||
1195 | |||||||
1196 | # tratar de parágrafos que acabam em letras, números, vírgula ou | ||||||
1197 | # "-", chamando-os fragmentos #ALTERACAO | ||||||
1198 | 0 | my $fragmento; | |||||
1199 | 0 | 0 | if ($par =~/[A-Za-záéíóúêãÁÉÍÓÚÀ0-9\),-][\»\"\'´>]*\s*\)*\s*$/) { | ||||
1200 | 0 | $fragmento = 1 | |||||
1201 | } | ||||||
1202 | |||||||
1203 | 0 | for ($par) { | |||||
1204 | # se o parágrafo acaba em "+", deve-se juntar "." outra vez. | ||||||
1205 | 0 | s/([^+])\+\s*$/$1+. /; | |||||
1206 | |||||||
1207 | # se o parágrafo acaba em abreviatura (+) seguido de aspas ou parêntesis, deve-se juntar "." | ||||||
1208 | 0 | s/([^+])\+\s*(["\»'´\)])\s*$/$1+$2. /; | |||||
1209 | |||||||
1210 | # print "Parágrafo antes da separação: $par"; | ||||||
1211 | } | ||||||
1212 | |||||||
1213 | 0 | my @sentences = split /\./,$par; | |||||
1214 | 0 | 0 | 0 | if (($#sentences > 0) and not $fragmento) { | |||
1215 | 0 | pop(@sentences); | |||||
1216 | } | ||||||
1217 | |||||||
1218 | 0 | my $resultado = ""; | |||||
1219 | # para saber em que frase pôr |
||||||
1220 | 0 | my $num_frase_no_paragrafo = 0; | |||||
1221 | 0 | foreach my $frase (@sentences) { | |||||
1222 | 0 | $frase = &recupera_ortografia_certa($frase); | |||||
1223 | |||||||
1224 | 0 | 0 | 0 | if (($frase=~/[.?!:;][\»"'´]*\s*$/) or | |||
0 | 0 | ||||||
1225 | ($frase=~/[.?!] *\)[\»"'´]*$/)) { | ||||||
1226 | # frase normal acabada por pontuação | ||||||
1227 | 0 | $resultado .= " |
|||||
1228 | } | ||||||
1229 | |||||||
1230 | elsif (($fragmento) and ($num_frase_no_paragrafo == $#sentences)) { | ||||||
1231 | 0 | $resultado .= " |
|||||
1232 | 0 | $fragmento = 0; | |||||
1233 | } | ||||||
1234 | else { | ||||||
1235 | 0 | $resultado .= " |
|||||
1236 | } | ||||||
1237 | 0 | $num_frase_no_paragrafo++; | |||||
1238 | } | ||||||
1239 | |||||||
1240 | 0 | return $resultado; | |||||
1241 | } | ||||||
1242 | |||||||
1243 | |||||||
1244 | sub recupera_ortografia_certa { | ||||||
1245 | 8 | 8 | 19512 | use utf8::all; | |||
8 | 27 | ||||||
8 | 40 | ||||||
1246 | # os sinais literais de + são codificados como "++" para evitar | ||||||
1247 | # transformação no ponto, que é o significado do "+" | ||||||
1248 | |||||||
1249 | 0 | 0 | 1 | my $par = shift; | |||
1250 | |||||||
1251 | 0 | for ($par) { | |||||
1252 | 0 | s/([^+])\+(?!\+)/$1./g; # um + não seguido por + | |||||
1253 | 0 | s/\+\+/+/g; | |||||
1254 | 0 | s/^§(?!§)/.../g; # se as reticências começam a frase | |||||
1255 | 0 | s/([^§(])§(?!§)\)/$1... \)/g; # porque se juntou no separa_frases | |||||
1256 | # So nao se faz se for (...) ... | ||||||
1257 | 0 | s/([^§])§(?!§)/$1.../g; # um § não seguido por § | |||||
1258 | 0 | s/§§/§/g; | |||||
1259 | 0 | s/_/./g; | |||||
1260 | 0 | s/#/,/g; | |||||
1261 | 0 | s#////#/#g; #passa 4 para 1 | |||||
1262 | 0 | s/([?!])\-/$1 \-/g; # porque se juntou no separa_frases | |||||
1263 | 0 | s/([?!])\)/$1 \)/g; # porque se juntou no separa_frases | |||||
1264 | } | ||||||
1265 | 0 | return $par; | |||||
1266 | } | ||||||
1267 | |||||||
1268 | |||||||
1269 | 1; | ||||||
1270 | __END__ |