File Coverage

blib/lib/Lingua/PT/Conjugate.pm
Criterion Covered Total %
statement 188 479 39.2
branch 131 356 36.8
condition 72 274 26.2
subroutine 13 28 46.4
pod 0 20 0.0
total 404 1157 34.9


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2             #
3             # Perl package exporting a function "conjug" that conjugates
4             # Portuguese verbs.
5             #
6             # Author : Etienne Grossmann (etienne@isr.ist.utl.pt)
7             #
8             # Date : May 1997 onwards.
9             #
10             # The verb data base is at the end of this file.
11             #
12             # Changes :
13             # 6/30/97 - Verbos Abundantes.
14             # 7/01/97 - Verbos Defectivos.
15             # 12/27/97 - Iso 8859 Accents.
16             # 01 98 - Renaming of conj.pm as Lingua/PT/Conjugate.pm and
17             # likewise for other files.
18             # - Make iso-accents the default, use them in verb database
19             # and source files.
20             # - Added double-past-participles that I had forgotten about.
21             # - Verb database as a string, is at the end of this file.
22             # - put use //o whenever possible, as suggested by Eryq
23             #
24             # 02 98 - Recognize long forms of verbs
25             # - Derivatives of "ter" (ugly fix)
26             # 03 98 - A few fixes, cleaned up code.
27             # 05 98 - A few more "defective" verbs.
28             # 11 98 - Include Accent_iso_8859_1.pm within Conjugate.pm
29             # - Call it version 0.90.
30             # - Add targets 'treinar.pl', 'conjug.pl', that
31             # are truly standalone, in the sense that they don't
32             # require Lingua::PT::Conjugate to be installed.
33             # 12 98 - A few past participles in 'uido' didn't have the required
34             # accent. Fixed.
35             # 3 99 - Options 'o' (comma-separated result) and 'l' (long format
36             # for verb names)
37             # - Fix installation of Lingua::PT::Conjugate.
38             # 5 99 - Minor doc fixes
39             # 6 99 - Portability of t/test.t fixed by cpan-tester Lupe.
40             # 8 99 - Miguel Marques noticed
41             # that 'cegar' had a wrong and ugly past participle. And
42             # another bug too. And that 'Lingua::PT::conjug()' should
43             # be able to return a hash. This is already possible, but I
44             # hadn't documented it. All this is fixed in Version
45             # 1.01. Also, some tests have been added.
46             # - Put second person plural in 1.02, as suggested by
47             # Miguel, and fixed all bugs I found. I doubt 2nd plural is
48             # always correct.
49             # - 1.03 : Code cleaning and commenting, fixed doc.
50             # 9 99 - 1.04 : Imperativo of second plural follows a simple rule
51             # which I had overlooked. Fixed. Some places where
52             # "Diciónario Online da Lingua Portuguesa" (DLPO) and "Guia
53             # Prática dos Verbos Portugueses" (GPVP) differ have been
54             # docummented in the verb database at end of this file.
55             #
56             # 12 2000 - Incorporate Unconjugate-related stuff
57             # 10 2002 - A few fixes in verbs
58             # 08 2013 - Start printing in utf8
59             # 06 2014 - Strings in utf8.
60             #
61             # See recent changes in file ChangeLog
62              
63             $VERSION = '1.20' ;
64              
65             # Just to make sure which file is loaded
66             # BEGIN{ print "SEE THIS ???\n",`pwd` }
67              
68             package Lingua::PT::Conjugate;
69              
70             #
71             # Accent_iso_8859_1.pm
72             # Author : Etienne Grossmann
73             # Created On : December 1997
74             # Last Modified On: January 1998
75             # Language : Perl
76             # Status : Use with caution!
77             #
78             # (C) Copyright 1998 Etienne Grossmann
79             #
80             #
81             # Convert to-from iso accent
82             # 01/10/97
83             # Bug : 'e -(iso2asc)-> 'e -(asc2iso)-> chr(233)!="'e"
84             # Fix : iso2asc("'") == "' "
85             # asc2iso("' ") == "'"
86             #
87              
88             package Lingua::PT::Accent_iso_8859_1;
89             # Not needed? use feature 'unicode_strings';
90 1     1   41311 use utf8;
  1         10  
  1         6  
91 1     1   32 use Exporter ;
  1         2  
  1         700  
92             @ISA = qw(Exporter);
93             # Yes, this package is a namespace polluter.
94             @EXPORT = qw(iso2asc asc2iso un_accent);
95             @EXPORT_OK = qw( iso2ascii ascii2iso );
96             %iso2ascii = (
97             "\'" =>"' ",
98             chr(0347)=>'\c',
99            
100             chr( 224)=>'`a',
101             chr( 225)=>'\'a',
102             chr( 226)=>'^a',
103             chr( 227)=>'~a',
104              
105             chr( 232)=>'`e',
106             chr( 233)=>'\'e',
107             chr( 234)=>'^e',
108              
109             chr( 236)=>'`i',
110             chr( 237)=>'\'i',
111             chr( 238)=>'^i',
112              
113             chr( 211)=>'\'O',
114             chr( 242)=>'`o',
115             chr( 243)=>'\'o',
116             chr( 244)=>'^o',
117             chr( 245)=>'~o',
118              
119             chr( 249)=>'`u',
120             chr( 250)=>'\'u',
121             chr( 251)=>'^u',
122             );
123             %ascii2iso = reverse %iso2ascii;
124             %ascii2iso_keys = (
125             "\' " =>"'",
126             '\\\\c'=>chr(0347),
127            
128             '\`a'=>chr( 224),
129             '\'a'=>chr( 225),
130             '\^a'=>chr( 226),
131             '\~a'=>chr( 227),
132              
133             '\`e'=>chr( 232),
134             '\'e'=>chr( 233),
135             '\^e'=>chr( 234),
136              
137             '\`i'=>chr( 236),
138             '\'i'=>chr( 237),
139             '\^i'=>chr( 238),
140              
141             '\'O'=>chr( 211),
142             '\`o'=>chr( 242),
143             '\'o'=>chr( 243),
144             '\^o'=>chr( 244),
145             '\~o'=>chr( 245),
146              
147             '\`u'=>chr( 249),
148             '\'u'=>chr( 250),
149             '\^u'=>chr( 251),
150              
151             );
152             # Accent-matching regexp
153             $find_iso_accent = "[".join("",keys(%iso2ascii))."]";
154              
155             # Accent-matching regexp
156             $find_ascii_accent = join("|",keys(%ascii2iso_keys));
157              
158             # Crude code
159             sub un_accent
160             {
161             ## return unless(defined @_);
162 50 50   50   236 return unless @_;
163 50         94 my @a=@_;
164 50         76 iso2asc(map {s/[\'\`\^\~]([aAeEiIoOuU])/$1/g; $_} @a)
  50         94  
  50         136  
165             }
166              
167             sub iso2asc {
168 50     50   59 my ($x,@res);
169              
170             # print "iso2asc : ";
171 50         119 while( $#_ >=0 ){
172 50         77 $x = shift @_ ;
173             # print "$x, ";
174 50 50       268 $x=~s/($find_iso_accent)/$iso2ascii{$1}/g if defined($x);
175 50         154 push @res,$x;
176             }
177             # print "\n";
178 50 50 33     512 $#res || wantarray ? @res : $res[0] ;
179             }
180              
181             sub asc2iso {
182 0     0   0 my ($x,@res);
183              
184             # print " N args $#_ \n";
185             # print "\nrrr",join("RRR\nRRR",@_),"rrr\n";
186 0         0 while( $#_>=0 ){
187 0         0 $x = shift @_;
188 0 0       0 $x=~s/($find_ascii_accent)/$ascii2iso{$1}/g if $x;
189 0         0 push @res,$x;
190             }
191             # print "\n SSS ",join("sss \n sss ",@res)," SSS \n";
192 0 0       0 $#res ? @res : $res[0] ;
193             }
194              
195             1;
196             package Lingua::PT::Conjugate ;
197              
198             import Lingua::PT::Accent_iso_8859_1 qw(iso2asc asc2iso un_accent);
199 1     1   6 use Exporter ;
  1         6  
  1         1909  
200             @ISA = qw(Exporter);
201             # Yes, this package is a namespace polluter.
202             @EXPORT = qw(conjug env_is_utf8);
203              
204             @EXPORT_OK = qw( cedilla codify end_gu end_oiar end_uir
205             end_zer hard_c hard_g list_verbs locate same_model
206             soft_c soft_g tabcol tabrow verbify verify @tense
207             %tense %alt_tense %long_tense %endg %reg %verb
208             @regverb $vpat $cpat $wpat $vlist $letter );
209              
210             # ##################### THE NAMES OF THE TENSES ##########################
211             # Various alternative ways of specifying tenses
212             # No accentuated characters
213             %alt_tense= ("presente" =>"pres",
214             "perfeito" =>"perf",
215             "imperfeito" =>"imp",
216             "futuro" =>"fut",
217             "mais-que-perfeito"=>"mdp",
218             "mais que perfeito"=>"mdp",
219             "mais" =>{"que"=>{"perfeito"=>"mdp"}},
220             "conjuntivo"=>{"presente"=>"cpres",
221             "imperfeito"=>"cimp",
222             "futuro"=>"cfut",
223             "pres"=>"cpres",
224             "imp"=>"cimp",
225             "fut"=>"cfut"},
226             "conjuntivo presente"=>"cpres",
227             "conjuntivo imperfeito"=>"cimp",
228             "conjuntivo futuro"=>"cfut",
229             "condicional" =>"cond",
230             "imperativo" =>"ivo",
231             "participio"=>{"passado"=>"pp"}, #'
232             "participio passado"=>"pp", #'
233             "gerundivo" =>"grd" ,
234             "pres"=>"pres",
235             "perf"=> "perf",
236             "imp"=>"imp",
237             "fut"=>"fut",
238             "mdp"=>"mdp",
239             "cpres"=>"cpres",
240             "cimp"=>"cimp",
241             "cfut"=>"cfut",
242             "cond"=>"cond",
243             "ivo"=>"ivo",
244             "pp"=>"pp",
245             "grd"=>"grd",
246             );
247              
248             # Full tense names
249             %long_tense= ("pres" =>"presente",
250             "perf" =>"perfeito",
251             "imp" =>"imperfeito",
252             "fut" =>"futuro",
253             "mdp"=>"mais-que-perfeito",
254             "cpres"=>"conjuntivo presente",
255             "cimp"=>"conjuntivo imperfeito",
256             "cfut"=>"conjuntivo futuro",
257             "cond" =>"condicional",
258             "ivo" =>"imperativo",
259             "pp"=>"particípio passado", #'
260             "grd" =>"gerundivo" ,
261             );
262              
263              
264             # WARNING : $tense[9,] eq "ivo" is assumed in verbify() below.
265             # WARNING : $tense[10,11] assumed to be partic'ipiopassado and
266             # gerundivo in verbify() below.
267              
268              
269              
270              
271             # Tenses
272             # # DONT PUT IT IN BEGIN{
273             @tense =qw{ pres perf imp fut mdp cpres cimp cfut cond ivo pp grd };
274             %tense = qw{ pres 1 perf 2 imp 3 fut 4 mdp 5 cpres 6 cimp 7 cfut 8
275             cond 9 ivo 10 pp 11 grd 12 };
276              
277             %empty = ("pres",[],"perf",[],"imp",[],"fut",[],"mdp",[],
278             "cpres",[],"cimp",[],"cfut",[],"cond",[],"ivo",[],
279             "pp",[],"grd",[]);
280              
281             sub strHash
282             {
283 0     0 0 0 my $a = $_[0];
284 0         0 "{ " . join (", ", map {"'".$_."' => '".$a{$_}."'"} sort keys %$a) . " }";
  0         0  
285             }
286              
287             # ####################### VOCALS, CONSONANTS #####################
288             # Vocals and Consonants
289             $vocs = "aeiouáàäâãéèëêíìïîóòöôõúùüû";
290             $plainvoc = "aeiou";
291             $accvoc = "áàäâãéèëêíìïîóòöôõúùüû";
292             # Char => accent
293             $only_acc =
294             {split("",$foo="á\'à\`ä\"â\^ã\~é\'è\`ë\"ê^í\'ì\`ï\"î\^ó\'ò\`ö\"ô\^õ\~ú\'ù\`ü\"û\^")};
295              
296             #print "only_acc = '", join("', '",%$only_acc), "'\n";
297             #print "only_acc = ",strHash($only_acc),"\n";
298             #print "foo='$foo' = >>",join("<>",split("",$foo)),"<<\n";
299             # Char => unaccentuated
300             $no_acc =
301             {split("","áaàaäaâaãaéeèeëeêeíiìiïiîióoòoöoôoõoúuùuüuûu")};
302             $vpat = "[$vocs]";
303             $cons = 'qwrtypsdfghjklzxcvbnm';
304             $cpat = "(?:[$cons]+|ç|gu)";
305             $wpat = "[ç$vocs$cons]";
306             $letter = "ç$vocs$cons";
307              
308             # pres perf imp fut mdp cpres cimp cfut cond ivo pp grd
309             # ############## REGULAR EXPRESSIONS THAT MATCH VERB ENDINGS ############
310             %endg = %{verbify( q"
311             o [aeiín]s [aeim] [eaioí]mos [ae]?[ií]s [ae]m,
312             e?[íis] [aeií]ste [eio][us] [aeií]mos [aeií]stes [aeií]ram,
313             (?:av|i)?a (?:av|i)?as (?:av|i)?a (?:av|áv|í|i)?[aá]mos
314             (?:av|áv|í|i)?[aá]?eis (?:av|i)?am,
315             [aeio]rei [aeio]r[aá]s [aeio]r[aáâ] [aeio]r[ae]mos [aeio]reis
316             [aeio]rão,
317             [aeií]ra [aeií]ras [aeií]ra [aeiâáêéîí]ramos [aeiaeiâáêéîí]reis [aeií]ram,
318             [aeo] [ae]s [ae] [ae]mos [aei]s [ae]m,
319             [aeí]sse [aeí]sses [aeí]sse [aeâáêéí]ssemos [aeiâáêéîí]sseis [aeí]ssem,
320             [aei]r [aeií]res [aei]r [aei]rmos [aei]rdes [aeií]rem,
321             [aeio]ria [aeio]rias [aeio]ria [aeio]r[iíî]amos
322             [aeio]r[aeioâáêéîíóòô]eis [aeio]riam,
323             [aeim] [ae] [ae]mos (?:i|de|í) [ae]m ,
324             (?:[aií]do|to) , [aeio]ndo "
325             )};
326              
327             # print join(",",%endg);
328             # exit;
329              
330             # #################### REGULAR VERBS ENDINGS ####################
331             # pres perf imp fut mdp cpres cimp cfut cond ivo pp grd
332             %reg = (
333             "er" => verbify( q{
334             o es e emos eis em,
335             i este eu emos estes eram,
336             ia ias ia íamos íeis iam,
337             erei erás erá eremos ereis erão,
338             era eras era êramos êreis eram,
339             a as a amos ais am,
340             esse esses esse êssemos êsseis essem,
341             er eres er ermos erdes erem,
342             eria erias eria eríamos eríeis eriam,
343             e a amos ei am ,
344             ido , endo ,
345             }) ,
346            
347             # pres perf imp fut mdp cpres cimp cfut cond ivo pp grd
348             "ar" => verbify( q{
349             o as a amos ais am ,
350             ei aste ou amos astes aram ,
351             ava avas ava ávamos áveis avam ,
352             arei arás ará aremos areis arão,
353             ara aras ara áramos áreis aram ,
354             e es e emos eis em ,
355             asse asses asse ássemos ásseis assem,
356             ar ares ar armos ardes arem,
357             aria arias aria aríamos aríeis ariam,
358             a e emos ai em ,
359             ado , ando ,
360             } ),
361            
362             # pres perf imp fut mdp cpres cimp cfut cond ivo pp grd
363             "ir" => verbify( q{
364             o es e imos is em ,
365             i iste iu imos istes iram ,
366             ia ias ia íamos íeis iam ,
367             irei irás irá iremos ireis irão,
368             ira iras ira íramos íreis iram,
369             a as a amos ais am,
370             isse isses isse íssemos ísseis issem,
371             ir ires ir irmos irdes irem,
372             iria irias iria iríamos iríeis iriam,
373             e a amos i am ,
374             ido , indo ,
375             } ),
376            
377             "or" => verbify(q{
378             onho ões õe omos ondes õem ,
379             us useste ôs usemos usestes useram ,
380             unha unhas unha únhamos únheis unham,
381             orei orás orá oremos oreis orão,
382             usera useras usera uséramos uséreis useram,
383             onha onhas onha onhamos onhais onham,
384             usesse usesses usesse uséssemos uésseis usessem,
385             user useres user usermos userdes userem,
386             oria orias oria oríamos oríeis oriam,
387             õe onha onhamos onde onham
388             pp osto grd ondo
389             }),
390             );
391              
392             # ################# AUXILIARY OR COMMON VERBS ##################
393             # pres perf imp fut mdp cpres cimp cfut cond ivo pp grd
394             %verb = (
395             "ter"=>verbify( q{
396             tenho tens tem temos tendes têm ,
397             tive tiveste teve tivemos tivestes tiveram,
398             tinha tinhas tinha tínhamos tínheis tinham,
399             terei terás terá teremos tereis terão,
400             tivera tiveras tivera tivéramos tivéreis tiveram,
401             tenha tenhas tenha tenhamos tenhais tenham,
402             tivesse tivesses tivesse tivéssemos tivésseis tivessem,
403             tiver tiveres tiver tivermos tiverdes tiverem,
404             cond teria terias teria teríamos teríeis teriam,
405             ivo tem tenha tenhamos tende tenham ,
406             tido tendo
407             } ),
408            
409             "ser"=>verbify( q{
410             sou és é somos sois são,
411             fui foste foi fomos fostes foram,
412             era eras era éramos éreis eram,
413             serei serás será seremos sereis serão ,
414             fora foras fora fôramos fôreis foram ,
415             seja sejas seja sejamos sejais sejam,
416             fosse fosses fosse fôssemos fôsseis fossem,
417             for fores for formos fordes forem,
418             seria serias seria seríamos seríeis seriam,
419             sê seja sejamos sede sejam,
420             sido sendo
421             } ),
422            
423             "estar"=>verbify( q{
424             estou estás está estamos estais estão,
425             estive estiveste esteve estivemos estivestes estiveram,
426             estava estavas estava estávamos estáveis estavam,
427             estarei estarás estará estaremos estareis estarão,
428             estivera estiveras estivera estivéramos estivéreis estiverãm,
429             esteja estejas esteja estejamos estejais estejam,
430             estivesse estivesses estivesse estivéssemos estivésseis estivessem,
431             estiver estiveres estiver estivermos estiverdes estiverem,
432             estaria estarias estaríamos estaríeis estariam,
433             está estéja estejamos estai estejam,
434             estado estando
435             } ),
436            
437             "haver"=>verbify( q{
438             hei hás há havemos haveis hão,
439             houve houveste houve houvemos houvestes houveram,
440             havia havias havia havíamos havíeis haviam,
441             haverei haverás haverá haveremos havereis haverão,
442             houvera houveras houvera houvéramos houvéreis houveram,
443             haja hajas haja hajamos hajais hajam,
444             houvesse houvesses houvesse houvéssemos houvésseis houvessem,
445             houver houveres houver houvermos houverdes houverem,
446             haveria haverias haveria haveríamos haveríeis haveriam,
447             hajas haja hajamos havei hajam, havido havendo
448             } ),
449            
450             # pres perf imp fut mdp cpres cimp cfut cond ivo pp grd
451             "pôr"=>verbify( q{ pôr
452             ponho pões põe pomos pondes põem ,
453             pus puseste pôs pusemos pusestes puseram ,
454             punha punhas punha púnhamos púnheis punham,
455             porei porás porá poremos poreis porão,
456             pusera puseras pusera puséramos puséreis puseram,
457             ponha ponhas ponha ponhamos ponhais ponham,
458             cimp pusesse pusesses pusesse puséssemos pusésseis pusessem,
459             puser puseres puser pusermos puserdes puserem,
460             poria porias poria poríamos poríeis poriam,
461             põe ponha ponhamos ponde ponham
462             pp posto grd pondo
463             }),
464            
465             );
466              
467             # A few regular verbs
468             @regverb = qw{ receitar viver andar partir fintar fracturar guiar
469             habituar garantir iludir imitir infundir inquirir
470             insistir infringir infligir impingir insurgir
471             intermitir irromper };
472              
473             ########################## SOME CODE, at last ########################
474              
475             # Specify that $_[0] is the model of conjugation for @_[1,$#_].
476             # Usage :
477             # same_model('model verb1 verb2 ...')
478             # same_model('model','verb1','verb2'...)
479             # same_model( \%verb_hash, 'model verb1 verb2 ...')
480             # same_model( \%verb_hash, 'model','verb1','verb2',...)
481             sub same_model {
482            
483 0 0   0 0 0 my $verb = ( ref($_[0]) eq "HASH") ? shift : \%verb ;
484 0         0 @_ = map {split /\s+/ } @_ ;
  0         0  
485 0         0 my $m = shift;
486             # print "Same model $m ",join(",",@_),"\n";
487 0         0 foreach (@_) { $verb->{$_}->{model} = $m }
  0         0  
488             }
489              
490             # Convert a single verb entry in "$vlist" format into a %verb hash.
491             sub verbify {
492            
493 13     13 0 24 my ($a,$t,$tc,$p,%res,$x,$y,$root,$edg,@accent);
494 13         25 $t = $tense[$tc=0]; # $tc = current tense, $t = it's name
495 13         16 $p = 0; # $p = current person.
496              
497 13         20 %res = (); # %empty;
498            
499 13         26 $a = $_[0]; # Take in the arg
500            
501 13         141 $a =~ s/,/ , /g; # prepare for split
502 13         80 $a =~ s/^\s+//;
503 13         262 $a =~ s/\s+$//;
504 13         577 @_ = split(/\s+/,$a); # Replace @_
505            
506             # print "verbify >$a<\n";
507            
508             # There may not be a root, see e.g. initial calls to verbify.
509 13 100       139 if( $_[0] =~ /([aeioô]r)$/ ){
510            
511            
512             # Extract Root and Ending
513 4         15 $edg = $1;
514 4         7 $root = shift;
515 4         19 $root =~ s/..$//;
516             # print "verbifying >> $root , $edg <<\n";
517             }
518              
519             # print "Verbifying $_[0]\n";
520 13         35 while($_ = shift) {
521              
522 729 50       1513 warn "Verbify : problem with tc : $tc" if $tc>$#tense ;
523 729 50       1453 warn "Verbify : no tense defined " unless defined $t ;
524            
525 729         2142 s/^\s*//;
526 729 50       1837 warn "Chomp1" if chomp($_); # This code should be removed
527            
528             # The current verb follows a model
529 729 50       1361 if($_ eq "model"){
530 0 0       0 warn "Model not found in verbify" unless $_ = shift ;
531 0         0 s/^\s*//;
532 0 0       0 warn "Chomp2" if chomp($_); # This code should be removed
533            
534 0         0 $res{model} = $_ ;
535 0         0 next;
536             }
537            
538             # Start a new tense
539 729 100 100     8298 if(defined($tense{$_}) || ("$_" eq ",") || $p==6 ){
    100 66        
    100 100        
    50 100        
    50 33        
      33        
      0        
      33        
      33        
540            
541             # All persons passed
542 116 50 66     464 $p6 = (! defined($tense{$_}) && ("$_" ne ","))? 1 : 0;
543            
544 116 100       217 if($p==5){ # If no 2nd person plural was found
545 1         4 $res{$t}->[5] = $res{$t}->[4] ;
546 1         2 $res{$t}->[4] = undef ; # MODIF 082899
547             }
548             # Ready for next tense
549 116         122 $p = 0;
550 116 100       241 if(defined($tense{$t=$_})){ # Advance $tc to the specified tense
551 10         144 for( $tc=0 ; "$tense[$tc]" ne "$t" ; $tc++ ){};
552             # print "Tense $t\n";
553            
554             } else { # .. or just increment $tc
555 106         101 $tc++;
556 106         146 $t = $tense[$tc] ;
557             }
558 116 50       386 next unless $p6;
559            
560             # HERE CAREFUL if @tense changes . This is "grd"
561             } elsif( ($tc==10) && ($p==1) ){
562            
563 4         14 $p = 0;
564 4         3 $tc++ ;
565 4         7 $t = $tense[$tc];
566            
567             } elsif( ($tc==9) && ($p==0) ){
568            
569             # Safer, but slower
570             # if( ($tense{$tc} eq "ivo" ) && ($p==0) );
571            
572 10         12 $p++ ;
573            
574             # Build default, if possible
575             } elsif( $_ eq "etc" && $edg && $p && ($x=$res{$t}->[$p-1]) ){
576            
577             # If last input matches a regular model, adopt that model
578 0         0 $edg2 = $edg;
579 0         0 my $e;
580 0 0       0 if( $x !~ / $reg{$edg}->{$t}->[$p-1] $/x ) {
581 0         0 foreach $e ("ir","ar","er") {
582 0 0       0 if( $x =~ / $reg{$e}->{$t}->[$p-1] $/x ){
583 0         0 $edg2=$e; last;
  0         0  
584             }
585             }
586             }
587 0         0 $x =~ s/ $reg{$edg2}->{$t}->[$p-1] $//x;
588 0         0 $x =~ s/ [e]+ $//x;
589            
590 0         0 while( $p < 6 ){
591 0 0 0     0 $res{$t}->[$p] = $x . $reg{$edg2}->{$t}->[$p] unless
      0        
592             $p==3 && $reg{$edg2}->{$t}->[$p] =~ /^i/ &&
593             $x =~ /i([$cons]{1,2}|ç|gu)$/o ;
594             # print "$t , $p , $res{$t}->[$p] <<\n";
595 0         0 $p++;
596             }
597            
598 0         0 $p = 5 ;
599 0         0 $_ = ".";
600             } elsif( $_ eq "acc" && $root && $edg ){
601 0         0 push @accent, $t;
602 0         0 next;
603             }
604            
605 613 50       1423 warn "Verbify problem root=$root, $_, $t, $tc "
606             unless defined($tense{$t}) ;
607            
608             # $res{$t}->[$p] = $_ if defined($_) and "$_" ne ".";
609 613 50       1892 $res{$t}->[$p] = $_ if "$_" ne ".";
610 613         1287 $p++;
611             }
612 13 50       29 if($p==5){
613             # if( $t ne "ivo" )
614             # {
615 0         0 $res{$t}->[5] = $res{$t}->[4] ;
616 0         0 $res{$t}->[4] = undef ; # MODIF 082899
617             # } else
618             # {
619             # chop( $res{$t}->[4] = $root ) ;
620             # ( $res{$t}->[4] .= "i" ) =~ s/ii$/i/ ;
621             # }
622             }
623            
624 13         24 foreach $t (@accent){
625             # $|=1;
626             # !!! HERE : Would be great not to do call conjug
627 0         0 $res{$t}->[3] = conjug({"$root$edg"=>\%res},"s","$root$edg",$t,4);
628             # Before iso-accentuating all
629             # $res{$t}->[3] =~ tr/\'\^/\^\'/ ;
630 1     1   5 $res{$t}->[3] =~ tr/áéíâêî/âêîáéí/ ;
  1         2  
  1         13  
  0         0  
631             }
632 13         86 \%res;
633            
634             } # End verbify
635              
636             # Read a string in the format of $vlist, and put the equivalent data
637             # in a %verb hash.
638             sub codify {
639            
640 0     0 0 0 my ($r,$v,$c,$f,$tmp,@s) = ("","","") ;
641            
642 0 0       0 my $verb = ( ref($_[0]) eq "HASH") ? shift : \%verb ;
643            
644 0         0 $_ = join("",@_);
645            
646 0         0 s/\#.*$//m;
647 0         0 s/^\s+//m;
648 0         0 s/\s+$//m;
649            
650             # @s = split(/(\w+)[\s\n]*([:=])/,$_ );
651             # @s = split(/([\w\\\"\^\'\~]+)[\s\n]*([:=])/,$_ ); #'"
652             # @s = split(/($wpat+)[\s\n]*([:=])/,$_ ); #'
653             # @s = grep {/\S/} split(/([^=:])[\s\n]*([=:])[\s\n]*/,$_ ); #'
654 0         0 @s = split(/[\s\n]*([=:])[\s\n]*([^=:]+)[\s\n]+([^=:]+)/,$_ ); #'
655 0         0 @s = grep {/\S/} @s;
  0         0  
656             # print " $#s \n";
657 0         0 $s[$#s-1] .= pop @s;
658            
659            
660 0         0 $v=shift @s;
661 0 0       0 $v = shift @s unless $v;
662 0   0     0 while( ($c=shift @s) && ($c!~/[:=]/) ){ # Skip if needed
663 0         0 warn " codify first finds : >$v<, then >$c< \n";
664 0         0 $v=$c;
665             }
666            
667 0         0 $r= shift @s;
668            
669            
670 0   0     0 while ( $c && $c=~/[:=]/ && $v && $r ){
      0        
      0        
671             # print "codify loop : >$v< >$c< >$r< \n";
672            
673 0 0       0 if($r=~/[:=]/){warn "codify finds \$r = >$r< \n"}
  0         0  
674 0 0       0 if($c eq ":"){
    0          
675            
676 0         0 $tmp = verbify( "$v $r " );
677 0         0 @{$verb->{$v}}{keys(%$tmp)} = values(%$tmp);
  0         0  
678            
679             } elsif( $v =~ /defectivos([1234])?/){
680 0         0 my $dnum = $1 ;
681             # print "found defective -- $v,$dnum,$r --\n";
682 0         0 foreach (split(/\s+/,$r)){
683 0         0 s/[\n\s]+//g;
684 0 0       0 next unless $_;
685             # print "found defective >>$v,$dnum,$_<<\n" if /abolir/ || /demolir/ ;
686             # $verb->{"defectivos". ($dnum eq "3" ? "": "$dnum")}->{"$v"}= $dnum ;
687             # print " Def $v,$dnum,defectivos",($dnum eq "3") ? "": "$dnum","\n";
688             # $verb->{defectivos}->{"$v"} = ($dnum eq "3") ? "$v" : $dnum;
689 0 0       0 $verb->{"defectivos". ($dnum eq "3" ? "": "$dnum")}->{"$_"}= $dnum ;
690             # print " Def $v,$dnum,defectivos",($dnum eq "3") ? "": "$dnum","\n";
691 0 0       0 $verb->{defectivos}->{"$v"} = ($dnum eq "3") ? "$_" : $dnum;
692 0 0       0 $verb->{defectivos}->{"$_"} = ($dnum eq "3") ? "$_" : $dnum;
693 0         0 my $tmpmodel = $verb->{$v}->{model} ;
694 0         0 delete($verb->{$v}) ;
695 0         0 $verb->{$v} = conjug($v) ;
696 0 0       0 $verb->{$v}->{model} = $tmpmodel if defined($tmpmodel) ;
697             # print "defective :: ",join(",",keys(%{$verb->{defectivos}})),"\n" if /abolir/ || /demolir/ ;
698             }
699            
700             } else {
701             # print "same_model : $v, $r\n" if $v =~ /abolir/ || $r =~ /demolir/ ;
702 0         0 same_model($verb, "$v $r " ) ;
703             }
704 0         0 $v=shift @s; $c=shift @s;
  0         0  
705 0         0 $r= shift @s;
706             }
707 0 0       0 if(@s){
708 0         0 warn "codify leaves out $#s elements, of which >$v< >$c< >$r< \n";
709             }
710              
711             } # End codify
712              
713             # ### Make a list of knows verb names in the global variable \%verb.
714             sub list_verbs {
715            
716 0     0 0 0 my ($r,$v,$c,$f,$tmp,@s) = ("","","") ;
717            
718 0         0 my $verb = \%verb ;
719 0         0 my @res;
720            
721 0         0 $_ = $vlist;
722            
723 0         0 s/\#.*$//m;
724 0         0 s/^\s+//m;
725 0         0 s/\s+$//m;
726            
727             # @s = split(/(\w+)[\s\n]*([:=])/,$_ );
728             # @s = split(/([\w\\\"\^\'\~]+)[\s\n]*([:=])/,$_ );"
729 0         0 @s = split(/([$wpat]+)[\s\n]*([:=])/o,$_ ); #
730 0         0 $v=shift @s;
731 0   0     0 while( ($c=shift @s) && ($c!~/[:=]/) ){$v=$c;}
  0         0  
732            
733 0         0 $r= shift @s;
734            
735 0   0     0 while ( $c && $c=~/[:=]/ && $v && $r ){
      0        
      0        
736            
737 0 0       0 if($c eq ":"){
    0          
738 0         0 push(@res,$v);
739             } elsif( $v =~ /defectivos([1234])?/){
740 0         0 foreach (split(/\s+/,$r)){
741 0         0 s/[\n\s]+//g;
742 0 0       0 next unless $_;
743             # print "found defective >>$v,$1,$_<<\n";
744             # $verb->{"defectivos". ($1 eq "3" ? "": "$1")}->{"$v"}= $1 ;
745             # print " Def $v,$1,defectivos",($1 eq "3") ? "": "$1","\n";
746             # $verb->{defectivos}->{"$v"} = ($1 eq "3") ? "$v" : $1;
747 0         0 push(@res,$v);
748             }
749            
750             } else {
751 0         0 push @res,split(/\s+/,$r);
752             }
753 0         0 $v=shift @s; $c=shift @s;
  0         0  
754 0         0 $r= shift @s;
755             }
756 0         0 @res;
757             }
758              
759              
760             # verify( reference_string, [%verb] )
761             # Compares the reference string with the output of conjug.
762             sub verify {
763 0     0 0 0 my ($errcnt,$r,$v,$c,$e,$f,$d,$d2,@s,@t,@u) =
764             (0, "","","","","","","") ;
765 0         0 @s=@t=@u=();
766            
767             # $w will contain the complaints
768 0         0 my ($res,$w,@ckd) = ("","");
769            
770             # print "Verify $#_ , \n", join(", ", @_ ),"\n";
771 0         0 $_ = shift ;
772             # Verb hash
773 0 0       0 my $verb = ( ref($_[0]) eq "HASH") ? shift : \%verb ;
774            
775 0         0 s/\#.*$//m;
776 0         0 s/^\s+//m;
777 0         0 s/\s+$//m;
778            
779             # print "Ver1 >$verb< ",($verb==\%verb)?"(\%verb)":"","\n";
780             # @s = split(/(\w+)[\s\n]*([:=])/,$_ );
781             # @s = split(/([\w\\]+)[\s\n]*([:=])/,$_ );
782            
783             # Split into verb, separator, definition
784 0         0 @s = split(/($wpat+)[\s\n]*([:=])/o,$_ );
785            
786             # print "Ver2 ",join(", ",@s);
787            
788             # Find first verb
789 0         0 $v=shift @s;
790 0   0     0 while( @s && ($c=shift @s) && ($c!~/[:=]/) ){$v=$c}
  0   0     0  
791            
792             # @u = reference of conjugation : One element = one tense
793 0         0 @u= split("\n",shift @s);
794 0         0 shift(@u) ; # First elt is empty
795            
796            
797 0   0     0 while ( $c && $c=~/[:=]/ && $v && @u ){
      0        
      0        
798            
799            
800 0 0       0 if($c eq ":"){
801             # !!! HERE : Would be great not to do call conjug
802 0         0 @t = split("\n",conjug( $verb,"x" , $v ));
803 0         0 shift @t;
804            
805 0   0     0 while ( defined($e=shift @u) && defined($d=shift @t) ){
806              
807             # Remove extra spaces
808 0         0 $e =~ s/\s+/ /g; $e =~ s/^\s+//; $e =~ s/\s+$//;
  0         0  
  0         0  
809 0         0 $d =~ s/\s+/ /g; $d =~ s/^\s+//; $d =~ s/\s+$//;
  0         0  
  0         0  
810 0         0 chomp $e; chomp $d ;
  0         0  
811 0         0 $d2 = $d;
812 0         0 $d2 =~ s/\\/\\\\/g;
813 0         0 $d2 =~ s/([^\\])([\'\"\^\~])/$1\\$2/g; #'"
814             # $d2 =~ s/([^\\])([\'\"\^\~])/$1\\$2/g;#'"
815 0 0       0 $w .= join("", tabcol(-2,[
816             sprintf(" %3d ",++$errcnt),
817             split(/\s+/,$d),
818             " REF ", split(/\s+/,$e)] ) )
819             if ($e !~ /$d2/);
820             # print ">$e<\n>$d2<\n" if ($e !~ /$d2/);a
821             }
822 0 0       0 if($#u>=0){
823 0         0 $w .= " ABS ".join("\n ABS ",@u)."\n"
824             }
825 0 0       0 if($#t>=0){
826 0         0 $w .= " EXC ".join("\n EXC ",@t)."\n"
827             }
828 0 0       0 if( $w ) {
829 0 0       0 $res .= "IN $v ".
830             ( defined($verb->{$v}->{model}) ?
831             "model $verb->{$v}->{model}" : "" )
832             ."\n$w\n" ;
833             } else {
834 0         0 push @ckd, $v;
835             }
836             }
837            
838 0 0       0 ( $v, $c, @u ) = (@s) ?
839             ( shift @s, shift @s, split("\n",shift @s)):
840             ("","",()) ;
841 0         0 shift(@u) ;
842            
843 0         0 $w="";
844 0         0 $errcnt = 0;
845             }
846             # print " $v, $c, $#u, $#s \n";
847 0         0 $w = join(" ",sort(@ckd));
848 0         0 $w =~ s/(.{80}\S+)/$1\nOK /g;
849 0 0       0 $res .= "OK $w\n" if "$w";
850 0         0 $res ;
851             } # End verify
852              
853              
854             ############## SUBS FOR MODIFYINGS THE TERMINATIONS ###########
855             # Each sub applies a simple spelling rule.
856              
857             ################# HERE : Take out all these
858             #################### needless arguments.
859             sub soft_g {
860 0     0 0 0 my ( $w , $root, $edg , $p , $t ) = @_ ;
861            
862 0 0       0 $w=~ s/g([^g]+)$/j$1/ if( $w =~ /g[aou][^g]*$/);
863 0         0 $w ;
864             }
865              
866             sub soft_c {
867 0     0 0 0 my ( $w , $root, $edg , $p , $t ) = @_ ;
868            
869 0 0       0 $w=~ s/c([^c]+)$/ç$1/ if( $w =~ /c[aou][^c]*$/);
870 0         0 $w ;
871             }
872              
873             sub hard_g {
874 14     14 0 153 my ( $w , $root, $edg , $p , $t ) = @_ ;
875            
876 14 50       76 $w =~ s/g([^g]+)$/gu$1/ if($w =~ /g[ei][^g]*$/);
877 14         37 $w;
878             }
879              
880             sub hard_c {
881 0     0 0 0 my ( $w , $root, $edg , $p , $t ) = @_ ;
882            
883 0 0       0 $w =~ s/c([^c]+)$/qu$1/ if($w =~ /c[ei][^c]*$/);
884 0         0 $w;
885             }
886              
887             sub cedilla {
888 0     0 0 0 my ( $w , $root, $edg , $p , $t ) = @_ ;
889            
890 0         0 $w =~ s/ç[e]([^ç]*)$/ce$1/;
891 0         0 $w;
892             }
893              
894             sub end_gu {
895 0     0 0 0 my ( $w , $root, $edg , $p , $t ) = @_ ;
896            
897 0 0       0 $w =~ s/gu([^g]+)$/g$1/ if $w =~ /gu[aou][^g]*$/;
898 0         0 $w;
899             }
900              
901             #sub end_oiar {
902             # my ( $w , $root, $edg , $p , $t ) = @_ ;
903             #
904             # $w =~ s/oó/ó/ ;
905             # $w;
906             #}
907              
908             sub end_zer {
909 0     0 0 0 my ( $w , $root, $edg , $p , $t ) = @_ ;
910            
911 0 0 0     0 $w =~ s/z.$/z/ if
      0        
      0        
912             $p==3 && $t eq "pres" || $p == 2 && $t eq "ivo" ;
913            
914 0         0 $w;
915             }
916              
917             sub end_uir {
918 0     0 0 0 my ( $w , $root, $edg , $p , $t ) = @_ ;
919            
920 0 0 0     0 $w =~ s/[$vocs]([$cons]?)$/i$1/o if
      0        
      0        
      0        
921             $t eq "pres" && ($p==2||$p==3) ||$t eq "ivo" && $p == 2 ;
922            
923             # Here ??Needed??
924 0 0 0     0 $w =~ s/$root i/ $root. "í"/ex if
  0   0     0  
      0        
      0        
      0        
925             $t eq "imp" || $t eq "mdp" || $t eq "perf" && $p!=3 ||
926             $t eq "pres" && $p==4 ;
927            
928 0         0 $w;
929             }
930             # Test for defectiveness
931             sub is_defectivo
932             {
933 24     24 0 42 my ( $verb, $v, $t, $p ) = @_ ;
934 24 50       107 return 0 unless exists( $verb->{defectivos}->{$v} ) ;
935             # Check that verb looks like a verb
936 0 0       0 unless( $v =~ /^(.*)([aeioô]r)$/ ){
937 0         0 warn "$v does not look like a verb." ;
938 0         0 next;
939             }
940             # Extract Root and Ending
941 0         0 $edg = $2;
942 0         0 $root = $1;
943              
944 0 0 0     0 return 1 if ( $verb->{defectivos}->{$v} =~ /[12]/ &&
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
945             defined( $reg{$edg}->{$t}->[$p-1] ) &&
946             !( $reg{$edg}->{$t}->[$p-1] =~
947             /["^$vocs"]*["$vocs"]["^$vocs"]*["$vocs"]/o ||
948             $reg{$edg}->{$t}->[$p-1] =~
949             /["^$vocs"]*(["$vocs"])/o &&
950             ($1 eq "i" || $1 eq "í" ||
951             "$verb->{defectivos}->{$v}" eq "2" && $1 eq "e")
952             )
953             || "$verb->{defectivos}->{$v}" eq "4" && $p!=3 && $p!=6
954             || ("precaver" eq $verb->{defectivos}->{$v}) &&
955             ( $t eq "pres" && $p!=4 || $t =~ /(cpres|ivo)/ )
956             || ("adequar" eq $verb->{defectivos}->{$v}) &&
957             ( $t =~ /c?pres/ && $p!=4 || $t eq "ivo" )
958             ) ;
959 0         0 return 0 ;
960             }
961              
962             # #################### THE MAIN FUNCTION IN THIS FILE ####################
963             #
964             # conjug [[qvx] [verb]+ [tense]+ [1-6]+]+
965             #
966              
967             sub conjug {
968            
969 11     11 0 227462 my($v,$w,@v,@t,@p);
970            
971 11         46 my ($verbose,$rc,$regexp,$isoacc,$sep,$long) = (1,"c",0,1," ",0);
972            
973             # print "Received : >",join("< >",@_),"<\n";
974             # print "HASH FOUND \n" if ( ref($_[0]) eq "HASH");
975 11 50       230 my $verb = ( ref($_[0]) eq "HASH") ? shift : \%verb ;
976            
977             # Extract options verb, tense and person.
978             # while( ($v=shift) && ($v=~ /^\-? [hvqlrcsxio]+ $/x ) ){
979 11   66     165 while( @_ && (($v = shift) =~ /^\-? [hvqlrcsxio]+ $/x ) ){
980             # print "option $v\n";
981 10 50       33 if( $v=~/[iaeoô]r$/ ){ # That looks like a verb
982             # unshift @_,$v;
983             # print "NOT OPT\n";
984 0         0 last ;
985             }
986 10         44 foreach ( $v =~ /./g )
987             {
988             # print "--> $_\n";
989 18 100       184 if ( /q/ ) {$verbose = 0 } # Quiet
  2 100       10  
  3 50       17  
    50          
    100          
    100          
    100          
    50          
    50          
    0          
990             elsif( /v/ ) {$verbose = 1 } # Verbose
991 0         0 elsif( /r/ ) { $rc = "r" } # Rows
992 0         0 elsif( /c/ ) { $rc = "c" } # Columns
993             # return a Single line
994 5         56 elsif( /s/ ) { $rc = "s"; $verbose = 0; }
  5         20  
995 3         17 elsif( /h/ ) { $rc = "h"; } # return a Hash
996 4         28 elsif( /l/ ) { $long = 1 } # Long form of verbs names
997 0         0 elsif( /o/ ) { $sep = ", " } # output is comma-separated
998             # Return a regexp that matches a correct verbal form
999 1         10 elsif( /x/ ) { $regexp = 1 }
1000 0         0 elsif( /i/ ) { $isoacc = 0; } # Use only ascii chars
1001             }
1002             }
1003            
1004 11   66     69 while( $v && !defined($alt_tense{$w = lc(un_accent($v)) }) && ($v!~/[\d]/)){
      66        
1005             # print "found verb $v\n";
1006 11         27 push @v,$v;
1007 11         50 $v=shift;
1008             }
1009 11         23 my $cur_verb = \%alt_tense;
1010 11         21 @t = ();
1011            
1012 11 50       40 $w = lc(un_accent($v)) if $v;
1013             # print "$w\n";
1014 11   100     60 while( $w && defined($cur_verb->{$w}) ){
1015 20 50       50 if(ref($cur_verb->{$w}) eq "HASH" ){
1016 0         0 $cur_verb = $cur_verb->{$w};
1017             } else {
1018 20         43 push @t, $cur_verb->{$w};
1019 20         34 $cur_verb = \%alt_tense;
1020             }
1021 20 100       78 $w = ($v = shift) ?
1022             lc(un_accent($v)) :
1023             "" ;
1024             # print "$w\n";
1025             }
1026 11 50       232 @t = @tense unless @t ;
1027            
1028             # if($v && defined($tense{$v})){
1029             # @t = ($v);
1030             # while(($v=shift) && defined($tense{$v})){ push @t,$v};
1031             #
1032             # } else {
1033             # @t = @tense;
1034             # }
1035            
1036 11 100 66     81 if( defined($v) && $v=~/^ [1-6] $/x ){
1037 8         19 @p = ($v);
1038 8   66     57 while(($v=shift) && $v=~ /^[1-6] $/x){ push @p,$v};
  15         70  
1039             } else {
1040             # @p = (1..4,6) unless @p ;
1041             }
1042 11 100       43 @p = (1..6) unless @p ;
1043             # print "VERB ",join(",",@v);
1044             # print "\nTENSE ",join(",",@t);
1045             # print "\nPERS ",join(",",@p),"\n";
1046             # CONJUGATION
1047            
1048 11         17 my (@res,%res); # Result (as array and hash),tmp.
1049 0         0 my ($root,$rr,$vr,$cr,$edg); # Root, $root = "$rr$vr$cr$edg";
1050 0         0 my ($m, $rm,$vm,$cm); # Model $m = "$rm$vm$cm$edg";
1051 0         0 my ($prefix, $missing);
1052 0         0 my ($y,$cy,$vy,$ey); # Found conjugated form,
1053 0         0 my ($ex,$z,$s); # EXplicitely defined? temps.
1054              
1055 11         17 @res = () ; %res = () ;
  11         19  
1056            
1057 11 50       18 map {$_=asc2iso($_) if /[\"\'\^\\\~]/} @v ; #
  11         48  
1058             # print "CONJUG \n>",join(",",@v),"<\n>",
1059             # join(",",@t),"<\n>",join(",",@p),"<\n"; #'"
1060 11         24 foreach $v (@v) {
1061            
1062             # print " D1 " if $verb->{defectivos}->{$v};
1063             # print " D ";
1064 11         30 locate($verb,$v);
1065            
1066             # print " D2 " if $verb->{defectivos}->{$v};
1067            
1068             # Check that verb looks like a verb
1069 11 50       68 unless( $v =~ /^(.*)([aeioô]r)$/ ){
1070 0         0 warn "$v does not look like a verb." ;
1071 0         0 next;
1072             }
1073             # Extract Root and Ending
1074 11         140 $edg = $2;
1075 11         20 $root = $1;
1076            
1077             # Is there a recognizable model ?
1078 11 50 33     159 if ( $v =~ /g[ei]r$/ ) { $modif = \&soft_g }
  0 50       0  
    100          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
1079 0         0 elsif( $v =~ /c[ei]r$/ ) { $modif = \&soft_c }
1080 6         19 elsif( $v =~ /g[ao]r$/ ) { $modif = \&hard_g }
1081 0         0 elsif( $v =~ /çar$/ ) { $modif = \¸la }
1082 0         0 elsif( $v =~ /c[ao]r$/ ) { $modif = \&hard_c }
1083 0         0 elsif( $v =~/gu[ei]r$/ ) { $modif = \&end_gu }
1084 0         0 elsif( $v =~ /[^g]uir$/) { $modif = \&end_uir }
1085 0 0       0 elsif( $v =~ /air$/) { $verb->{$v}->{model} = "sair"
1086             unless $v eq "sair" }
1087 0 0       0 elsif( $v =~ /oer$/) { $verb->{$v}->{model} = "moer"
1088             unless $v eq "moer" }
1089 0 0       0 elsif( $v =~ /oar$/) { $verb->{$v}->{model} = "perdoar"
1090             unless $v eq "perdoar" }
1091             elsif( $v =~ /oiar$/ && $v ne "boiar" ) {
1092 0         0 $verb->{$v}->{model} = "boiar" ;
1093             # $modif = \&end_oiar ;
1094             }
1095 0         0 elsif( $v =~ /(uzir|zer)$/ ){ $modif = \&end_zer }
1096 0 0       0 elsif( $v =~/ear$/ ) { $verb->{$v}->{model} = "passear"
1097             unless $v eq "passear" }
1098 5         12 else { $modif = 0 }
1099            
1100             # if($v =~/or$/){ # verbs in "or"
1101             # $verb->{$v}->{model} = "pôr" unless defined($verb->{$v});
1102             # }
1103            
1104 11 100       38 if($verbose)
1105             {
1106            
1107 9 50       82 push @res, "$v : ", defined($verb->{defectivos}->{$v}) ?
    100          
    50          
1108             ("defectivo","") :
1109             defined($verb->{$v}) ?
1110             defined($verb->{$v}->{model}) ?
1111             ("model",$verb->{$v}->{model}) :
1112             ("irreg","") : ("",""),
1113             ("","","","") ; # Assume @p == 5 !!!
1114             # Avoid putting too many columns/rows
1115 9 50       27 if( @p != @res )
1116             {
1117 9         34 push @res , join(" ", splice(@res,@p) ) ;
1118 9         42 $res[$#res] =~ s/\s+$//;
1119             }
1120            
1121             }
1122            
1123 11 100       35 if( defined($verb->{$v}) ) { # Irregular Verb
1124            
1125 8 50 50     223 warn " Root $v -> $root ,$cpat,of unexpected kind" unless
      33        
      66        
1126             (($rr,$vr,$cr) =
1127             ($root =~ /^ (.*) ($vpat+) ($cpat* \^?) $/ox ))
1128             || $root=~/^ $cpat* \^? $/ox && ($rr = $root || 1) ;
1129              
1130             # The \^? serves only for p^or
1131             # print "Root $root yields ($rr,$vr,$cr,$edg)\n";
1132            
1133             # Is there a model ?
1134 8 50       35 if(defined($m = $verb->{$v}->{model})){
1135 0 0       0 locate($verb,$m) unless defined($verb->{$m});
1136 0         0 ($rm = $m) =~ s/..$//;
1137             # print "Model : $rm, $m \n";
1138 0         0 ($vm,$cm) = ($rm =~ / ([$vocs]+) ($cpat{0,2}) $/ox );
1139            
1140             # print " Model $model yields ($rr,$vr,$cr,$edg) \n";
1141             # print " Prefix is $prefix\n" if
1142 0         0 $missing = 0;
1143 0 0       0 unless(($prefix) = ($v=~/(.*)$m$/)){
1144 0         0 my $em = substr($rm,1);
1145 0 0 0     0 unless((length($em)>1) &&
      0        
1146             (($prefix) = ($v=~/(.*)$em$/)) && ($missing=1)) {
1147 0         0 $em= substr($em,1);
1148 0 0 0     0 length($em)>1 &&
1149             (($prefix) = ($v=~/(.*)$em$/)) && ($missing=2);
1150             }
1151             # print " em $em ";
1152             }
1153             # print "Prefix $m, $v, $prefix, $missing\n";
1154            
1155             }
1156            
1157            
1158 8         21 foreach $t (@t) # Loop over tenses
1159             {
1160 14 50       47 next unless defined($reg{er}->{$t});
1161            
1162 14 100       51 push @res, $long ? $long_tense{$t} : $t if $verbose ;
    100          
1163            
1164 14         22 foreach $p (@p) # Loop over persons
1165             {
1166             # Is it explicitly defined ?
1167 49 100       160 $ex = ($w = $verb->{$v}->{$t}->[$p-1])?1:0 ;
1168            
1169 49 50 66     177 if(!$w && $m && ($y = $verb->{$m}->{$t}->[$p-1]) )
      33        
1170             {
1171             # pass from explicit model to conjd. form.
1172 0 0       0 if($prefix){
1173 0         0 $y = substr($y,$missing); # SUSPICIOUS
1174 0         0 $w= "$prefix$y";
1175             } else {
1176 0 0       0 warn " $y ,$t,$p,$endg{$t}->[$p-1] of unexpected kind"
1177             unless
1178             ($vy,$cy,$ey) =
1179             $y=~/ ($vpat+) ($cpat?) ($endg{$t}->[$p-1]) $/x;
1180            
1181             # print "cm,cy = $cm,$vy,$cy,$ey\n";
1182 0 0       0 $w = ($cm eq $cy) ?
1183             "$rr$vy$cr$ey" : "$rr$vy$cy$ey" ;
1184            
1185             }
1186             }
1187            
1188 49 0 66     304 if( (!$w) && ("$t" eq "cpres") &&
      0        
      33        
1189             (($y=$verb->{$v}->{cpres}->[0]) ||
1190             ($m && ($y=$verb->{$m}->{cpres}->[0]))) ){
1191            
1192             # print "Root $root , $rr , $vr , $cr , $edg \n";
1193 0         0 $vy=$cy=$ey="";
1194 0 0       0 warn "Cpres bug $y ($vy,$cy,$ey)" unless
1195             ($vy,$cy,$ey) = $y =~
1196             / ($vpat+) ($cpat?) ($endg{cpres}->[0]) $/x;
1197             # print "Cpres rule $y ($vy,$cy,$ey) <$endg{cpres}->[0]> \n";
1198 0 0 0     0 $y = (!defined($cr) || defined($cy) && ($cr eq $cy)) ? "$rr$vy$cy" : "$rr$vy$cr" ;
1199             # $|=1;
1200             # print "cr=$cr, " ;
1201             # print "cy=$cy, " ;
1202             # print "rr=$rr, " ;
1203             # print "vy=$vy\n" ;
1204              
1205 0         0 $w = "$y$reg{$edg}->{cpres}->[$p-1]";
1206             }
1207            
1208             # Default Conjuntivo passado/futuro for irregular
1209             # verbs is built from 1st person perfeito
1210 49 50 33     1589 if( (!$w) && ("$t" eq "cimp" || "$t" eq "cfut") &&
    50 66        
    50 0        
      33        
      66        
      33        
      33        
      0        
      0        
      66        
      33        
      33        
1211             (($y=$verb->{$v}->{perf}->[0]) ||
1212             ($m && ($verb->{$m}->{perf}->[0]))) ){
1213            
1214 0 0       0 if(!$y) {
1215 0         0 $y = $verb->{$m}->{perf}->[0];
1216 0 0       0 if($prefix){
1217 0         0 $y = substr($y,$missing); # SUSPICIOUS
1218 0         0 $y="$prefix$y";
1219             } else {
1220 0         0 $vy=$cy=$ey="";
1221 0 0       0 warn "Cpassad bug $y ($vy,$cy,$ey)" unless
1222             ($vy,$cy,$ey) = $y =~
1223             / ($vpat+) ($cpat?)($endg{perf}->[0]) $/x;
1224            
1225 0 0       0 $y= ($cr eq $cy) ? "$rr$vy$cr" : "$rr$vy$cy" ;
1226             }
1227             }
1228 0         0 $z = $reg{$edg}->{$t}->[$p-1];
1229            
1230             # ?? if($y=~s/([\'\^\"]?[$vocs])$//){#"
1231 0 0       0 if($y=~s/([$vocs])$//ox){
1232 0         0 $z = $1.$z;
1233 0         0 $z = iso2asc($z); # Swap accents
1234 0 0       0 $z =~ s/^([\'\^\"])([$vocs])([\'\^\"]?)([$vocs])/$1$2/ox
1235             || $z =~ s/^([$vocs])([\'\^\"]?)([$vocs])/$2$1/ox; #"
1236 0         0 $z = asc2iso($z);
1237             }
1238 0         0 $y .= $z;
1239            
1240             # $w = "$y";
1241              
1242 0         0 $w = $y;
1243              
1244             # Default imperativo is built from conjuntivo
1245             } elsif (!$w && "$t" eq "ivo" && $p!=1 && $p != 5 &&
1246             (($y=$verb->{$v}->{cpres}->[$p-1]) ||
1247             ($m && $verb->{$m}->{cpres}->[$p-1] ))
1248             ){
1249             # print "I'm here III $p,$y \n";
1250 0 0       0 if(!$y) {
1251 0 0       0 if($prefix){
1252             # print "I'm here II\n";
1253 0         0 $y="$verb->{$m}->{cpres}->[$p-1]";
1254 0         0 $y = $prefix . substr($y,$missing); # SUSPICIOUS
1255             } else {
1256 0         0 $y = $verb->{$m}->{cpres}->[$p-1];
1257 0         0 $vy=$cy=$ey="";
1258 0 0       0 if( $p != 5 )
1259             {
1260 0 0       0 warn "Ivo bug $y , $p, ($vy,$cy,$ey) $vocs / $cpat / $endg{cpres}->[$p-1]" unless
1261             ($vy,$cy,$ey) = $y =~
1262             / ([$vocs]) ($cpat?) ($endg{cpres}->[$p-1]) $/x;
1263             # print "-$endg{cpres}->[$p-1]-$y-$1-$2-$3\n";
1264             } else {
1265             # print "I'm here\n" ;
1266 0         0 $ey = "i";
1267 0 0       0 warn "Ivo bug $y , $p, ($vy,$cy,$ey) (BIS)" unless
1268             ($vy,$cy) = $y =~
1269             / ([$vocs]) ($cpat) /x;
1270             }
1271 0         0 $y= "$rr$vy$cr$ey";
1272             }
1273             }
1274 0         0 $w = "$y";
1275            
1276             } elsif(!$w && "$t" eq "ivo" && $p!=1 && $p == 5 )
1277             {
1278 0         0 chop( $w = $v );
1279 0         0 ($w .= "i") =~ s/ii/i/;
1280            
1281             }
1282            
1283 49 100 100     229 $w = "$root$reg{$edg}->{$t}->[$p-1]" if
1284             !$w && defined($reg{$edg}->{$t}->[$p-1]) ;
1285            
1286 49 100 100     216 $w = &$modif( $w ,$root, $edg ,$p ,$t )
      66        
1287             if( $w && !$ex && $modif );
1288            
1289 49 100 100     194 unless( $regexp || !defined($w)){
1290 28         50 $w =~ s/ \[ ([^\]]) [^\]]* \] /$1/gx;
1291 28         69 $w =~ s/ \( ([^\|\)]*) \|? .* \) /$1/gx;
1292             }
1293            
1294 49 50       123 if( $verb->{defectivos}->{$v} ){
1295             # Is this code ever used ?
1296             # Answer : YES (082899)
1297             # print "Defectivo\n";
1298             # my $tmp = $reg{$edg}->{$t}->[$p-1] ;
1299             # $|=1;print STDERR ">> $edg, $t, $p, $tmp <<\n" ;
1300             # $tmp = $t ;
1301             # $tmp = $v ;
1302             # $tmp = $p ;
1303            
1304 0 0       0 $w = " " if is_defectivo($verb, $v, $t, $p ) ;
1305             }
1306            
1307 49 100       105 $w=~s/^x$/ / if $w ;
1308            
1309 49         94 push @res, $w ;
1310 49         182 $res{$t}->[$p] = $w;
1311             } # End loop over persons
1312             } # End loop over tenses
1313             # ####################################
1314             } else { # Regular Verb
1315            
1316 3         9 foreach $t (@t){
1317            
1318 6 50       22 next unless defined($reg{er}->{$t});
1319            
1320 6 100       25 push @res, $long ? $long_tense{$t}: $t if $verbose ;
    50          
1321            
1322 6         12 foreach $p (@p){
1323 24         39 $w = "";
1324            
1325              
1326 24 50       81 if(defined($s = $reg{$edg}->{$t}->[$p-1])) {
1327 24         37 $w="$root$s";
1328 24 50       48 $w = &$modif( $w ,$root, $edg ,$p ,$t ) if( $modif );
1329            
1330 24 50       54 $w = " " if is_defectivo( $verb, $v, $t, $p ) ;
1331              
1332             }
1333 24         42 $w=~s/^x$/ /;
1334 24         52 push @res, $w ;
1335 24         74 $res{$t}->[$p] = $w;
1336             } } }
1337             } # End regular verbs ##################
1338             # ####################################
1339             # Format output : accents, columns ...
1340 11 50       28 unless($isoacc){
1341             # print "Iso un-accentuating \n";
1342 0 0       0 if($rc ne "h"){
1343 0         0 @res = iso2asc(@res);
1344             }else{
1345 0         0 @res{keys(%res)}=iso2asc(values(%res));
1346             }
1347             }
1348             # Format output
1349 11 100       41 if ( $rc eq "c" ){ return tabcol($verbose+@p,\@res,$sep); }
  4 50       26  
    100          
    50          
1350 0         0 elsif( $rc eq "r" ){ return tabrow($verbose+@p,\@res,$sep); }
1351             elsif( $rc eq "s" ){ # Single line
1352 4         21 $_ = join($sep,grep defined, @res);
1353 4         29 s/\s+$//mg;
1354 4         36 return $_ }
1355 3         22 elsif( $rc eq "h" ){ return \%res }
1356 0         0 return \@res ;
1357            
1358             }
1359              
1360             # Tries to find a verb in $vlist (string containing verb defs)
1361             # Eventually, finds model verbs for it.
1362             sub locate {
1363            
1364 11 50   11 0 38 my $verb = ( ref($_[0]) eq "HASH") ? shift : \%verb ;
1365             # HERE 5 7 97
1366             # print "locate($_[0]) with ",($verb==\%verb)?"global":"local","\n";
1367 11         17 my $v=$_[0];
1368            
1369 11 100 66     67 return if !$v || defined($verb->{$v});
1370            
1371 6         21 while( $v ){
1372            
1373 6 50       20 return if defined($verb->{$v});
1374            
1375             # print "Trying to locate >>$v<<\n";
1376 6 100       241 if( $vlist =~ / \b$v \s* : \s* ( [^=:]+ [=:]? ) /mx ){
1377             # print "Located >>$1<<\n";
1378 3         22 $_ = $1 ;
1379 3         33 s/\S+\s*[:=]//g;
1380            
1381             # print "Becomes >>$v $_<<\n";
1382 3         18 $verb->{$v} = verbify( "$v $_" );
1383            
1384             }
1385            
1386 6         13 my $m = "";
1387 6 0 33     205 if($vlist =~ / \b$v \s* ([^\s=:]|\Z) /x &&
      33        
1388             # $` =~ / \b(\S*)\s* ( = [^:=]*) \Z/x ){
1389             $` =~ / ([^\s\n]*)\s* ( = [^\:\=]*) \Z/x &&
1390             $1 !~/^defectivos[1234]?$/ ){
1391            
1392             # print "found for model : >>$1,$2<<\n";
1393 0         0 $m = $1;
1394 0         0 $verb->{$v}->{model} = $m ;
1395             }
1396            
1397 6 50       251 if($vlist =~ / defectivos([1234])?\s* ( = [^\:\=]*) \b$v \s*
1398             ([^\s=:]|\Z) /x
1399             ){
1400            
1401             # print "FOUND DEFECTIVE >>$1,$2<<\n";
1402 0 0       0 $verb->{"defectivos". ($1 eq "3" ? "": "$1")}->{"$v"}= $1 ;
1403             # print " Def $v,$1,defectivos",($1 eq "3") ? "": "$1","\n";
1404 0 0       0 $verb->{defectivos}->{$v} = ($1 eq "3") ? "$v" : $1;
1405 0         0 $v="";
1406            
1407             }
1408 6         29 $v = $m ;
1409            
1410             }
1411            
1412             }
1413             ######################################################################
1414             ################ A few Output-formatting functions ###################
1415              
1416             # Tabify a list into a string
1417             sub tabcol {
1418 4     4 0 8 my ($ncols,$l,$sep) = @_ ;
1419 4 50       9 $sep = " " unless defined $sep ;
1420             # print "tabcol received $ncols, $#$l ,sep=$sep, \@\$l=",join(" ,",@$l),"\n";
1421            
1422 4 50       10 $ncols = 1 unless $ncols;
1423 4 50       12 $ncols = int(($#{$l} + 1)/(-$ncols)+0.9999) if($ncols<0);
  0         0  
1424              
1425             # Maximum widtdth of each column
1426 4         12 my @mx = (0) x $ncols ; # not 0 x $ncols or whatever
1427            
1428 4         12 my ($i,$res,$a) = (0,"",0) ;
1429            
1430 4         9 foreach (@$l) {
1431             # $mx[$i] = $a if( $mx[$i] < ($a=length($_)));
1432 52 100 100     382 $mx[$i] = $a if( defined($_) && ($mx[$i] < ($a=length($_))));
1433 52         85 $i = ($i+1)% $ncols ;
1434             }
1435            
1436             # print "mx ",join(" ,",@mx),"\n";
1437 4         8 $i=0;
1438 4         8 foreach (@$l) {
1439 52 100       187 $res .= sprintf("%-$mx[$i]s$sep", defined($_) ? $_ : "" );
1440 52         72 $i = ($i+1)%$ncols ;
1441 52 100       112 $res .= "\n" unless $i ;
1442             }
1443 4 50       27 $res .= "\n" unless $res =~ /\n$/;
1444 4         41 $res;
1445             }
1446              
1447             # Tabify a list into a string
1448             sub tabrow {
1449 0     0 0   my ($nrows,$l,$sep) = @_ ;
1450 0 0         $sep = " " unless defined $sep ;
1451              
1452 0 0         my $nn = $#$l+1 > $nrows ? $#$l+1 : $nrows ;
1453              
1454 0 0         $nrows = 1 unless $nrows;
1455 0 0         $nrows = ($#{$l} + 1)/(-$nrows) if($nrows<0);
  0            
1456            
1457 0           my @mx = (0) x $nn ;
1458 0           my @res = "" x $nn ;
1459 0           my ($i,$j,$a) = (0,0,"") ;
1460             # print "n=$nrows $#$l $nn\n";
1461 0           foreach (@$l) {
1462 0 0         $_ = "" unless defined($_);
1463 0 0 0       $mx[$j] = $a if(defined($_) && $mx[$j] < ($a=length($_)));
1464 0           $i = ($i+1)% $nrows ;
1465 0 0         $j++ unless $i;
1466             }
1467            
1468 0           $i=$j=0;
1469 0           foreach (@$l) {
1470 0           $res[$i] .= sprintf("%-$mx[$j]s$sep",$_);
1471 0           $i = ($i+1)%$nrows ;
1472 0 0         $j++ unless $i;
1473             }
1474 0           $res = join("\n",@res)."\n";
1475 0           $res =~ s/\n[\n\s]+/\n/mg;
1476 0           $res;
1477             }
1478              
1479             sub env_is_utf8 ()
1480             {
1481 0     0 0   foreach my $v (qw(LC_ALL LC_TYPE LANG))
1482             {
1483 0 0 0       if (exists ($ENV{$v}) && defined ($ENV{$v}))
1484             {
1485 0           return $ENV{$v} =~ /utf-?8/i;
1486             }
1487             }
1488 0           return undef;
1489             }
1490              
1491             ######################################################################
1492              
1493              
1494             BEGIN {
1495              
1496             # ## Define a string variable $vlist that holds a database for Portuguese
1497             # ## verbs. The non-commented text below has the format :
1498             #
1499             # model_verb = verb1 verb2 ...
1500             #
1501             # ## To specify that verb1, verb1 ... conjugate like model_verb.
1502             #
1503             #
1504             # verb : conjugo conjugues ...
1505             #
1506             # ## To specify the conjugation of verb.
1507             #
1508             # # WARNING ### don't write "=" and ":" on the same line.
1509             #
1510             # Order of tenses :
1511             # pres perf imp fut mdp cpres cimp cfut cond ivo pp grd
1512             #
1513             # Cool : Emacs perl-mode highlights the infinitives (as labels?).
1514              
1515 1     1   16473 $vlist = <
1516              
1517             obter: obtenho obténs obtém ivo obtém model ter
1518             abster: abstenho absténs abstém ivo abstém model ter
1519             ater: atenho aténs atém ivo atém model ter
1520             conter: contenho conténs contém ivo contém model ter
1521             deter: detenho deténs detém ivo detém model ter
1522             entreter: entretenho entreténs entretém ivo entretém model ter
1523             reter: retenho reténs retém ivo retém model ter
1524             suster: sustenho susténs sustém ivo sustém model ter
1525              
1526             # obter = abster ater conter deter entreter reter suster # phoey
1527             boiar:
1528             bóio etc
1529             cpres bóie bóies bóie boiemos bóiem
1530             ivo bóia bóie boiemos bóiem
1531             # This one has ivo,p=5 perdoeis in GPVP, perdoai in DLPO
1532             perdoar:
1533             perdoo perdoas perdoa perdoamos perdoam
1534             moer:
1535             moo moís mói moemos moem,
1536             moí,
1537             moía moías moía moíamos moíam, cfut moer etc cimp moesse etc
1538             ivo mói pp moído
1539             passear:
1540             passeio passeias passeia passeamos passeiam,
1541             cpres passeie passeies passeie passeemos passeeis passeiem
1542             ivo passeia
1543             incendiar:
1544             incendeio incendeias incendeia incendiamos incendeiam
1545             cpres incedeie incendeies incendeie incendiemos incendeiem
1546             ivo incendeia incendeie incendiemos incendeiem
1547             incendiar = ansiar mediar odiar remediar
1548             dizer:
1549             digo . diz,
1550             disse disseste disse dissemos disseram,,
1551             direi etc
1552             cpres diga etc,
1553             cimp dissesse dissesses dissesse dissêssemos dissessem
1554             cond diria etc,
1555             ivo diz,
1556             pp dito
1557             dizer = antedizer bendizer condizer contradizer desdizer
1558             interdizer maldizer predizer
1559             fazer = contrafazer desfazer satisfazer refazer
1560             fazer:
1561             faço . faz ,
1562             fiz fizeste fez fizemos fizeram ,
1563             fazia fazias fazia fazíamos faziam,
1564             fut farei farás fará faremos farão,
1565             fizera etc , # fizeras fizera fizéramos fizeram,
1566             faça etc , # faças faça façamos façam,
1567             cond faria etc , # farias faria faríamaos faria
1568             ivo faz
1569             pp feito
1570             dar:
1571             dou dás dá damos dais dão,
1572             dei deste etc
1573             mdp dera deras dera déramos deram,
1574             dê dês dê dêmos deis dêem,
1575             desse etc
1576             der deres der dermos derem ,
1577             ivo dá . demos
1578             poder:
1579             posso podes etc
1580             pude pudeste pôde pudemos puderam,
1581             mdp pudera etc
1582             cpres possa etc
1583             cimp pudesse pudesses pudesse pudéssemos pudessem
1584             # DLPO defines ivo like here, GPVP says it isn't defined
1585             ivo pode
1586             caber:
1587             caibo perf coube etc cpres caiba etc
1588             cimp acc
1589             mdp coubera acc etc
1590             # DLPO defines ivo like here, GPVP says it isn't defined
1591             ivo cabe
1592             sentir:
1593             sinto sentes etc
1594             cpres sinta etc
1595             # HERE Must check
1596             ivo sente sinta sintamos senti sintam
1597             sentir = ressentir assentir consentir mentir desmentir investir revestir desinvestir vestir
1598             ir:
1599             vou vais vai vamos ides vão ,
1600             fui foste foi fomos fostes foram ,
1601             cpres vá vás vá vamos vades vão,
1602             fosse fosses fosse fôssemos fôsseis fossem,
1603             for fores for formos fordes foram
1604             ivo vai vá vamos ide vão
1605             valer:
1606             valho vales vale valemos valem,
1607             cpres valha etc
1608             ivo vale
1609             prover: perf provi etc pp provido model ver
1610             rever: model ver
1611             sair:
1612             saio sais sai saímos saís saem,
1613             saí saíste saiu saímos saístes saíram,
1614             saía saías saía saíamos saíeis saíam
1615             mdp saíra saíras saíra saíramos saíreis saíram
1616             cpres saia saias saia saiamos saiais saiam
1617             cimp saísse saísses saísse saíssemos saísseis saíssem
1618             cfut sair saíres sair sairmos sairdes saírem
1619             ivo sai saia saiamos saí saiam
1620             abrir: pp aberto
1621             abrir = entreabrir
1622             saber:
1623             sei sabes sabe sabemos sabem ,
1624             soube soubeste soube soubemos souberam
1625             mdp soubera acc etc
1626             cpres saiba etc # saibas saiba saibamos saibam
1627             cimp acc
1628             ivo sabe
1629             # DLPO defines ivo like here. GPVP says ivo is not defined.
1630             querer:
1631             . . quer . . ,
1632             quis quiseste quis quisemos quiseram,
1633             mdp quisera acc etc
1634             cpres queira etc
1635             cimp quisesse acc etc
1636             ivo quer
1637              
1638             requerer:
1639             requeiro . requer ,
1640             requeri requereste requereu requeremos requerem ,
1641             cpres requeira etc , cimp requeresse etc , cfut requerer etc
1642             # DLPO defines ivo "requer requira requiramos requerei requiram"
1643             ivo requer
1644             ganhar: pp (ganho|ganhado)
1645             gastar: pp gast(|ad)o
1646             pagar: pp pago
1647             trazer:
1648             trago trazes traz trazemos trazem,
1649             trouxe trouxeste trouxe etc
1650             mdp trouxera acc etc
1651             fut trarei trarás trará traremos trarão,
1652             cpres traga etc
1653             cond traria etc
1654             ivo traz traga etc
1655             ferir: firo cpres fira ivo fere fira firamos feri firam
1656             ferir = conferir preferir transferir gerir digerir preterir
1657             servir divertir advertir reflectir repetir compelir vestir sugerir
1658             seguir:
1659             sigo cpres siga etc ivo segue
1660             seguir = perseguir prosseguir conseguir
1661             # pres perf imp fut mdp cpres cimp cfut cond ivo pp grd
1662             ler:
1663             leio lês lê lemos lêem
1664             cpres leia leias leia leiamos leiam
1665             ivo lê lêia leiamos leiam
1666             ler = reler tresler
1667             atribuir:
1668             atribuo atribuis atribui atribuímos atribuís atribuem,
1669             atribuí atribuíste atribuiu atribuímos atribuíram,
1670             atribuía atribuías atribuía atribuíamos atribuíam,
1671             cfut atribuir . atribuir atribuirmos .
1672             ivo atribui
1673             pp atribuído
1674             averiguar:
1675             cpres averigúe averigúes averigúe . averigúem
1676             ivo averigua
1677             pedir:
1678             peço cpres peça etc ivo pede peça peçamos pedi peçam
1679             ver:
1680             vejo vês vê vemos vêem,
1681             vi viste viu vimos viram,
1682             mdp vira etc
1683             cpres veja vejas veja vejamos vejam
1684             cimp visse visses visse víssemos vísseis vissem
1685             ivo vê veja vejamos vede vejam
1686             pp visto
1687             ver = antever entrever prever rever
1688             vir:
1689             venho vens vem vimos vindes vêm,
1690             vim vieste veio viemos viestes vieram,
1691             vinha vinhas vinha vínhamos vínheis vinham,
1692             mdp viera vieras viera viéramos vieram,
1693             cpres venha venhas venha venhamos venham,
1694             cimp viesse viesses viesse viéssemos viésseis viessem,
1695             cfut vier vieres vier viermos vierdes vierem,
1696             ivo vem venha vinhamos vinde venham
1697             pp vindo
1698             vir = advir convir intervir
1699              
1700             ouvir:
1701             o(i|u)ço ouves ouve ouvimos ouvem,
1702             cpres o(i|u)ça etc # ouças ouça ouçamos ouçam,
1703             # alternative : cpres oiça oiças oiça oiçamos oiçam
1704             ivo ouve oiça
1705             # alternative : ivo . oiça
1706             rir:
1707             rio ris ri rimos rides riem
1708             cpres ria rias ria riamos riais riam
1709             ivo ri ria riamos ride riam
1710             rir = sorrir
1711             fugir:
1712             fujo foges foge fugimos fogem ivo foge
1713             dormir: durmo , cpres durma
1714             cobrir: cubro cpres cubra pp coberto
1715             cobrir = encobrir descobrir
1716             agredir: agrido agrides etc , cpres agrida etc ivo agride
1717             agredir = prevenir progredir transgredir
1718              
1719             # More irregular verbs
1720             escrever: pp escrito
1721             escrever = descrever inscrever reescrever prescrever
1722             dormir = abolir demolir engolir
1723              
1724             influir: . . . . influís .
1725             ivo . . . influí .
1726             cimp influísse influísses influísse . . influíssem
1727              
1728             construir: . constr(ó|u)is constr(ó|u)i . . constr(o|u)em
1729             model influir
1730             destruir: . destr(ó|u)is destr(ó|u)i . . destr(o|u)em
1731             model influir
1732             polir:
1733             pulo pules pule polimos polis pulem
1734             cpres pula pulas pula pulamos pulais pulam
1735             ivo pule
1736              
1737             # Won't do construir = destruir
1738              
1739             subir:
1740             subo sobes sobe subimos sobem ivo sobe
1741              
1742              
1743             reaver:
1744             x x x reavemos reaveis x ,
1745             reouve reouveste reouve reouvemos reouvestes reouveram,
1746             reavia reavias reavia reavíamos reavíeis reaviam,
1747             reaverei reaverás reaverá reaveremos reavereis reaverão,
1748             reouvera reouveras reouvera reouvéramos reouvéreis reouveram,
1749             x x x x x x,
1750             reouvesse reouvesses reouvesse reouvéssemos reouvésseis reouvessem,
1751             reouver reouveres reouver reouvermos reouverdes reouverem,
1752             reaveria reaverias reaveria reaveríamos reaveríeis reaveriam,
1753             x x x x x, reavido reavendo
1754             pedir = despedir medir impedir expedir
1755             perder:
1756             perco ,
1757             cpres perca percas perca percais percam
1758             ivo perde perca percamos
1759             crer:
1760             creio crês crê . credes crêem,
1761             cpres creia creias creia creiamos creiais creiam
1762             ivo crê . . crede
1763             # Double Particípio Passado
1764             aceitar: pp aceit(o|e|ado)
1765             afeiçoar: pp afe(ct|içoad)o
1766             cativar: pp cativ(|ad)o
1767             cegar: pp ceg(|ad)o
1768             completar: pp complet(|ad)o
1769             cultivar: pp cult(|ivad)o
1770             descalçar: pp descalç(|ad)o
1771             entregar: pp entreg(ue|ado)
1772             enxugar: pp enxu(t|gad)o
1773             expulsar: pp expuls(|ad)o
1774             fartar: pp fart(|ad)o
1775             findar: pp find(|ad)o
1776             infectar: pp infect(|ad)o
1777             inquietar: pp inquiet(|ad)o
1778             isentar: pp isent(|ad)o
1779             juntar: pp junt(|ad)o
1780             libertar: pp libert(|ad)o
1781             limpar: pp limp(|ad)o
1782             manifestar: pp manifest(|ad)o
1783             matar: pp (matado|morto)
1784             murchar: pp murch(|ad)o
1785             ocultar: pp ocult(|ad)o
1786             salvar: pp salv(|ad)o
1787             secar: pp sec(|ad)o
1788             segurar: pp segur(|ad)o
1789             fechar: pp fech(|ad)o
1790             afligir: pp afli(t|gid)o
1791             concluir:pp conclu(s|íd)o
1792             corrigir:pp corr(ect|igid)o
1793             dirigir:pp dir(ect|igid)o
1794             distingir:pp distin(t|guid)o
1795             emergir:pp emer(s|gid)o
1796             erigir:pp er(ect|igid)o
1797             exprimir:pp expr(ess|imid)o
1798             extinguir:pp ext(int|inguid)o
1799             frigir:pp fri(t|gid)o
1800             imergir:pp imer(s|gid)o
1801             imprimir:pp impr(ess|imid)o
1802             incluir:pp inclu(s|íd)o
1803             inserir:pp ins(ert|erid)o
1804             omitir:pp om(ess|itid)o
1805             oprimir:pp opr(ess|imid)o
1806             repelir:pp rep(uls|elid)o
1807             submergir:pp submer(s|gid)o
1808             atingir:pp atin(t|gid)o
1809             absorver:pp absor(t|vid)o
1810             acender:pp ace(s|ndid)o
1811             agradecer:pp (grat|agradecid)o
1812             atender:pp aten(t|did)o
1813             benzer:pp ben(t|zid)o
1814             convencer:pp conv(ict|encid)o
1815             corromper:pp corr(upt|ompid)o
1816             defender:pp def(es|endid)o
1817             dissolver:pp dissol(lut|vid)o
1818             eleger:pp ele(it|gid)o
1819             envolver:pp envol(t|vid)o
1820             incorrer:pp inc(urs|orrid)o
1821             morrer:pp mor(t|rid)o
1822             nascer:pp na(d|scid)o
1823             perverter:pp perver(s|tid)o
1824             prender:pp pre(s|ndid)o
1825             pretender:pp preten(s|did)o
1826             revolver:pp revol(t|vid)o
1827             romper:pp ro(t|mpid)o
1828             submeter:pp subm(iss|etid)o
1829             suspender:pp suspen(s|did)o
1830             tender:pp ten(s|did)o
1831              
1832             # Some of these verb's forms aren't defined because they would sound
1833             # bad.
1834             defectivos1= abolir adir banir carpir colorir combalir comedir
1835             delinquir delir demolir descomedir embair empedernir escapulir
1836             extorquir falir florir munir remir renhir retorquir
1837            
1838             # These are defined only in the forms where the infinitive's 'i' is
1839             # either present, or replaced by a 'e'.
1840             defectivos2= aturdir brandir brunir emergir exaurir fremir fulgir
1841             haurir imergir jungir submergir ungir #
1842              
1843             # These verbs have only the third person defined.
1844             defectivos4= acontecer concernir grassar constar assentar
1845              
1846             defectivos3= precaver adequar
1847              
1848              
1849             EOD
1850             ;
1851             # ############### INITIALIZE THE DATABASE STRING OF VERBS ##############
1852              
1853 1         175 $vlist =~ s/\#.*\n+/\n/mg; # Remove comment and newlines
1854 1         237 $vlist =~ s/\n/ /mg;
1855              
1856             } # EOF BEGIN
1857             1 ;