[Koha-cvs] CVS: koha/misc/translator TmplTokenizer.pm,1.31,1.32 tmpl_process3.pl,1.18,1.19

Ambrose C. LI acli at users.sourceforge.net
Mon Mar 8 05:59:41 CET 2004


Update of /cvsroot/koha/koha/misc/translator
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21903

Modified Files:
	TmplTokenizer.pm tmpl_process3.pl 
Log Message:
Fixed some bugs which caused some context to be not recognized, and some
spurious context to be recognized.  In particular, the bugs fixed are:

1. Failure to recognize INPUT element at the end, e.g., if the input has
   the form "Item number:%S", then the pattern was recognized as only
   "Item number".

2. Failure to remove matching <foo></foo> tags if the pattern contains
   INPUT or TMPL_VAR; e.g., if the input has the form "<h1>%s %s</h1>",
   the form would not be simplified to "%s %s".

Unfortunately, fixing these 2 bugs will cause about 40 fuzzies to appear.


Index: TmplTokenizer.pm
===================================================================
RCS file: /cvsroot/koha/koha/misc/translator/TmplTokenizer.pm,v
retrieving revision 1.31
retrieving revision 1.32
diff -C2 -r1.31 -r1.32
*** TmplTokenizer.pm	27 Feb 2004 13:26:07 -0000	1.31
--- TmplTokenizer.pm	8 Mar 2004 04:59:38 -0000	1.32
***************
*** 541,551 ****
      my $undo_trailing_blanks = sub {
  		for (my $i = $#structure; $i >= 0; $i -= 1) {
! 		last if $structure[$i]->type != TmplTokenType::TEXT;
! 		last if !blank_p($structure[$i]->string);
  		    # Queue element structure: [reanalysis-p, token]
  		    push @{$this->{_queue}}, [1, pop @structure];
  		}
  	    };
      &$undo_trailing_blanks;
      while (@structure >= 2) {
  	my $something_done_p = 0;
--- 541,552 ----
      my $undo_trailing_blanks = sub {
  		for (my $i = $#structure; $i >= 0; $i -= 1) {
! 		last unless ($structure[$i]->type == TmplTokenType::TEXT && blank_p($structure[$i]->string)) ;#|| ($structure[$i]->type == TmplTokenType::TAG && $structure[$i]->string =~ /^<br\b/is);
  		    # Queue element structure: [reanalysis-p, token]
  		    push @{$this->{_queue}}, [1, pop @structure];
  		}
  	    };
+ 	    print "DEBUG: optimize: entry: checking: ", join('', map {$_->string} @structure), "\n";
      &$undo_trailing_blanks;
+ 	    print "DEBUG: optimize: structure length is ", scalar @structure, "\n";
      while (@structure >= 2) {
  	my $something_done_p = 0;
***************
*** 557,560 ****
--- 558,562 ----
  		&& $structure[$#structure]->string =~ /^<\//s) {
  	    my $has_other_tags_p = 0;
+ 	    print "DEBUG: checking for unmatched close tag: ", join('', map {$_->string} @structure), "\n";
  	    for (my $i = 0; $i < $#structure; $i += 1) {
  		$has_other_tags_p = 1
***************
*** 563,570 ****
--- 565,574 ----
  	    }
  	    if (!$has_other_tags_p) {
+ 	    print "DEBUG: requeuing ", $structure[$#structure]->string, "\n";
  		push @{$this->{_queue}}, [0, pop @structure]
  		&$undo_trailing_blanks;
  		$something_done_p = 1;
  	    }
+ 	    print "DEBUG: finished checking for unmatched closed tag\n";
  	}
  	# FIXME: Do the same ugly hack for the last token being a ( or [
***************
*** 576,579 ****
--- 580,610 ----
  	    $something_done_p = 1;
  	}
+ 	# FIXME: If the first token is an open tag, but there is no
+ 	# FIXME: corresponding close tag, "drop the open tag", i.e.,
+ 	# FIXME: requeue everything for reanalysis, except the frist tag. :-(
+ 	if (@structure >= 2
+ 		&& $structure[0]->type == TmplTokenType::TAG
+ 		&& $structure[0]->string =~ /^<([a-z0-9]+)/is
+ 		&& (my $tag = $1) !~ /^(?:br|hr|img|input)\b/is
+ 	) {
+ 	    print "DEBUG: checking for unmatched open tag: ", join('', map {$_->string} @structure), "\n";
+ 	    my $tag_open_count = 1;
+ 	    for (my $i = 1; $i <= $#structure; $i += 1) {
+ 		if ($structure[$i]->type == TmplTokenType::TAG) {
+ 		    if ($structure[$i]->string =~ /^<(\/?)$tag\b/is) {
+ 			$tag_open_count += ($1? -1: +1);
+ 		    }
+ 		}
+ 	    }
+ 	    if ($tag_open_count > 0) {
+ 	    print "DEBUG: tag open count is $tag_open_count, requeuing...\n";
+ 		for (my $i = $#structure; $i; $i -= 1) {
+ 	    print "DEBUG: requeuing ", $structure[$#structure]->string, "\n";
+ 		    push @{$this->{_queue}}, [1, pop @structure];
+ 		}
+ 		$something_done_p = 1;
+ 	    }
+ 	    print "DEBUG: finished checking structure\n\n";
+ 	}
  	# FIXME: If the first token is an open tag, the last token is the
  	# FIXME: corresponding close tag, and there are no other close tags 
***************
*** 582,589 ****
  	if (@structure >= 3
  		&& $structure[0]->type == TmplTokenType::TAG
! 		&& $structure[0]->string =~ /^<([a-z0-9])/is && (my $tag = $1)
  		&& $structure[$#structure]->type == TmplTokenType::TAG
  		&& $structure[$#structure]->string =~ /^<\/$1\s*>$/is) {
  	    my $has_other_open_or_close_tags_p = 0;
  	    for (my $i = 1; $i < $#structure; $i += 1) {
  		$has_other_open_or_close_tags_p = 1
--- 613,621 ----
  	if (@structure >= 3
  		&& $structure[0]->type == TmplTokenType::TAG
! 		&& $structure[0]->string =~ /^<([a-z0-9]+)/is && (my $tag = $1)
  		&& $structure[$#structure]->type == TmplTokenType::TAG
  		&& $structure[$#structure]->string =~ /^<\/$1\s*>$/is) {
  	    my $has_other_open_or_close_tags_p = 0;
+ 	    print "DEBUG: checking for matching open and close tags: ", join('', map {$_->string} @structure), "\n";
  	    for (my $i = 1; $i < $#structure; $i += 1) {
  		$has_other_open_or_close_tags_p = 1
***************
*** 594,601 ****
--- 626,635 ----
  	    if (!$has_other_open_or_close_tags_p) {
  		for (my $i = $#structure; $i; $i -= 1) {
+ 	    print "DEBUG: requeuing ", $structure[$#structure]->string, "\n";
  		    push @{$this->{_queue}}, [1, pop @structure];
  		}
  		$something_done_p = 1;
  	    }
+ 	    print "DEBUG: finished checking for matching open and close tags\n";
  	}
      last if !$something_done_p;
***************
*** 611,619 ****
      for (my $i = 0; $i <= $#structure; $i += 1) {
  	if ($structure[$i]->type == TmplTokenType::TAG) {
! 	    if ($structure[$i]->string =~ /^<([A-Z0-9]+)/is) {
  		my $tag = lc($1);
! 		push @tags, $tag unless $tag =~ /^<(?:input)/is
! 			|| $tag =~ /\/>$/is;
! 	    } elsif ($structure[$i]->string =~ /^<\/([A-Z0-9]+)/is) {
  		if (@tags && lc($1) eq $tags[$#tags]) {
  		    pop @tags;
--- 645,655 ----
      for (my $i = 0; $i <= $#structure; $i += 1) {
  	if ($structure[$i]->type == TmplTokenType::TAG) {
! 	    my $form = $structure[$i]->string;
! 	    if ($form =~ /^<([A-Z0-9]+)/is) {
  		my $tag = lc($1);
! 		if ($tag !~ /^(?:br|input)$/is && $form !~ /\/>$/is) {
! 		    push @tags, $tag;
! 		}
! 	    } elsif ($form =~ /^<\/([A-Z0-9]+)/is) {
  		if (@tags && lc($1) eq $tags[$#tags]) {
  		    pop @tags;
***************
*** 658,664 ****
  		$parametrized_p = 1;
  	    } elsif ($it->type == TmplTokenType::TAG && $it->string =~ /^<([A-Z0-9]+)/is) {
! 		push @tags, lc($1);
! 		$with_anchor_p = 1 if lc($1) eq 'a';
! 		$with_input_p = 1 if lc($1) eq 'input';
  	    }
  	    # We hate | and || in msgid strings, so we try to avoid them
--- 694,701 ----
  		$parametrized_p = 1;
  	    } elsif ($it->type == TmplTokenType::TAG && $it->string =~ /^<([A-Z0-9]+)/is) {
! 		my $tag = lc($1);
! 		push @tags, $tag if $tag !~ /^(?:br|input)$/i;
! 		$with_anchor_p = 1 if $tag eq 'a';
! 		$with_input_p = 1 if $tag eq 'input';
  	    }
  	    # We hate | and || in msgid strings, so we try to avoid them
***************
*** 679,687 ****
  		} elsif ($next->type == TmplTokenType::TAG) {
  		    if ($next->string =~ /^<([A-Z0-9]+)/is) {
! 			my $candidate = lc($1);
! 			push @tags, $candidate
! 				unless $candidate =~ /^(?:input)$/is;
! 			$with_anchor_p = 1 if lc($1) eq 'a';
! 			$with_input_p = 1 if lc($1) eq 'input';
  		    } elsif ($next->string =~ /^<\/([A-Z0-9]+)/is) {
  			my $close = lc($1);
--- 716,723 ----
  		} elsif ($next->type == TmplTokenType::TAG) {
  		    if ($next->string =~ /^<([A-Z0-9]+)/is) {
! 			my $tag = lc($1);
! 			push @tags, $tag if $tag !~ /^(?:br|input)$/i;
! 			$with_anchor_p = 1 if $tag eq 'a';
! 			$with_input_p = 1 if $tag eq 'input';
  		    } elsif ($next->string =~ /^<\/([A-Z0-9]+)/is) {
  			my $close = lc($1);

Index: tmpl_process3.pl
===================================================================
RCS file: /cvsroot/koha/koha/misc/translator/tmpl_process3.pl,v
retrieving revision 1.18
retrieving revision 1.19
diff -C2 -r1.18 -r1.19
*** tmpl_process3.pl	1 Mar 2004 18:46:43 -0000	1.18
--- tmpl_process3.pl	8 Mar 2004 04:59:38 -0000	1.19
***************
*** 55,59 ****
  	    next if $a eq 'content' && $tag ne 'meta';
  	    next if $a eq 'value' && ($tag ne 'input'
! 		|| (ref $attr->{'type'} && $attr->{'type'}->[1] =~ /^(?:hidden|radio)$/)); # FIXME
  	    my($key, $val, $val_orig, $order) = @{$attr->{$a}}; #FIXME
  	    if ($val =~ /\S/s) {
--- 55,59 ----
  	    next if $a eq 'content' && $tag ne 'meta';
  	    next if $a eq 'value' && ($tag ne 'input'
! 		|| (ref $attr->{'type'} && $attr->{'type'}->[1] =~ /^(?:hidden|radio|text)$/)); # FIXME
  	    my($key, $val, $val_orig, $order) = @{$attr->{$a}}; #FIXME
  	    if ($val =~ /\S/s) {





More information about the Koha-cvs mailing list