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

[Ambrose Li]

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

Modified Files:
        text-extract2.pl 
Log Message:
Minor factoring of construction of warning messages.


Index: text-extract2.pl
===================================================================
RCS file: /cvsroot/koha/koha/misc/translator/text-extract2.pl,v
retrieving revision 1.32
retrieving revision 1.33
diff -C2 -r1.32 -r1.33
*** text-extract2.pl    14 Feb 2004 09:50:11 -0000      1.32
--- text-extract2.pl    16 Feb 2004 22:50:34 -0000      1.33
***************
*** 81,89 ****
  
###############################################################################
  
! 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;
      }
--- 81,113 ----
  
###############################################################################
  
! use vars qw( $appName $input_abbr );
! 
! sub construct_warn_prefix ($$) {
!     my($prefix, $lc) = @_;
!     # Construct some short but should-be-still-useful versions
!     # of this script's name and the input file's name
!     my $appName = $& if !defined $appName && $0 =~ /[^\/]+$/;
!     my $input_abbr = $& if !defined $input_abbr && $input =~ /[^\/]+$/;
!     # FIXME: The line number is not accurate, but should be "close enough"
!     # FIXME: This wording is worse than what was there, but it's wrong to
!     # FIXME: hard-code this thing in each warn statement. Need improvement.
!     return "$appName: $prefix: " . (defined $lc? "$input_abbr: line $lc: ": 
"$input_abbr: ");
! }
! 
! sub warn_normal ($$) {
!     my($msg, $lc) = @_;
!     my $prefix = construct_warn_prefix('Warning', $lc);
!     $msg .= "\n" unless $msg =~ /\n$/s;
!     warn "$prefix$msg";
! }
! 
! sub warn_pedantic ($$$) {
!     my($msg, $lc, $flag) = @_;
!     my $prefix = construct_warn_prefix("Warning$pedantic_tag", $lc);
!     $msg .= "\n" unless $msg =~ /\n$/s;
!     warn "$prefix$msg" if $pedantic_p || !$$flag;
      if (!$pedantic_p) {
!       $prefix = construct_warn_prefix("Warning$pedantic_tag", undef);
!       warn $prefix."Further similar negligible warnings will not be reported, 
use --pedantic for details\n" unless $$flag;
        $$flag = 1;
      }
***************
*** 105,110 ****
        $s = $rest;
        if ($val =~ /$re_tmpl_include/os) {
!           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) {
            # XXX: we probably should not warn if key is "onclick" etc
--- 129,133 ----
        $s = $rest;
        if ($val =~ /$re_tmpl_include/os) {
!           warn_normal "TMPL_INCLUDE in attribute: $val_orig\n", $lc;
        } elsif ($val =~ /$re_tmpl_var/os && $val !~ /$re_tmpl_var_escaped/os) {
            # XXX: we probably should not warn if key is "onclick" etc
***************
*** 112,124 ****
            my $suggest = ($key =~ 
/^(?:action|archive|background|cite|classid|codebase|data|datasrc|for|href|longdesc|profile|src|usemap)$/i?
 'URL': 'HTML');
            undef $suggest if $key =~ 
/^(?:onblur|onchange|onclick|ondblclick|onfocus|onkeydown|onkeypress|onkeyup|onload|onmousedown|onmousemove|onmouseout|onmouseover|onmouseup|onreset|onselect|onsubmit|onunload)$/i;
!           warn_pedantic \$pedantic_tmpl_var_use_in_nonpedantic_mode_p,
                    "Suggest ESCAPE=$suggest for TMPL_VAR in attribute \"$key\""
!                   . (defined $lc? " near line $lc": '') . ": $val_orig"
                if defined $suggest && ($pedantic_p || 
!$pedantic_tmpl_var_use_in_nonpedantic_mode_p);
        } elsif ($val_orig !~ /^['"]/) {
            my $t = $val; $t =~ s/$re_directive_control//os;
!           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 $t =~ /[^-\.A-Za-z0-9]/s;
        }
--- 135,149 ----
            my $suggest = ($key =~ 
/^(?:action|archive|background|cite|classid|codebase|data|datasrc|for|href|longdesc|profile|src|usemap)$/i?
 'URL': 'HTML');
            undef $suggest if $key =~ 
/^(?:onblur|onchange|onclick|ondblclick|onfocus|onkeydown|onkeypress|onkeyup|onload|onmousedown|onmousemove|onmouseout|onmouseover|onmouseup|onreset|onselect|onsubmit|onunload)$/i;
!           warn_pedantic
                    "Suggest ESCAPE=$suggest for TMPL_VAR in attribute \"$key\""
!                       . ": $val_orig",
!                   $lc, \$pedantic_tmpl_var_use_in_nonpedantic_mode_p
                if defined $suggest && ($pedantic_p || 
!$pedantic_tmpl_var_use_in_nonpedantic_mode_p);
        } elsif ($val_orig !~ /^['"]/) {
            my $t = $val; $t =~ s/$re_directive_control//os;
!           warn_pedantic
                "Unquoted attribute contains character(s) that should be quoted"
!                   . ": $val_orig",
!               $lc, \$pedantic_attribute_error_in_nonpedantic_mode_p
                if $t =~ /[^-\.A-Za-z0-9]/s;
        }
***************
*** 127,137 ****
      if ($s2 =~ /\S/s) { # should never happen
        if ($s =~ /^([^\n]*)\n/s) { # this is even worse
!           warn "Error: Completely confused while extracting attributes"
!                   . (defined $lc? " near line $lc": '') . ": $1\n";
!           warn "Error: " . (scalar split(/\n/, $s) - 1) . " more line(s) not 
shown.\n";
            $fatal_p = 1;
        } else {
!           warn "Warning: Strange attribute syntax"
!                   . (defined $lc? " near line $lc": '') . ": $s\n";
        }
      }
--- 152,162 ----
      if ($s2 =~ /\S/s) { # should never happen
        if ($s =~ /^([^\n]*)\n/s) { # this is even worse
!           my $prefix = construct_warn_prefix('Error: ', $lc);
!           warn $prefix . "Completely confused while extracting attributes"
!                   . ": $1\n";
!           warn $prefix . (scalar split(/\n/, $s) - 1) . " more line(s) not 
shown.\n";
            $fatal_p = 1;
        } else {
!           warn "Strange attribute syntax: $s\n", $lc;
        }
      }
***************
*** 159,163 ****
      } elsif ($readahead =~ /^(?:[^<]|<[<\s])+/s) {    # non-space normal text
        ($kind, $it, $readahead) = (KIND_TEXT, $&, $');
!       warn "Warning: Unescaped < near line $lc_0: $it\n"
                if !$cdata_mode_p && $it =~ /</s;
      } else {                          # tag/declaration/processing instruction
--- 184,188 ----
      } elsif ($readahead =~ /^(?:[^<]|<[<\s])+/s) {    # non-space normal text
        ($kind, $it, $readahead) = (KIND_TEXT, $&, $');
!       warn "Warning: Unescaped < $it\n", $lc_0
                if !$cdata_mode_p && $it =~ /</s;
      } else {                          # tag/declaration/processing instruction
***************
*** 175,183 ****
                ($kind, $it, $readahead) = (KIND_TAG, "$1>", $3);
                $ok_p = 1;
!               warn "Warning: SGML \"closed start tag\" notation near line 
$lc_0: $1<\n" if $2 eq '';
            } elsif ($readahead =~ /^<!--(?:(?!-->).)*-->/s) {
                ($kind, $it, $readahead) = (KIND_COMMENT, $&, $');
                $ok_p = 1;
!               warn "Warning: Syntax error in comment at line $lc_0: $&\n";
                $syntaxerror_p = 1;
            }
--- 200,208 ----
                ($kind, $it, $readahead) = (KIND_TAG, "$1>", $3);
                $ok_p = 1;
!               warn "SGML \"closed start tag\" notation: $1<\n", $lc_0 if $2 
eq '';
            } elsif ($readahead =~ /^<!--(?:(?!-->).)*-->/s) {
                ($kind, $it, $readahead) = (KIND_COMMENT, $&, $');
                $ok_p = 1;
!               warn "Syntax error in comment: $&\n", $lc_0;
                $syntaxerror_p = 1;
            }
***************
*** 205,209 ****
        }
      }
!     warn "Warning: Unrecognizable token found near line $lc_0: $it\n"
            if $kind eq KIND_UNKNOWN;
      return defined $it? (wantarray? ($kind, $it):
--- 230,234 ----
        }
      }
!     warn "Unrecognizable token found: $it\n", $lc_0
            if $kind eq KIND_UNKNOWN;
      return defined $it? (wantarray? ($kind, $it):
***************
*** 352,356 ****
  }
  
! warn "Warning: This input will not work with Mozilla standards-compliant 
mode\n"
        if $syntaxerror_p;
  
--- 377,381 ----
  }
  
! warn "This input will not work with Mozilla standards-compliant mode\n", undef
        if $syntaxerror_p;