| 
      
            Lines 35-41
          use vars qw( $charset_in $charset_out );
      
      
        Link Here
      
     | 
  
        
          | 35 | 
           | 
          35 | 
           | 
        
        
          | 36 | 
          ###############################################################################  | 
          36 | 
          ###############################################################################  | 
        
        
          | 37 | 
           | 
          37 | 
           | 
        
          
            
              | 38 | 
              sub find_translation ($) { | 
              38 | 
              sub find_translation { | 
            
        
          | 39 | 
              my($s) = @_;  | 
          39 | 
              my($s) = @_;  | 
        
        
          | 40 | 
              my $key = $s;  | 
          40 | 
              my $key = $s;  | 
        
        
          | 41 | 
              if ($s =~ /\S/s) { | 
          41 | 
              if ($s =~ /\S/s) { | 
        
  
    | 
      
            Lines 56-68
          sub find_translation ($) {
      
      
        Link Here
      
     | 
  
        
          | 56 | 
              }  | 
          56 | 
              }  | 
        
        
          | 57 | 
          }  | 
          57 | 
          }  | 
        
        
          | 58 | 
           | 
          58 | 
           | 
        
          
            
              | 59 | 
              sub text_replace_tag ($$) { | 
              59 | 
              sub text_replace_tag { | 
            
        
          | 60 | 
              my($t, $attr) = @_;  | 
          60 | 
              my($t, $attr) = @_;  | 
        
        
          | 61 | 
              my $it;  | 
          61 | 
              my $it;  | 
        
        
          | 62 | 
              my @ttvar;  | 
          62 | 
              my @ttvar;  | 
        
        
          | 63 | 
           | 
          63 | 
           | 
        
        
          | 64 | 
              # value [tag=input], meta  | 
          64 | 
              # value [tag=input], meta  | 
        
          
            
              | 65 | 
                  my $tag = lc($1) if $t =~ /^<(\S+)/s;  | 
              65 | 
                  my $tag = ($t =~ /^<(\S+)/s) ? lc($1) : undef;  | 
            
        
          | 66 | 
              my $translated_p = 0;  | 
          66 | 
              my $translated_p = 0;  | 
        
        
          | 67 | 
              for my $a ('alt', 'content', 'title', 'value', 'label', 'placeholder') { | 
          67 | 
              for my $a ('alt', 'content', 'title', 'value', 'label', 'placeholder') { | 
        
        
          | 68 | 
              if ($attr->{$a}) { | 
          68 | 
              if ($attr->{$a}) { | 
        
  
    | 
      
            Lines 117-126
          sub text_replace_tag ($$) {
      
      
        Link Here
      
     | 
  
        
          | 117 | 
              return $it;  | 
          117 | 
              return $it;  | 
        
        
          | 118 | 
          }  | 
          118 | 
          }  | 
        
        
          | 119 | 
           | 
          119 | 
           | 
        
          
            
              | 120 | 
              sub text_replace (**) { | 
              120 | 
              sub text_replace { | 
            
        
          | 121 | 
              my($h, $output) = @_;  | 
          121 | 
              my($h, $output) = @_;  | 
        
        
          | 122 | 
              for (;;) { | 
          122 | 
              for (;;) { | 
        
          
            
              | 123 | 
                  my $s = TmplTokenizer::next_token $h;  | 
              123 | 
                  my $s = TmplTokenizer::next_token($h);  | 
            
        
          | 124 | 
              last unless defined $s;  | 
          124 | 
              last unless defined $s;  | 
        
        
          | 125 | 
              my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);  | 
          125 | 
              my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);  | 
        
        
          | 126 | 
              if ($kind eq C4::TmplTokenType::TEXT) { | 
          126 | 
              if ($kind eq C4::TmplTokenType::TEXT) { | 
        
  
    | 
      
            Lines 138-144
          sub text_replace (**) {
      
      
        Link Here
      
     | 
  
        
          | 138 | 
                  for my $t (@{$s->js_data}) { | 
          138 | 
                  for my $t (@{$s->js_data}) { | 
        
        
          | 139 | 
                  # FIXME for this whole block  | 
          139 | 
                  # FIXME for this whole block  | 
        
        
          | 140 | 
                  if ($t->[0]) { | 
          140 | 
                  if ($t->[0]) { | 
        
          
            
              | 141 | 
                          printf $output "%s%s%s", $t->[2], find_translation $t->[3],  | 
              141 | 
                          printf $output "%s%s%s", $t->[2], find_translation($t->[3]),  | 
            
        
          | 142 | 
                          $t->[2];  | 
          142 | 
                          $t->[2];  | 
        
        
          | 143 | 
                  } else { | 
          143 | 
                  } else { | 
        
        
          | 144 | 
                      print $output $t->[1];  | 
          144 | 
                      print $output $t->[1];  | 
        
  
    | 
      
            Lines 178-191
          sub listfiles {
      
      
        Link Here
      
     | 
  
        
          | 178 | 
                      }  | 
          178 | 
                      }  | 
        
        
          | 179 | 
                  }  | 
          179 | 
                  }  | 
        
        
          | 180 | 
              } else { | 
          180 | 
              } else { | 
        
          
            
              | 181 | 
                      warn_normal "$dir: $!", undef;  | 
              181 | 
                      warn_normal("$dir: $!", undef); | 
            
        
          | 182 | 
              }  | 
          182 | 
              }  | 
        
        
          | 183 | 
              return @it;  | 
          183 | 
              return @it;  | 
        
        
          | 184 | 
          }  | 
          184 | 
          }  | 
        
        
          | 185 | 
           | 
          185 | 
           | 
        
        
          | 186 | 
          ###############################################################################  | 
          186 | 
          ###############################################################################  | 
        
        
          | 187 | 
           | 
          187 | 
           | 
        
          
            
              | 188 | 
              sub mkdir_recursive ($) { | 
              188 | 
              sub mkdir_recursive { | 
            
        
          | 189 | 
              my($dir) = @_;  | 
          189 | 
              my($dir) = @_;  | 
        
        
          | 190 | 
              local($`, $&, $', $1);  | 
          190 | 
              local($`, $&, $', $1);  | 
        
        
          | 191 | 
              $dir = $` if $dir ne /^\/+$/ && $dir =~ /\/+$/;  | 
          191 | 
              $dir = $` if $dir ne /^\/+$/ && $dir =~ /\/+$/;  | 
        
  
    | 
      
            Lines 194-206
          sub mkdir_recursive ($) {
      
      
        Link Here
      
     | 
  
        
          | 194 | 
              if (!-d $dir) { | 
          194 | 
              if (!-d $dir) { | 
        
        
          | 195 | 
              print STDERR "Making directory $dir...\n" unless $quiet;  | 
          195 | 
              print STDERR "Making directory $dir...\n" unless $quiet;  | 
        
        
          | 196 | 
              # creates with rwxrwxr-x permissions  | 
          196 | 
              # creates with rwxrwxr-x permissions  | 
        
          
            
              | 197 | 
                  mkdir($dir, 0775) || warn_normal "$dir: $!", undef;  | 
              197 | 
                  mkdir($dir, 0775) || warn_normal("$dir: $!", undef); | 
            
        
          | 198 | 
              }  | 
          198 | 
              }  | 
        
        
          | 199 | 
          }  | 
          199 | 
          }  | 
        
        
          | 200 | 
           | 
          200 | 
           | 
        
        
          | 201 | 
          ###############################################################################  | 
          201 | 
          ###############################################################################  | 
        
        
          | 202 | 
           | 
          202 | 
           | 
        
          
            
              | 203 | 
              sub usage ($) { | 
              203 | 
              sub usage { | 
            
        
          | 204 | 
              my($exitcode) = @_;  | 
          204 | 
              my($exitcode) = @_;  | 
        
        
          | 205 | 
              my $h = $exitcode? *STDERR: *STDOUT;  | 
          205 | 
              my $h = $exitcode? *STDERR: *STDOUT;  | 
        
        
          | 206 | 
              print $h <<EOF;  | 
          206 | 
              print $h <<EOF;  | 
        
  
    | 
      
            Lines 238-244
          EOF
      
      
        Link Here
      
     | 
  
        
          | 238 | 
           | 
          238 | 
           | 
        
        
          | 239 | 
          ###############################################################################  | 
          239 | 
          ###############################################################################  | 
        
        
          | 240 | 
           | 
          240 | 
           | 
        
          
            
              | 241 | 
              sub usage_error (;$) { | 
              241 | 
              sub usage_error { | 
            
        
          | 242 | 
              for my $msg (split(/\n/, $_[0])) { | 
          242 | 
              for my $msg (split(/\n/, $_[0])) { | 
        
        
          | 243 | 
              print STDERR "$msg\n";  | 
          243 | 
              print STDERR "$msg\n";  | 
        
        
          | 244 | 
              }  | 
          244 | 
              }  | 
        
  
    | 
      
            Lines 260-269
          GetOptions(
      
      
        Link Here
      
     | 
  
        
          | 260 | 
              'quiet|q'               => \$quiet,  | 
          260 | 
              'quiet|q'               => \$quiet,  | 
        
        
          | 261 | 
              'pedantic-warnings|pedantic'    => sub { $pedantic_p = 1 }, | 
          261 | 
              'pedantic-warnings|pedantic'    => sub { $pedantic_p = 1 }, | 
        
        
          | 262 | 
              'help'              => \&usage,  | 
          262 | 
              'help'              => \&usage,  | 
        
          
            
              | 263 | 
              ) || usage_error;  | 
              263 | 
              ) || usage_error();  | 
            
        
          | 264 | 
           | 
          264 | 
           | 
        
          
            
              | 265 | 
              VerboseWarnings::set_application_name $0;  | 
              265 | 
              VerboseWarnings::set_application_name($0);  | 
            
            
              | 266 | 
              VerboseWarnings::set_pedantic_mode $pedantic_p;  | 
              266 | 
              VerboseWarnings::set_pedantic_mode($pedantic_p);  | 
            
        
          | 267 | 
           | 
          267 | 
           | 
        
        
          | 268 | 
          # keep the buggy Locale::PO quiet if it says stupid things  | 
          268 | 
          # keep the buggy Locale::PO quiet if it says stupid things  | 
        
        
          | 269 | 
          $SIG{__WARN__} = sub { | 
          269 | 
          $SIG{__WARN__} = sub { | 
        
  
    | 
      
            Lines 307-313
          $href = Locale::PO->load_file_ashash($str_file);
      
      
        Link Here
      
     | 
  
        
          | 307 | 
          # guess the charsets. HTML::Templates defaults to iso-8859-1  | 
          307 | 
          # guess the charsets. HTML::Templates defaults to iso-8859-1  | 
        
        
          | 308 | 
          if (defined $href) { | 
          308 | 
          if (defined $href) { | 
        
        
          | 309 | 
              die "$str_file: PO file is corrupted, or not a PO file\n" unless defined $href->{'""'}; | 
          309 | 
              die "$str_file: PO file is corrupted, or not a PO file\n" unless defined $href->{'""'}; | 
        
          
            
              | 310 | 
                  $charset_out = TmplTokenizer::charset_canon $2 if $href->{'""'}->msgstr =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/; | 
              310 | 
                  $charset_out = TmplTokenizer::charset_canon($2) if $href->{'""'}->msgstr =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/; | 
            
        
          | 311 | 
              $charset_in = $charset_out;  | 
          311 | 
              $charset_in = $charset_out;  | 
        
        
          | 312 | 
          #     for my $msgid (keys %$href) { | 
          312 | 
          #     for my $msgid (keys %$href) { | 
        
        
          | 313 | 
          #   if ($msgid =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/) { | 
          313 | 
          #   if ($msgid =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/) { | 
        
  
    | 
      
            Lines 326-347
          if (defined $href) {
      
      
        Link Here
      
     | 
  
        
          | 326 | 
                  next if $id_count == $str_count ||  | 
          326 | 
                  next if $id_count == $str_count ||  | 
        
        
          | 327 | 
                          $msg->{msgstr} eq '""' || | 
          327 | 
                          $msg->{msgstr} eq '""' || | 
        
        
          | 328 | 
                          grep { /fuzzy/ } @{$msg->{_flags}}; | 
          328 | 
                          grep { /fuzzy/ } @{$msg->{_flags}}; | 
        
          
            
              | 329 | 
                      warn_normal  | 
              329 | 
                      warn_normal(  | 
            
        
          | 330 | 
                      "unconsistent %s count: ($id_count/$str_count):\n" .  | 
          330 | 
                      "unconsistent %s count: ($id_count/$str_count):\n" .  | 
        
        
          | 331 | 
                      "  line:   " . $msg->{loaded_line_number} . "\n" . | 
          331 | 
                      "  line:   " . $msg->{loaded_line_number} . "\n" . | 
        
        
          | 332 | 
                      "  msgid:  " . $msg->{msgid} . "\n" . | 
          332 | 
                      "  msgid:  " . $msg->{msgid} . "\n" . | 
        
          
            
              | 333 | 
                          "  msgstr: " . $msg->{msgstr} . "\n", undef; | 
              333 | 
                          "  msgstr: " . $msg->{msgstr} . "\n", undef); | 
            
        
          | 334 | 
              }  | 
          334 | 
              }  | 
        
        
          | 335 | 
          }  | 
          335 | 
          }  | 
        
        
          | 336 | 
           | 
          336 | 
           | 
        
        
          | 337 | 
          # set our charset in to UTF-8  | 
          337 | 
          # set our charset in to UTF-8  | 
        
        
          | 338 | 
          if (!defined $charset_in) { | 
          338 | 
          if (!defined $charset_in) { | 
        
          
            
              | 339 | 
                  $charset_in = TmplTokenizer::charset_canon 'UTF-8';  | 
              339 | 
                  $charset_in = TmplTokenizer::charset_canon('UTF-8'); | 
            
        
          | 340 | 
              warn "Warning: Can't determine original templates' charset, defaulting to $charset_in\n" unless ( $quiet );  | 
          340 | 
              warn "Warning: Can't determine original templates' charset, defaulting to $charset_in\n" unless ( $quiet );  | 
        
        
          | 341 | 
          }  | 
          341 | 
          }  | 
        
        
          | 342 | 
          # set our charset out to UTF-8  | 
          342 | 
          # set our charset out to UTF-8  | 
        
        
          | 343 | 
          if (!defined $charset_out) { | 
          343 | 
          if (!defined $charset_out) { | 
        
          
            
              | 344 | 
                  $charset_out = TmplTokenizer::charset_canon 'UTF-8';  | 
              344 | 
                  $charset_out = TmplTokenizer::charset_canon('UTF-8'); | 
            
        
          | 345 | 
              warn "Warning: Charset Out defaulting to $charset_out\n" unless ( $quiet );  | 
          345 | 
              warn "Warning: Charset Out defaulting to $charset_out\n" unless ( $quiet );  | 
        
        
          | 346 | 
          }  | 
          346 | 
          }  | 
        
        
          | 347 | 
          my $xgettext = './xgettext.pl'; # actual text extractor script  | 
          347 | 
          my $xgettext = './xgettext.pl'; # actual text extractor script  | 
        
  
    | 
      
            Lines 376-398
          if ($action eq 'create')  {
      
      
        Link Here
      
     | 
  
        
          | 376 | 
              # FIXME: msgmerge(1) is a Unix dependency  | 
          376 | 
              # FIXME: msgmerge(1) is a Unix dependency  | 
        
        
          | 377 | 
              # FIXME: need to check the return value  | 
          377 | 
              # FIXME: need to check the return value  | 
        
        
          | 378 | 
              unless (-f $str_file) { | 
          378 | 
              unless (-f $str_file) { | 
        
          
            
              | 379 | 
                      local(*INPUT, *OUTPUT);  | 
              379 | 
                      open(my $infh, '<', $tmpfile2);  | 
            
            
              | 380 | 
                      open(INPUT, "<$tmpfile2");  | 
              380 | 
                      open(my $outfh, '>', $str_file);  | 
            
            
              | 381 | 
                      open(OUTPUT, ">$str_file");  | 
              381 | 
                      while (<$infh>) { | 
            
            
              | 382 | 
                      while (<INPUT>) { | 
              382 | 
                      print $outfh;  | 
            
            
              | 383 | 
                      print OUTPUT;  | 
               | 
               | 
            
        
          | 384 | 
                  last if /^\n/s;  | 
          383 | 
                  last if /^\n/s;  | 
        
        
          | 385 | 
                  }  | 
          384 | 
                  }  | 
        
          
            
              | 386 | 
                      close INPUT;  | 
              385 | 
                      close $infh;  | 
            
            
              | 387 | 
                      close OUTPUT;  | 
              386 | 
                      close $outfh;  | 
            
        
          | 388 | 
              }  | 
          387 | 
              }  | 
        
        
          | 389 | 
              $st = system("msgmerge ".($quiet?'-q':'')." -s $str_file $tmpfile2 -o - | msgattrib --no-obsolete -o $str_file"); | 
          388 | 
              $st = system("msgmerge ".($quiet?'-q':'')." -s $str_file $tmpfile2 -o - | msgattrib --no-obsolete -o $str_file"); | 
        
        
          | 390 | 
              } else { | 
          389 | 
              } else { | 
        
          
            
              | 391 | 
                  error_normal "Text extraction failed: $xgettext: $!\n", undef;  | 
              390 | 
                  error_normal("Text extraction failed: $xgettext: $!\n", undef); | 
            
            
              | 392 | 
                  error_additional "Will not run msgmerge\n", undef;  | 
              391 | 
                  error_additional("Will not run msgmerge\n", undef); | 
            
        
          | 393 | 
              }  | 
          392 | 
              }  | 
        
          
            
              | 394 | 
                  unlink $tmpfile1 || warn_normal "$tmpfile1: unlink failed: $!\n", undef;  | 
              393 | 
                  unlink $tmpfile1 || warn_normal("$tmpfile1: unlink failed: $!\n", undef); | 
            
            
              | 395 | 
                  unlink $tmpfile2 || warn_normal "$tmpfile2: unlink failed: $!\n", undef;  | 
              394 | 
                  unlink $tmpfile2 || warn_normal("$tmpfile2: unlink failed: $!\n", undef); | 
            
        
          | 396 | 
           | 
          395 | 
           | 
        
        
          | 397 | 
          } elsif ($action eq 'update') { | 
          396 | 
          } elsif ($action eq 'update') { | 
        
        
          | 398 | 
              my($tmph1, $tmpfile1) = tmpnam();  | 
          397 | 
              my($tmph1, $tmpfile1) = tmpnam();  | 
        
  
    | 
      
            Lines 421-431
          if ($action eq 'create')  {
      
      
        Link Here
      
     | 
  
        
          | 421 | 
                      $st = system("msgmerge ".($quiet?'-q':'')." -s $str_file $tmpfile2 -o - | msgattrib --no-obsolete -o $str_file"); | 
          420 | 
                      $st = system("msgmerge ".($quiet?'-q':'')." -s $str_file $tmpfile2 -o - | msgattrib --no-obsolete -o $str_file"); | 
        
        
          | 422 | 
                  }  | 
          421 | 
                  }  | 
        
        
          | 423 | 
              } else { | 
          422 | 
              } else { | 
        
          
            
              | 424 | 
                      error_normal "Text extraction failed: $xgettext: $!\n", undef;  | 
              423 | 
                      error_normal("Text extraction failed: $xgettext: $!\n", undef); | 
            
            
              | 425 | 
                      error_additional "Will not run msgmerge\n", undef;  | 
              424 | 
                      error_additional("Will not run msgmerge\n", undef); | 
            
        
          | 426 | 
              }  | 
          425 | 
              }  | 
        
          
            
              | 427 | 
                  unlink $tmpfile1 || warn_normal "$tmpfile1: unlink failed: $!\n", undef;  | 
              426 | 
                  unlink $tmpfile1 || warn_normal("$tmpfile1: unlink failed: $!\n", undef); | 
            
            
              | 428 | 
                  unlink $tmpfile2 || warn_normal "$tmpfile2: unlink failed: $!\n", undef;  | 
              427 | 
                  unlink $tmpfile2 || warn_normal("$tmpfile2: unlink failed: $!\n", undef); | 
            
        
          | 429 | 
           | 
          428 | 
           | 
        
        
          | 430 | 
          } elsif ($action eq 'install') { | 
          429 | 
          } elsif ($action eq 'install') { | 
        
        
          | 431 | 
              if(!defined($out_dir)) { | 
          430 | 
              if(!defined($out_dir)) { | 
        
  
    | 
      
            Lines 448-455
          if ($action eq 'create')  {
      
      
        Link Here
      
     | 
  
        
          | 448 | 
              -d $out_dir || die "$out_dir: The directory does not exist\n";  | 
          447 | 
              -d $out_dir || die "$out_dir: The directory does not exist\n";  | 
        
        
          | 449 | 
           | 
          448 | 
           | 
        
        
          | 450 | 
              # Try to open the file, because Locale::PO doesn't check :-/  | 
          449 | 
              # Try to open the file, because Locale::PO doesn't check :-/  | 
        
          
            
              | 451 | 
                  open(INPUT, "<$str_file") || die "$str_file: $!\n";  | 
              450 | 
                  open(my $fh, '<', $str_file) || die "$str_file: $!\n";  | 
            
            
              | 452 | 
                  close INPUT;  | 
              451 | 
                  close $fh;  | 
            
        
          | 453 | 
           | 
          452 | 
           | 
        
        
          | 454 | 
              # creates the new tmpl file using the new translation  | 
          453 | 
              # creates the new tmpl file using the new translation  | 
        
        
          | 455 | 
              for my $input (@in_files) { | 
          454 | 
              for my $input (@in_files) { | 
        
  
    | 
      
            Lines 457-473
          if ($action eq 'create')  {
      
      
        Link Here
      
     | 
  
        
          | 457 | 
                      unless substr($input, 0, length($in_dir) + 1) eq "$in_dir/";  | 
          456 | 
                      unless substr($input, 0, length($in_dir) + 1) eq "$in_dir/";  | 
        
        
          | 458 | 
           | 
          457 | 
           | 
        
        
          | 459 | 
                  my $target = $out_dir . substr($input, length($in_dir));  | 
          458 | 
                  my $target = $out_dir . substr($input, length($in_dir));  | 
        
          
            
              | 460 | 
                      my $targetdir = $` if $target =~ /[^\/]+$/s;  | 
              459 | 
                      my $targetdir = ($target =~ /[^\/]+$/s) ? $` : undef;  | 
            
        
          | 461 | 
           | 
          460 | 
           | 
        
        
          | 462 | 
                  if (!defined $type || $input =~ /\.(?:$type)$/) { | 
          461 | 
                  if (!defined $type || $input =~ /\.(?:$type)$/) { | 
        
        
          | 463 | 
                      my $h = TmplTokenizer->new( $input );  | 
          462 | 
                      my $h = TmplTokenizer->new( $input );  | 
        
        
          | 464 | 
                      $h->set_allow_cformat( 1 );  | 
          463 | 
                      $h->set_allow_cformat( 1 );  | 
        
          
            
              | 465 | 
                          VerboseWarnings::set_input_file_name $input;  | 
              464 | 
                          VerboseWarnings::set_input_file_name($input);  | 
            
        
          | 466 | 
                      mkdir_recursive($targetdir) unless -d $targetdir;  | 
          465 | 
                      mkdir_recursive($targetdir) unless -d $targetdir;  | 
        
        
          | 467 | 
                      print STDERR "Creating $target...\n" unless $quiet;  | 
          466 | 
                      print STDERR "Creating $target...\n" unless $quiet;  | 
        
          
            
              | 468 | 
                          open( OUTPUT, ">$target" ) || die "$target: $!\n";  | 
              467 | 
                          open( my $fh, '>', $target ) || die "$target: $!\n";  | 
            
            
              | 469 | 
                          text_replace( $h, *OUTPUT );  | 
              468 | 
                          text_replace( $h, $fh );  | 
            
            
              | 470 | 
                          close OUTPUT;  | 
              469 | 
                          close $fh;  | 
            
        
          | 471 | 
                  } else { | 
          470 | 
                  } else { | 
        
        
          | 472 | 
                  # just copying the file  | 
          471 | 
                  # just copying the file  | 
        
        
          | 473 | 
                      mkdir_recursive($targetdir) unless -d $targetdir;  | 
          472 | 
                      mkdir_recursive($targetdir) unless -d $targetdir;  |