[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;