[Koha-cvs] CVS: koha/misc/translator text-extract2.pl,1.22,1.23

[Ambrose Li]

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

Modified Files:
	text-extract2.pl 
Log Message:
Don't complain about </TMPL_IF> or </TMPL_LOOP> being strange attribute
syntax; they are fine.

The way TMPL_VAR is warned probably makes more sense now.


Index: text-extract2.pl
===================================================================
RCS file: /cvsroot/koha/koha/misc/translator/text-extract2.pl,v
retrieving revision 1.22
retrieving revision 1.23
diff -C2 -r1.22 -r1.23
*** text-extract2.pl	14 Feb 2004 06:16:36 -0000	1.22
--- text-extract2.pl	14 Feb 2004 07:07:36 -0000	1.23
***************
*** 24,28 ****
  use vars qw( $input );
  use vars qw( $debug_dump_only_p );
! use vars qw( $pedantic_p $pedantic_error_occurred_in_nonpedantic_mode_p );
  use vars qw( $fatal_p );
  
--- 24,30 ----
  use vars qw( $input );
  use vars qw( $debug_dump_only_p );
! use vars qw( $pedantic_p $pedantic_tag );
! use vars qw( $pedantic_attribute_error_in_nonpedantic_mode_p );
! use vars qw( $pedantic_tmpl_var_use_in_nonpedantic_mode_p );
  use vars qw( $fatal_p );
  
***************
*** 31,42 ****
  # Hideous stuff
  use vars qw( $re_directive $re_tmpl_var $re_tmpl_var_escaped $re_tmpl_include );
  BEGIN {
      # $re_directive must not do any backreferences
      $re_directive = q{<(?:(?i)(?:!--\s*)?\/?TMPL_(?:VAR|LOOP|INCLUDE|IF|ELSE|UNLESS)(?:\s+(?:[a-zA-Z][-a-zA-Z0-9]*=)?(?:'[^']*'|"[^"]*"|[^\s<>]+))*\s*(?:--)?)>};
!     # As above but only TMPL_VAR and TMPL_INCLUDE (those that can emit a value)
!     $re_tmpl_var = q{<(?:(?i)(?:!--\s*)?\/?TMPL_(?:VAR)(?:\s+(?:[a-zA-Z][-a-zA-Z0-9]*=)?(?:'[^']*'|"[^"]*"|[^\s<>]+))*\s*(?:--)?)>};
!     $re_tmpl_include = q{<(?:(?i)(?:!--\s*)?\/?TMPL_(?:INCLUDE)(?:\s+(?:[a-zA-Z][-a-zA-Z0-9]*=)?(?:'[^']*'|"[^"]*"|[^\s<>]+))*\s*(?:--)?)>};
      # TMPL_VAR ESCAPE=1/HTML/URL
!     $re_tmpl_var_escaped = q{<(?:(?i)(?:!--\s*)?\/?TMPL_(?:VAR|INCLUDE)(?:\s+(?:[a-zA-Z][-a-zA-Z0-9]*=)?(?:'[^']*'|"[^"]*"|[^\s<>]+))\s+ESCAPE=(?:1|HTML|URL)(?:\s+(?:[a-zA-Z][-a-zA-Z0-9]*=)?(?:'[^']*'|"[^"]*"|[^\s<>]+))*\s*(?:--)?)>};
  }
  
--- 33,47 ----
  # Hideous stuff
  use vars qw( $re_directive $re_tmpl_var $re_tmpl_var_escaped $re_tmpl_include );
+ use vars qw( $re_tmpl_endif_endloop );
  BEGIN {
      # $re_directive must not do any backreferences
      $re_directive = q{<(?:(?i)(?:!--\s*)?\/?TMPL_(?:VAR|LOOP|INCLUDE|IF|ELSE|UNLESS)(?:\s+(?:[a-zA-Z][-a-zA-Z0-9]*=)?(?:'[^']*'|"[^"]*"|[^\s<>]+))*\s*(?:--)?)>};
!     # TMPL_VAR or TMPL_INCLUDE
!     $re_tmpl_var = q{<(?:(?i)(?:!--\s*)?TMPL_(?:VAR)(?:\s+(?:[a-zA-Z][-a-zA-Z0-9]*=)?(?:'[^']*'|"[^"]*"|[^\s<>]+))*\s*(?:--)?)>};
!     $re_tmpl_include = q{<(?:(?i)(?:!--\s*)?TMPL_(?:INCLUDE)(?:\s+(?:[a-zA-Z][-a-zA-Z0-9]*=)?(?:'[^']*'|"[^"]*"|[^\s<>]+))*\s*(?:--)?)>};
      # TMPL_VAR ESCAPE=1/HTML/URL
!     $re_tmpl_var_escaped = q{<(?:(?i)(?:!--\s*)?TMPL_(?:VAR|INCLUDE)(?:\s+(?:[a-zA-Z][-a-zA-Z0-9]*=)?(?:'[^']*'|"[^"]*"|[^\s<>]+))\s+ESCAPE=(?:1|HTML|URL)(?:\s+(?:[a-zA-Z][-a-zA-Z0-9]*=)?(?:'[^']*'|"[^"]*"|[^\s<>]+))*\s*(?:--)?)>};
!     # /LOOP or /IF or /UNLESS
!     $re_tmpl_endif_endloop = q{<(?:(?i)(?:!--\s*)?\/TMPL_(?:LOOP|IF|UNLESS)(?:\s+(?:[a-zA-Z][-a-zA-Z0-9]*=)?(?:'[^']*'|"[^"]*"|[^\s<>]+))*\s*(?:--)?)>};
  }
  
***************
*** 74,77 ****
--- 79,95 ----
  use vars qw( $cdata_mode_p $cdata_close );
  
+ ###############################################################################
+ 
+ sub warn_pedantic ($$) {
+     my($flag, $msg) = @_;
+     warn "Warning$pedantic_tag: $msg\n" if $pedantic_p || !$$flag;
+     if (!$pedantic_p) {
+ 	warn "Warning$pedantic_tag: Further similar negligible warnings will not be reported, use --pedantic for details\n" unless $$flag;
+ 	$$flag = 1;
+     }
+ }
+ 
+ ###############################################################################
+ 
  sub extract_attributes ($;$) {
      my($s, $lc) = @_;
***************
*** 89,111 ****
  	    warn "Warning: TMPL_INCLUDE in attribute"
  		. (defined $lc? " near line $lc": '') . ": $val_orig\n";
  	} elsif ($val_orig !~ /^['"]/) {
! 	    if ($val =~ /$re_tmpl_var/os && $val !~ /$re_tmpl_var_escaped/os) {
! 		warn "Warning: TMPL_VAR without ESCAPE in unquoted attribute"
! 		    . (defined $lc? " near line $lc": '') . ": $val_orig\n";
! 	    } elsif ($val =~ /[^-\.A-Za-z0-9]/s) {
! 		if ($pedantic_p) {
! 		    warn "Warning: Unquoted attribute containing character(s) that must be quoted"
! 			. (defined $lc? " near line $lc": '') . ": $val_orig\n";
! 		} else {
! 		    warn "Warning: Negligible minor syntax error in token detected"
! 			. (defined $lc? " near line $lc": '')
! 			. ", use --pedantic to show\n"
! 			unless $pedantic_error_occurred_in_nonpedantic_mode_p;
! 		    $pedantic_error_occurred_in_nonpedantic_mode_p = 1;
! 		}
! 	    }
  	}
      }
!     if ($s =~ /\S/s) { # should never happen
  	if ($s =~ /^([^\n]*)\n/s) { # this is even worse
  	    warn "Error: Completely confused while extracting attributes"
--- 107,124 ----
  	    warn "Warning: TMPL_INCLUDE in attribute"
  		. (defined $lc? " near line $lc": '') . ": $val_orig\n";
+ 	} elsif ($val =~ /$re_tmpl_var/os && $val !~ /$re_tmpl_var_escaped/os) {
+ 	    warn_pedantic \$pedantic_tmpl_var_use_in_nonpedantic_mode_p,
+ 		    "Unescaped TMPL_VAR in attribute"
+ 		    . (defined $lc? " near line $lc": '') . ": $val_orig"
+ 		if $pedantic_p || !$pedantic_tmpl_var_use_in_nonpedantic_mode_p;
  	} elsif ($val_orig !~ /^['"]/) {
! 	    warn_pedantic \$pedantic_attribute_error_in_nonpedantic_mode_p,
! 		"Unquoted attribute contains character(s) that should be quoted"
! 		. (defined $lc? " near line $lc": '') . ": $val_orig"
! 		if $val =~ /[^-\.A-Za-z0-9]/s;
  	}
      }
!     my $s2 = $s; $s2 =~ s/$re_tmpl_endif_endloop//g; # for the next check
!     if ($s2 =~ /\S/s) { # should never happen
  	if ($s =~ /^([^\n]*)\n/s) { # this is even worse
  	    warn "Error: Completely confused while extracting attributes"
***************
*** 321,324 ****
--- 334,338 ----
      'help'		=> sub { usage(0) },
  ) || usage_error;
+ $pedantic_tag = $pedantic_p? '': ' (negligible)';
  usage_error('Missing mandatory option -f') unless defined $input;