| 
      
            Lines 32-38
          use vars qw( $charset_in $charset_out );
      
      
        Link Here
      
     | 
  
        
          | 32 | 
           | 
          32 | 
           | 
        
        
          | 33 | 
          ###############################################################################  | 
          33 | 
          ###############################################################################  | 
        
        
          | 34 | 
           | 
          34 | 
           | 
        
          
            
              | 35 | 
              sub find_translation ($) { | 
              35 | 
              sub find_translation { | 
            
        
          | 36 | 
              my($s) = @_;  | 
          36 | 
              my($s) = @_;  | 
        
        
          | 37 | 
              my $key = $s;  | 
          37 | 
              my $key = $s;  | 
        
        
          | 38 | 
              if ($s =~ /\S/s) { | 
          38 | 
              if ($s =~ /\S/s) { | 
        
  
    | 
      
            Lines 53-64
          sub find_translation ($) {
      
      
        Link Here
      
     | 
  
        
          | 53 | 
              }  | 
          53 | 
              }  | 
        
        
          | 54 | 
          }  | 
          54 | 
          }  | 
        
        
          | 55 | 
           | 
          55 | 
           | 
        
          
            
              | 56 | 
              sub text_replace_tag ($$) { | 
              56 | 
              sub text_replace_tag { | 
            
        
          | 57 | 
              my($t, $attr) = @_;  | 
          57 | 
              my($t, $attr) = @_;  | 
        
        
          | 58 | 
              my $it;  | 
          58 | 
              my $it;  | 
        
        
          | 59 | 
           | 
          59 | 
           | 
        
        
          | 60 | 
              # value [tag=input], meta  | 
          60 | 
              # value [tag=input], meta  | 
        
          
            
              | 61 | 
                  my $tag = lc($1) if $t =~ /^<(\S+)/s;  | 
              61 | 
                  my $tag = ($t =~ /^<(\S+)/s) ? lc($1) : undef;  | 
            
        
          | 62 | 
              my $translated_p = 0;  | 
          62 | 
              my $translated_p = 0;  | 
        
        
          | 63 | 
              for my $a ('alt', 'content', 'title', 'value', 'label', 'placeholder') { | 
          63 | 
              for my $a ('alt', 'content', 'title', 'value', 'label', 'placeholder') { | 
        
        
          | 64 | 
              if ($attr->{$a}) { | 
          64 | 
              if ($attr->{$a}) { | 
        
  
    | 
      
            Lines 97-106
          sub text_replace_tag ($$) {
      
      
        Link Here
      
     | 
  
        
          | 97 | 
              return $it;  | 
          97 | 
              return $it;  | 
        
        
          | 98 | 
          }  | 
          98 | 
          }  | 
        
        
          | 99 | 
           | 
          99 | 
           | 
        
          
            
              | 100 | 
              sub text_replace (**) { | 
              100 | 
              sub text_replace { | 
            
        
          | 101 | 
              my($h, $output) = @_;  | 
          101 | 
              my($h, $output) = @_;  | 
        
        
          | 102 | 
              for (;;) { | 
          102 | 
              for (;;) { | 
        
          
            
              | 103 | 
                  my $s = TmplTokenizer::next_token $h;  | 
              103 | 
                  my $s = TmplTokenizer::next_token($h);  | 
            
        
          | 104 | 
              last unless defined $s;  | 
          104 | 
              last unless defined $s;  | 
        
        
          | 105 | 
              my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);  | 
          105 | 
              my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);  | 
        
        
          | 106 | 
              if ($kind eq C4::TmplTokenType::TEXT) { | 
          106 | 
              if ($kind eq C4::TmplTokenType::TEXT) { | 
        
  
    | 
      
            Lines 118-124
          sub text_replace (**) {
      
      
        Link Here
      
     | 
  
        
          | 118 | 
                  for my $t (@{$s->js_data}) { | 
          118 | 
                  for my $t (@{$s->js_data}) { | 
        
        
          | 119 | 
                  # FIXME for this whole block  | 
          119 | 
                  # FIXME for this whole block  | 
        
        
          | 120 | 
                  if ($t->[0]) { | 
          120 | 
                  if ($t->[0]) { | 
        
          
            
              | 121 | 
                          printf $output "%s%s%s", $t->[2], find_translation $t->[3],  | 
              121 | 
                          printf $output "%s%s%s", $t->[2], find_translation($t->[3]),  | 
            
        
          | 122 | 
                          $t->[2];  | 
          122 | 
                          $t->[2];  | 
        
        
          | 123 | 
                  } else { | 
          123 | 
                  } else { | 
        
        
          | 124 | 
                      print $output $t->[1];  | 
          124 | 
                      print $output $t->[1];  | 
        
  
    | 
      
            Lines 158-171
          sub listfiles {
      
      
        Link Here
      
     | 
  
        
          | 158 | 
                      }  | 
          158 | 
                      }  | 
        
        
          | 159 | 
                  }  | 
          159 | 
                  }  | 
        
        
          | 160 | 
              } else { | 
          160 | 
              } else { | 
        
          
            
              | 161 | 
                      warn_normal "$dir: $!", undef;  | 
              161 | 
                      warn_normal("$dir: $!", undef); | 
            
        
          | 162 | 
              }  | 
          162 | 
              }  | 
        
        
          | 163 | 
              return @it;  | 
          163 | 
              return @it;  | 
        
        
          | 164 | 
          }  | 
          164 | 
          }  | 
        
        
          | 165 | 
           | 
          165 | 
           | 
        
        
          | 166 | 
          ###############################################################################  | 
          166 | 
          ###############################################################################  | 
        
        
          | 167 | 
           | 
          167 | 
           | 
        
          
            
              | 168 | 
              sub mkdir_recursive ($) { | 
              168 | 
              sub mkdir_recursive { | 
            
        
          | 169 | 
              my($dir) = @_;  | 
          169 | 
              my($dir) = @_;  | 
        
        
          | 170 | 
              local($`, $&, $', $1);  | 
          170 | 
              local($`, $&, $', $1);  | 
        
        
          | 171 | 
              $dir = $` if $dir ne /^\/+$/ && $dir =~ /\/+$/;  | 
          171 | 
              $dir = $` if $dir ne /^\/+$/ && $dir =~ /\/+$/;  | 
        
  
    | 
      
            Lines 174-186
          sub mkdir_recursive ($) {
      
      
        Link Here
      
     | 
  
        
          | 174 | 
              if (!-d $dir) { | 
          174 | 
              if (!-d $dir) { | 
        
        
          | 175 | 
              print STDERR "Making directory $dir...\n" unless $quiet;  | 
          175 | 
              print STDERR "Making directory $dir...\n" unless $quiet;  | 
        
        
          | 176 | 
              # creates with rwxrwxr-x permissions  | 
          176 | 
              # creates with rwxrwxr-x permissions  | 
        
          
            
              | 177 | 
                  mkdir($dir, 0775) || warn_normal "$dir: $!", undef;  | 
              177 | 
                  mkdir($dir, 0775) || warn_normal("$dir: $!", undef); | 
            
        
          | 178 | 
              }  | 
          178 | 
              }  | 
        
        
          | 179 | 
          }  | 
          179 | 
          }  | 
        
        
          | 180 | 
           | 
          180 | 
           | 
        
        
          | 181 | 
          ###############################################################################  | 
          181 | 
          ###############################################################################  | 
        
        
          | 182 | 
           | 
          182 | 
           | 
        
          
            
              | 183 | 
              sub usage ($) { | 
              183 | 
              sub usage { | 
            
        
          | 184 | 
              my($exitcode) = @_;  | 
          184 | 
              my($exitcode) = @_;  | 
        
        
          | 185 | 
              my $h = $exitcode? *STDERR: *STDOUT;  | 
          185 | 
              my $h = $exitcode? *STDERR: *STDOUT;  | 
        
        
          | 186 | 
              print $h <<EOF;  | 
          186 | 
              print $h <<EOF;  | 
        
  
    | 
      
            Lines 218-224
          EOF
      
      
        Link Here
      
     | 
  
        
          | 218 | 
           | 
          218 | 
           | 
        
        
          | 219 | 
          ###############################################################################  | 
          219 | 
          ###############################################################################  | 
        
        
          | 220 | 
           | 
          220 | 
           | 
        
          
            
              | 221 | 
              sub usage_error (;$) { | 
              221 | 
              sub usage_error { | 
            
        
          | 222 | 
              for my $msg (split(/\n/, $_[0])) { | 
          222 | 
              for my $msg (split(/\n/, $_[0])) { | 
        
        
          | 223 | 
              print STDERR "$msg\n";  | 
          223 | 
              print STDERR "$msg\n";  | 
        
        
          | 224 | 
              }  | 
          224 | 
              }  | 
        
  
    | 
      
            Lines 240-249
          GetOptions(
      
      
        Link Here
      
     | 
  
        
          | 240 | 
              'quiet|q'               => \$quiet,  | 
          240 | 
              'quiet|q'               => \$quiet,  | 
        
        
          | 241 | 
              'pedantic-warnings|pedantic'    => sub { $pedantic_p = 1 }, | 
          241 | 
              'pedantic-warnings|pedantic'    => sub { $pedantic_p = 1 }, | 
        
        
          | 242 | 
              'help'              => \&usage,  | 
          242 | 
              'help'              => \&usage,  | 
        
          
            
              | 243 | 
              ) || usage_error;  | 
              243 | 
              ) || usage_error();  | 
            
        
          | 244 | 
           | 
          244 | 
           | 
        
          
            
              | 245 | 
              VerboseWarnings::set_application_name $0;  | 
              245 | 
              VerboseWarnings::set_application_name($0);  | 
            
            
              | 246 | 
              VerboseWarnings::set_pedantic_mode $pedantic_p;  | 
              246 | 
              VerboseWarnings::set_pedantic_mode($pedantic_p);  | 
            
        
          | 247 | 
           | 
          247 | 
           | 
        
        
          | 248 | 
          # keep the buggy Locale::PO quiet if it says stupid things  | 
          248 | 
          # keep the buggy Locale::PO quiet if it says stupid things  | 
        
        
          | 249 | 
          $SIG{__WARN__} = sub { | 
          249 | 
          $SIG{__WARN__} = sub { | 
        
  
    | 
      
            Lines 287-293
          $href = Locale::PO->load_file_ashash($str_file);
      
      
        Link Here
      
     | 
  
        
          | 287 | 
          # guess the charsets. HTML::Templates defaults to iso-8859-1  | 
          287 | 
          # guess the charsets. HTML::Templates defaults to iso-8859-1  | 
        
        
          | 288 | 
          if (defined $href) { | 
          288 | 
          if (defined $href) { | 
        
        
          | 289 | 
              die "$str_file: PO file is corrupted, or not a PO file\n" unless defined $href->{'""'}; | 
          289 | 
              die "$str_file: PO file is corrupted, or not a PO file\n" unless defined $href->{'""'}; | 
        
          
            
              | 290 | 
                  $charset_out = TmplTokenizer::charset_canon $2 if $href->{'""'}->msgstr =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/; | 
              290 | 
                  $charset_out = TmplTokenizer::charset_canon($2) if $href->{'""'}->msgstr =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/; | 
            
        
          | 291 | 
              $charset_in = $charset_out;  | 
          291 | 
              $charset_in = $charset_out;  | 
        
        
          | 292 | 
          #     for my $msgid (keys %$href) { | 
          292 | 
          #     for my $msgid (keys %$href) { | 
        
        
          | 293 | 
          #   if ($msgid =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/) { | 
          293 | 
          #   if ($msgid =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/) { | 
        
  
    | 
      
            Lines 306-327
          if (defined $href) {
      
      
        Link Here
      
     | 
  
        
          | 306 | 
                  next if $id_count == $str_count ||  | 
          306 | 
                  next if $id_count == $str_count ||  | 
        
        
          | 307 | 
                          $msg->{msgstr} eq '""' || | 
          307 | 
                          $msg->{msgstr} eq '""' || | 
        
        
          | 308 | 
                          grep { /fuzzy/ } @{$msg->{_flags}}; | 
          308 | 
                          grep { /fuzzy/ } @{$msg->{_flags}}; | 
        
          
            
              | 309 | 
                      warn_normal  | 
              309 | 
                      warn_normal(  | 
            
        
          | 310 | 
                      "unconsistent %s count: ($id_count/$str_count):\n" .  | 
          310 | 
                      "unconsistent %s count: ($id_count/$str_count):\n" .  | 
        
        
          | 311 | 
                      "  line:   " . $msg->{loaded_line_number} . "\n" . | 
          311 | 
                      "  line:   " . $msg->{loaded_line_number} . "\n" . | 
        
        
          | 312 | 
                      "  msgid:  " . $msg->{msgid} . "\n" . | 
          312 | 
                      "  msgid:  " . $msg->{msgid} . "\n" . | 
        
          
            
              | 313 | 
                          "  msgstr: " . $msg->{msgstr} . "\n", undef; | 
              313 | 
                          "  msgstr: " . $msg->{msgstr} . "\n", undef); | 
            
        
          | 314 | 
              }  | 
          314 | 
              }  | 
        
        
          | 315 | 
          }  | 
          315 | 
          }  | 
        
        
          | 316 | 
           | 
          316 | 
           | 
        
        
          | 317 | 
          # set our charset in to UTF-8  | 
          317 | 
          # set our charset in to UTF-8  | 
        
        
          | 318 | 
          if (!defined $charset_in) { | 
          318 | 
          if (!defined $charset_in) { | 
        
          
            
              | 319 | 
                  $charset_in = TmplTokenizer::charset_canon 'UTF-8';  | 
              319 | 
                  $charset_in = TmplTokenizer::charset_canon('UTF-8'); | 
            
        
          | 320 | 
              warn "Warning: Can't determine original templates' charset, defaulting to $charset_in\n";  | 
          320 | 
              warn "Warning: Can't determine original templates' charset, defaulting to $charset_in\n";  | 
        
        
          | 321 | 
          }  | 
          321 | 
          }  | 
        
        
          | 322 | 
          # set our charset out to UTF-8  | 
          322 | 
          # set our charset out to UTF-8  | 
        
        
          | 323 | 
          if (!defined $charset_out) { | 
          323 | 
          if (!defined $charset_out) { | 
        
          
            
              | 324 | 
                  $charset_out = TmplTokenizer::charset_canon 'UTF-8';  | 
              324 | 
                  $charset_out = TmplTokenizer::charset_canon('UTF-8'); | 
            
        
          | 325 | 
              warn "Warning: Charset Out defaulting to $charset_out\n";  | 
          325 | 
              warn "Warning: Charset Out defaulting to $charset_out\n";  | 
        
        
          | 326 | 
          }  | 
          326 | 
          }  | 
        
        
          | 327 | 
          my $xgettext = './xgettext.pl'; # actual text extractor script  | 
          327 | 
          my $xgettext = './xgettext.pl'; # actual text extractor script  | 
        
  
    | 
      
            Lines 356-378
          if ($action eq 'create')  {
      
      
        Link Here
      
     | 
  
        
          | 356 | 
              # FIXME: msgmerge(1) is a Unix dependency  | 
          356 | 
              # FIXME: msgmerge(1) is a Unix dependency  | 
        
        
          | 357 | 
              # FIXME: need to check the return value  | 
          357 | 
              # FIXME: need to check the return value  | 
        
        
          | 358 | 
              unless (-f $str_file) { | 
          358 | 
              unless (-f $str_file) { | 
        
          
            
              | 359 | 
                      local(*INPUT, *OUTPUT);  | 
              359 | 
                      open(my $infh, '<', $tmpfile2);  | 
            
            
              | 360 | 
                      open(INPUT, "<$tmpfile2");  | 
              360 | 
                      open(my $outfh, '>', $str_file);  | 
            
            
              | 361 | 
                      open(OUTPUT, ">$str_file");  | 
              361 | 
                      while (<$infh>) { | 
            
            
              | 362 | 
                      while (<INPUT>) { | 
              362 | 
                      print $outfh;  | 
            
            
              | 363 | 
                      print OUTPUT;  | 
               | 
               | 
            
        
          | 364 | 
                  last if /^\n/s;  | 
          363 | 
                  last if /^\n/s;  | 
        
        
          | 365 | 
                  }  | 
          364 | 
                  }  | 
        
          
            
              | 366 | 
                      close INPUT;  | 
              365 | 
                      close $infh;  | 
            
            
              | 367 | 
                      close OUTPUT;  | 
              366 | 
                      close $outfh;  | 
            
        
          | 368 | 
              }  | 
          367 | 
              }  | 
        
        
          | 369 | 
              $st = system("msgmerge ".($quiet?'-q':'')." -s $str_file $tmpfile2 -o - | msgattrib --no-obsolete -o $str_file"); | 
          368 | 
              $st = system("msgmerge ".($quiet?'-q':'')." -s $str_file $tmpfile2 -o - | msgattrib --no-obsolete -o $str_file"); | 
        
        
          | 370 | 
              } else { | 
          369 | 
              } else { | 
        
          
            
              | 371 | 
                  error_normal "Text extraction failed: $xgettext: $!\n", undef;  | 
              370 | 
                  error_normal("Text extraction failed: $xgettext: $!\n", undef); | 
            
            
              | 372 | 
                  error_additional "Will not run msgmerge\n", undef;  | 
              371 | 
                  error_additional("Will not run msgmerge\n", undef); | 
            
        
          | 373 | 
              }  | 
          372 | 
              }  | 
        
          
            
              | 374 | 
                  unlink $tmpfile1 || warn_normal "$tmpfile1: unlink failed: $!\n", undef;  | 
              373 | 
                  unlink $tmpfile1 || warn_normal("$tmpfile1: unlink failed: $!\n", undef); | 
            
            
              | 375 | 
                  unlink $tmpfile2 || warn_normal "$tmpfile2: unlink failed: $!\n", undef;  | 
              374 | 
                  unlink $tmpfile2 || warn_normal("$tmpfile2: unlink failed: $!\n", undef); | 
            
        
          | 376 | 
           | 
          375 | 
           | 
        
        
          | 377 | 
          } elsif ($action eq 'update') { | 
          376 | 
          } elsif ($action eq 'update') { | 
        
        
          | 378 | 
              my($tmph1, $tmpfile1) = tmpnam();  | 
          377 | 
              my($tmph1, $tmpfile1) = tmpnam();  | 
        
  
    | 
      
            Lines 401-411
          if ($action eq 'create')  {
      
      
        Link Here
      
     | 
  
        
          | 401 | 
                      $st = system("msgmerge ".($quiet?'-q':'')." -s $str_file $tmpfile2 -o - | msgattrib --no-obsolete -o $str_file"); | 
          400 | 
                      $st = system("msgmerge ".($quiet?'-q':'')." -s $str_file $tmpfile2 -o - | msgattrib --no-obsolete -o $str_file"); | 
        
        
          | 402 | 
                  }  | 
          401 | 
                  }  | 
        
        
          | 403 | 
              } else { | 
          402 | 
              } else { | 
        
          
            
              | 404 | 
                      error_normal "Text extraction failed: $xgettext: $!\n", undef;  | 
              403 | 
                      error_normal("Text extraction failed: $xgettext: $!\n", undef); | 
            
            
              | 405 | 
                      error_additional "Will not run msgmerge\n", undef;  | 
              404 | 
                      error_additional("Will not run msgmerge\n", undef); | 
            
        
          | 406 | 
              }  | 
          405 | 
              }  | 
        
          
            
              | 407 | 
                  unlink $tmpfile1 || warn_normal "$tmpfile1: unlink failed: $!\n", undef;  | 
              406 | 
                  unlink $tmpfile1 || warn_normal("$tmpfile1: unlink failed: $!\n", undef); | 
            
            
              | 408 | 
                  unlink $tmpfile2 || warn_normal "$tmpfile2: unlink failed: $!\n", undef;  | 
              407 | 
                  unlink $tmpfile2 || warn_normal("$tmpfile2: unlink failed: $!\n", undef); | 
            
        
          | 409 | 
           | 
          408 | 
           | 
        
        
          | 410 | 
          } elsif ($action eq 'install') { | 
          409 | 
          } elsif ($action eq 'install') { | 
        
        
          | 411 | 
              if(!defined($out_dir)) { | 
          410 | 
              if(!defined($out_dir)) { | 
        
  
    | 
      
            Lines 428-435
          if ($action eq 'create')  {
      
      
        Link Here
      
     | 
  
        
          | 428 | 
              -d $out_dir || die "$out_dir: The directory does not exist\n";  | 
          427 | 
              -d $out_dir || die "$out_dir: The directory does not exist\n";  | 
        
        
          | 429 | 
           | 
          428 | 
           | 
        
        
          | 430 | 
              # Try to open the file, because Locale::PO doesn't check :-/  | 
          429 | 
              # Try to open the file, because Locale::PO doesn't check :-/  | 
        
          
            
              | 431 | 
                  open(INPUT, "<$str_file") || die "$str_file: $!\n";  | 
              430 | 
                  open(my $fh, '<', $str_file) || die "$str_file: $!\n";  | 
            
            
              | 432 | 
                  close INPUT;  | 
              431 | 
                  close $fh;  | 
            
        
          | 433 | 
           | 
          432 | 
           | 
        
        
          | 434 | 
              # creates the new tmpl file using the new translation  | 
          433 | 
              # creates the new tmpl file using the new translation  | 
        
        
          | 435 | 
              for my $input (@in_files) { | 
          434 | 
              for my $input (@in_files) { | 
        
  
    | 
      
            Lines 437-453
          if ($action eq 'create')  {
      
      
        Link Here
      
     | 
  
        
          | 437 | 
                      unless substr($input, 0, length($in_dir) + 1) eq "$in_dir/";  | 
          436 | 
                      unless substr($input, 0, length($in_dir) + 1) eq "$in_dir/";  | 
        
        
          | 438 | 
           | 
          437 | 
           | 
        
        
          | 439 | 
                  my $target = $out_dir . substr($input, length($in_dir));  | 
          438 | 
                  my $target = $out_dir . substr($input, length($in_dir));  | 
        
          
            
              | 440 | 
                      my $targetdir = $` if $target =~ /[^\/]+$/s;  | 
              439 | 
                      my $targetdir = ($target =~ /[^\/]+$/s) ? $` : undef;  | 
            
        
          | 441 | 
           | 
          440 | 
           | 
        
        
          | 442 | 
                  if (!defined $type || $input =~ /\.(?:$type)$/) { | 
          441 | 
                  if (!defined $type || $input =~ /\.(?:$type)$/) { | 
        
        
          | 443 | 
                      my $h = TmplTokenizer->new( $input );  | 
          442 | 
                      my $h = TmplTokenizer->new( $input );  | 
        
        
          | 444 | 
                      $h->set_allow_cformat( 1 );  | 
          443 | 
                      $h->set_allow_cformat( 1 );  | 
        
          
            
              | 445 | 
                          VerboseWarnings::set_input_file_name $input;  | 
              444 | 
                          VerboseWarnings::set_input_file_name($input);  | 
            
        
          | 446 | 
                      mkdir_recursive($targetdir) unless -d $targetdir;  | 
          445 | 
                      mkdir_recursive($targetdir) unless -d $targetdir;  | 
        
        
          | 447 | 
                      print STDERR "Creating $target...\n" unless $quiet;  | 
          446 | 
                      print STDERR "Creating $target...\n" unless $quiet;  | 
        
          
            
              | 448 | 
                          open( OUTPUT, ">$target" ) || die "$target: $!\n";  | 
              447 | 
                          open( my $fh, '>', $target ) || die "$target: $!\n";  | 
            
            
              | 449 | 
                          text_replace( $h, *OUTPUT );  | 
              448 | 
                          text_replace( $h, $fh );  | 
            
            
              | 450 | 
                          close OUTPUT;  | 
              449 | 
                          close $fh;  | 
            
        
          | 451 | 
                  } else { | 
          450 | 
                  } else { | 
        
        
          | 452 | 
                  # just copying the file  | 
          451 | 
                  # just copying the file  | 
        
        
          | 453 | 
                      mkdir_recursive($targetdir) unless -d $targetdir;  | 
          452 | 
                      mkdir_recursive($targetdir) unless -d $targetdir;  |