[Po4a-devel][CVS] po4a/lib/Locale/Po4a Po.pm,1.15,1.16

Update of /cvsroot/po4a/po4a/lib/Locale/Po4a In directory haydn:/tmp/cvs-serv23510/lib/Locale/Po4a Modified Files: Po.pm Log Message: Implement a tool I dream of since a long time: msgsearch, which allows you to filter out some messages of the po file and put them in another Index: Po.pm =================================================================== RCS file: /cvsroot/po4a/po4a/lib/Locale/Po4a/Po.pm,v retrieving revision 1.15 retrieving revision 1.16 diff -u -d -r1.15 -r1.16 --- Po.pm 1 Aug 2004 09:44:50 -0000 1.15 +++ Po.pm 2 Aug 2004 09:35:39 -0000 1.16 @@ -77,7 +77,8 @@ my %debug=('canonize' => 0, 'quote' => 0, - 'escape' => 0); + 'escape' => 0, + 'filter' => 1); =head1 Functions about whole message catalogs @@ -142,16 +143,21 @@ my $filename=shift || croak (dgettext("po4a","po4a::po: Please provide a non-nul filename")."\n"); - open INPUT,"<$filename" - || croak (sprintf(dgettext("po4a","Can't read from %s: %s"),$filename,$!)."\n"); + my $fh; + if ($filename eq '-') { + $fh=*STDIN; + } else { + open $fh,"<$filename" + || croak (sprintf(dgettext("po4a","Can't read from %s: %s"),$filename,$!)."\n"); + } ## Read paragraphs line-by-line my $pofile=""; my $textline; - while (defined ($textline = <INPUT>)) { + while (defined ($textline = <$fh>)) { $pofile .= $textline; } - close INPUT || croak (sprintf(dgettext("po4a","Can't close %s after reading: %s"),$filename,$!)."\n"); +# close INPUT || croak (sprintf(dgettext("po4a","Can't close %s after reading: %s"),$filename,$!)."\n"); my $linenum=0; @@ -334,29 +340,192 @@ return $pores; } -=item select_file() +=item filter() This function extract a catalog from an existing one. Only the entries having a reference in the given file will be placed in the resulting catalog. +This function parses its argument, convert it to a perl function definition, +eval this definition and filter the fields for which this function returns true. +I love perl sometimes ;) + =cut -sub select_file { +sub filter { my $self=shift; - my $file=shift; + our $filter=shift; my $res; $res = Locale::Po4a::Po->new(); + # Parse the filter + our $code="sub apply { return "; + our $pos=0; + our $length = length $filter; + our @filter = split(//,$filter); # explode chars to parts. How to subscript a string in Perl? + + sub gloups { + my $fmt=shift; + my $space; + for (1..$pos){ + $space .= ' '; + } + die (sprintf(dgettext(&quot;po4a&quot;,$fmt).&quot;\n&quot;,(a)_).&quot;$filter\n$space^ HERE\n");; + } + sub showmethecode { + return unless $debug{'filter'}; + my $fmt=shift; + my $space=""; + for (1..$pos){ + $space .= ' '; + } + print STDERR "$filter\n$space^ $fmt\n";#"$code\n"; + } + + # I dream of a lex in perl :-/ + sub parse_expression { + showmethecode("Begin expression"); + + gloups("Begin of expression expected, got '%s'",$filter[$pos]) + unless ($filter[$pos] eq '('); + $pos ++; # pass the '(' + if ($filter[$pos] eq '&') { + # AND + $pos++; + showmethecode("Begin of AND"); + $code .= "("; + while (1) { + gloups ("Unfinished AND statement.") + if ($pos == $length); + parse_expression(); + if ($filter[$pos] eq '(') { + $code .= " && "; + } elsif ($filter[$pos] eq ')') { + last; # do not eat that char + } else { + gloups("End of AND or begin of sub-expression expected, got '%s'", $filter[$pos]); + } + } + $code .= ")"; + } elsif ($filter[$pos] eq '|') { + # OR + $pos++; + $code .= "("; + while (1) { + gloups("Unfinished OR statement.") + if ($pos == $length); + parse_expression(); + if ($filter[$pos] eq '(') { + $code .= " || "; + } elsif ($filter[$pos] eq ')') { + last; # do not eat that char + } else { + gloups("End of OR or begin of sub-expression expected, got '%s'",$filter[$pos]); + } + } + $code .= ")"; + } elsif ($filter[$pos] eq '!') { + # NOT + $pos++; + $code .= "(!"; + gloups("Missing sub-expression in NOT statement.") + if ($pos == $length); + parse_expression(); + $code .= ")"; + } else { + # must be an equal. Let's get field and argument + my ($field,$arg,$done); + $field = substr($filter,$pos); + gloups("EQ statement contains no '=' or invalid field name") + unless ($field =~ /([a-z]*)=/i); + $field = lc($1); + $pos += (length $field) + 1; + + # check that we've got a valid field name, and the number it referes to + my @names=qw(msgid msgstr reference flags comment automatic); # DO NOT CHANGE THE ORDER + my $fieldpos; + for ($fieldpos = 0; + $fieldpos < scalar @names && $field ne $names[$fieldpos]; + $fieldpos++) {} + gloups("Invalid field name: %s",$field) + if $fieldpos == scalar @names; # not found + + # Now, get the argument value. It has to be between quotes, which can be escaped + # We point right on the first char of the argument (first quote already ate) + my $escaped = 0; + my $quoted = 0; + if ($filter[$pos] eq '"') { + $pos++; + $quoted = 1; + } + showmethecode(($quoted?"Quoted":"Unquoted")." argument of field '$field'"); + + while (!$done) { + gloups("Unfinished EQ argument.") + if ($pos == $length); + + if ($quoted) { + if ($filter[$pos] eq '\\') { + if ($escaped) { + $arg .= '\\'; + $escaped = 0; + } else { + $escaped = 1; + } + } elsif ($escaped) { + if ($filter[$pos] eq '"') { + $arg .= '"'; + $escaped = 0; + } else { + gloups("Invalid escape sequence in argument: '\\%s'",$filter[$pos]); + } + } else { + if ($filter[$pos] eq '"') { + $done = 1; + } else { + $arg .= $filter[$pos]; + } + } + } else { + if ($filter[$pos] eq ')') { + $pos--; # counter the next ++ since we don't want to eat this char + $done = 1; + } else { + $arg .= $filter[$pos]; + } + } + $pos++; + } + # and now, add the code to check this equality + $code .= "(\$_[$fieldpos] =~ m/$arg/)"; + + } + showmethecode("End of expression"); + gloups("Unfinished statement.") + if ($pos == $length); + gloups("End of expression expected, got '%s'",$filter[$pos]) + unless ($filter[$pos] eq ')'); + $pos++; + } + # And now, launch the beast, finish the function and use eval to construct this function. + # Ok, the lack of lexer is a fair price for the eval ;) + parse_expression(); + gloups("Garbage at the end of the expression") + if ($pos != $length); + $code .= "; }"; + print STDERR "CODE = $code\n"; + eval $code; + die (sprintf(dgettext("po4a","Eval failure: %s")."\n",$@)) + if $@; + for (my $cpt=(0) ; $cpt<$self->count_entries(); - $cpt) { + $cpt++) { my ($msgid,$ref,$msgstr,$flags,$type,$comment,$automatic); $msgid = $self->msgid($cpt); $ref=$self->{po}{$msgid}{'reference'}; - next unless ($ref =~ / $file:/); $msgstr= $self->{po}{$msgid}{'msgstr'}; $flags = $self->{po}{$msgid}{'flags'}; @@ -364,14 +533,14 @@ $comment = $self->{po}{$msgid}{'comment'}; $automatic = $self->{po}{$msgid}{'automatic'}; -# $res->push_raw('msgid' => $msgid, -# 'msgstr' => $msgstr, -# 'flags' => $flags, -# 'type' => $type, -# 'reference' => $ref, -# 'comment' => $comment, -# 'automatic' => $automatic); - + $res->push_raw('msgid' => $msgid, + 'msgstr' => $msgstr, + 'flags' => $flags, + 'type' => $type, + 'reference' => $ref, + 'comment' => $comment, + 'automatic' => $automatic) + if (apply($msgid,$msgstr,$ref,$flags,$comment,$automatic)); # DO NOT CHANGE THE ORDER } return $res; }