view release on metacpan or  search on metacpan

lib/Lingua/PT/PLN.pm  view on Meta::CPAN

      for (/($A+(?:['-]$A+)*|$P)/g) { $oco{$_}++; $tot++ }
    }
  } else {
    my (@file) = (@_);
    for(@file) {
      open F,"< $_" or die "cant open $_: $!";
      binmode(F, ":utf8") if $opt{encoding} =~ /utf8/i ;
      while (<F>) {
	$_ = lc if $opt{ignorecase};
	s/<[^>]+>//g if $opt{ignorexml};
	for (/($A+(?:['-]$A+)*|$P)/g) { $oco{$_}++;  $tot++}
      }
      close F;
    }
  }

  if ($opt{log}){
    print "total = $tot\n";
    _setmax($tot);
    _setmax($opt{log}) if($opt{log} > 1);
    for (keys %oco){
      $oco{$_}=_logit($oco{$_});
    }
  }

  if ($opt{num}) { # imprime por ordem de quantidade de ocorrencias

    # TODO: não é portável
    if (defined $opt{output}) {
      open SORT,"| sort -nr > $opt{output}"
    } else {
      open SORT,"| sort -nr"
    }

    for my $i (keys %oco) {
      print SORT "$oco{$i} $i"
    }
    close SORT;

  } elsif ($opt{alpha}) { # imprime ordenado alfabeticamente

    if (defined $opt{output}) {
      open SORT ,"> $opt{output}";
      for my $i (sort keys %oco ) {
	print SORT  "$i $oco{$i}";
      }
    } else {
      binmode STDOUT, ":utf8" if $opt{encoding};
      for my $i (sort keys %oco ) {
	print  "$i $oco{$i}";
      }
    }
  } else {
    return (%oco)
  }
}

### syllabs, and accents

sub accent {
  local $/ = "";           # input record separator=1 or more empty lines
  my $p=shift;
  $p =~ s/(\w+)/ wordaccent($1) /ge;
  $p
}

sub wordaccent {
  my $p = syllable($_[0]);
  my $flag = $_[1] or 0; # 0 (default) => use : after vowel; 1 => use " before syllable
  for ($p) {
    s{(\w*$acento)}{"$1}i             or  # word with an accent character
#      s{(\w*)([ua])(ir)$}{$1$2|"$3}i  or  # word ending with air uir
      s{(\w*([zlr]|[iu]s?|um))$}{"$1}i   or  # word ending with z l r i u is us
      s{(\w+\|\w+)$}{"$1}             or  # accent in 2 syllable frm the end
      s{(\w)}{"$1};                       # accent in the only syllable

    if(!$flag){
      # s{"(([qg]u|$consoante)*($vogal|[yw]))}{$1:}i; # accent in the 1.st vowel
      # bugfix: quo|ti|"dia|no => quo|ti|dia:|no; op|"ção => op|çã:o
      s{"(([qg]u|$consoante)*([i]$vogal|$vogal|[yw]))}{$1:}i; # accent in the 1.st vowel
      s{:($acento)}{$1:}i;                         # mv accent after accents
      s{"}{}g;
    }

  }
  $p
}

my %syl = (
   20 => " -.!?:;",
   10 => "bçdfgjkpqtv",
   8 => "sc",
   7 => "m",
   6 => "lzx",
   5 => "nr",
   4 => "h",
   3 => "wy",
   2 => "eaoáéíóúôâêûàãõäëïöü",
   1 => "iu",
   breakpair =>
      #"ie|ia|io|ee|oo|oa|sl|sm|sn|sc|sr|rn|bc|lr|lz|bd|bj|bg|bq|bt|bv|pt|pc|dj|pç|ln|nr|mn|tp|bf|bp",
      "sl|sm|sn|sc|sr|rn|bc|lr|lz|bd|bj|bg|bq|bt|bv|pt|pc|dj|pç|ln|nr|mn|tp|bf|bp|xc|sç|ss|rr",
	# dígrafos que se separam sempre: xc, sç, ss, rr, sc.
  );

my %spri = ();

for my $pri (grep(/\d/, keys %syl)){
  for(split(//,$syl{$pri})) { $spri{$_} = $pri}}

(my $sylseppair= $syl{breakpair}) =~ s/(\w)(\w)/(\?<=($1))(\?=($2))/g;

sub syllable{
  my $p=shift;

  for($p){
    s/$sylseppair/|/g;
    s{(\w)(?=(\w)(\w))}
      {if($spri{lc($1)}<$spri{lc($2)} && $spri{lc($2)}>=$spri{lc($3)}){"$1|"}
       else{$1}
      }ge;