scripts/migrate_template_to_t8.pl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Pod::Usage;
   5 use List::Util qw(reduce);
   6 use List::MoreUtils qw(zip);
   7
   8 use constant DEBUG => 0;
   9
  10 unless ( caller(0) ) {
  11   pod2usage(2) unless @ARGV;
  12   migrate_file(@ARGV);
  13 };
  14
  15 sub migrate_file {
  16   my $file = shift or return;
  17
  18   my $contents = do { local( @ARGV, $/ ) = $file ; <> }
  19     or die "cannot read file";
  20
  21   my %substitutions = (
  22     "<translate>"  => "[% '",
  23     "</translate>" => "' | \$T8 %]",
  24   );
  25
  26   my $last_match = '';
  27   my $num_matches;
  28   my $in_template;
  29   my $inline_counter = 0;
  30
  31   # now replace <translate> with [% '
  32   # and </translate> with ' | $T8 %]
  33   while ($contents =~ m# ( < /? translate> | \[% | %\] ) #xg) {
  34     my $match  = $1;
  35     my $pos    = pos $contents;
  36
  37     if ($match eq '[%') {
  38       $in_template = 1;
  39       DEBUG && warn "entering [% block %] at pos $pos";
  40       next;
  41     }
  42     if ($match eq '%]') {
  43       $in_template = 0;
  44       DEBUG && warn "leaving [% block %] at pos $pos";
  45       next;
  46     }
  47
  48     if ($in_template) {
  49       $inline_counter++ if $match eq '<translate>';
  50       next;
  51     }
  52
  53     DEBUG && warn "found token $match at pos $pos";
  54
  55     my $sub_by = $substitutions{$match};
  56
  57     unless ($sub_by) {
  58       DEBUG && warn "found token $& but got no substitute";
  59       next;
  60     }
  61
  62     die "unbalanced tokens - two times '$match' in file $file"
  63       if $last_match eq $match;
  64
  65     $last_match = $match;
  66     $num_matches++;
  67
  68     # alter string. substr is faster than s/// for strings of this size.
  69     substr $contents, $-[0], $+[0] - $-[0], $sub_by;
  70
  71     # set match pos for m//g matching on the altered string.
  72     pos $contents = $-[0] + length $sub_by;
  73   }
  74
  75   warn "found $inline_counter occurances of inline translates in file $file $/"
  76     if $inline_counter;
  77
  78   exit 0 unless $num_matches;
  79
  80   die "unbalanced tokens in file $file" if $num_matches % 2;
  81
  82   if ($contents !~ m/\[%-? USE T8 %\]/) {
  83     $contents = "[%- USE T8 %]$/" . $contents;
  84   }
  85
  86   # all fine? spew back
  87
  88   do {
  89     open my $fh, ">$file" or die "can't write $file $!";
  90     print $fh $contents;
  91   };
  92 }
  93
  94 1;
  95
  96 __END__
  97
  98 =head1 NAME
  99
 100 migrate_template_to_t8.pl - helper script to migrate templates to T8 module
 101
 102 =head1 SYNOPSIS
 103
 104   # single:
 105   scripts/migrate_template_to_t8.pl <file>
 106
 107   # bash:
 108   for file in `find templates | grep master\.html`;
 109     do scripts/migrate_template_to_t8.pl $file;
 110   done;
 111
 112   # as a lib:
 113   require "scripts/migrate_template_to_t8.pl";
 114   migrate_file($file);
 115
 116 =head1 DESCRIPTION
 117
 118 This script will do the following actions in a template file
 119
 120 =over 8
 121
 122 =item 1.
 123
 124 Change every occurance of C<<< <translate>Text</translate> >>> to C<<< [%
 125 'Text' | $T8 %] >>>
 126
 127 =item 2.
 128
 129 Add [%- USE T8 %] at the top if something needs to be translated
 130
 131 =back
 132
 133 Note! This script is written to help with the process of migrating old
 134 templates. It is assumed that anyone working on Lx-Office is working with a
 135 version control system. This script will change your files. You have been
 136 warned.
 137
 138 Due to the nature of the previous locale system, it is not easily possible to
 139 migrate translates in other template blocks. As of this writing this is used in
 140 about 20 occurances throughout the code. If such a construct is found, a
 141 warning will be generated. lib uses of this will have to trap the warning.
 142
 143 =head1 DIAGNOSIS
 144
 145 =head2 found I<NUM> occurances of inline translates in file I<FILE>
 146
 147 If a processed file has <translate> blocks in template blocks, these will be
 148 ignored.  This warning is thrown at the end of processing.
 149
 150 =head2 unbalanced tokens in file I<FILE>
 151
 152 The script could not resolve pairs of <translate> </translate>s. The file will
 153 not be changed in this case.
 154
 155 =head1 AUTHOR
 156
 157 Sven Schoeling E<lt>s.schoeling@linet-services.deE<gt>
 158
 159 =cut