projekt kivitendo

#!/usr/bin/perl -w

use strict;

use Pod::Usage;

use List::Util qw(reduce);

use List::MoreUtils qw(zip);

use constant DEBUG => 0;

unless ( caller(0) ) {

  pod2usage(2) unless @ARGV;

  migrate_file(@ARGV);

};

sub migrate_file {

  my $file = shift or return;

  my $contents = do { local( @ARGV, $/ ) = $file ; <> }

    or die "cannot read file";

  my %substitutions = (

    "<translate>"  => "[% '",

    "</translate>" => "' | \$T8 %]",

  );

  my $last_match = '';

  my $num_matches;

  my $in_template;

  my $inline_counter = 0;

  # now replace <translate> with [% '

  # and </translate> with ' | $T8 %]

  while ($contents =~ m# ( < /? translate> | \[% | %\] ) #xg) {

    my $match  = $1;

    my $pos    = pos $contents;

    if ($match eq '[%') {

      $in_template = 1;

      DEBUG && warn "entering [% block %] at pos $pos";

      next;

    }

    if ($match eq '%]') {

      $in_template = 0;

      DEBUG && warn "leaving [% block %] at pos $pos";

      next;

    }

    if ($in_template) {

      $inline_counter++ if $match eq '<translate>';

      next;

    }

    DEBUG && warn "found token $match at pos $pos";

    my $sub_by = $substitutions{$match};

    unless ($sub_by) {

      DEBUG && warn "found token $& but got no substitute";

      next;

    }

    die "unbalanced tokens - two times '$match' in file $file"

      if $last_match eq $match;

    $last_match = $match;

    $num_matches++;

    # alter string. substr is faster than s/// for strings of this size.

    substr $contents, $-[0], $+[0] - $-[0], $sub_by;

    # set match pos for m//g matching on the altered string.

    pos $contents = $-[0] + length $sub_by;

  }

  warn "found $inline_counter occurances of inline translates in file $file $/"

    if $inline_counter;

  exit 0 unless $num_matches;

  die "unbalanced tokens in file $file" if $num_matches % 2;

  if ($contents !~ m/\[%-? USE T8 %\]/) {

    $contents = "[%- USE T8 %]$/" . $contents;

  }

  # all fine? spew back

  do {

    open my $fh, ">$file" or die "can't write $file $!";

    print $fh $contents;

  };

}

1;

__END__

=head1 NAME

migrate_template_to_t8.pl - helper script to migrate templates to T8 module

=head1 SYNOPSIS

  # single:

  scripts/migrate_template_to_t8.pl <file>

  # bash:

  for file in `find templates | grep master\.html`;

    do scripts/migrate_template_to_t8.pl $file;

  done;

  # as a lib:

  require "scripts/migrate_template_to_t8.pl";

  migrate_file($file);

=head1 DESCRIPTION

This script will do the following actions in a template file

=over 8

=item 1.

Change every occurance of C<<< <translate>Text</translate> >>> to C<<< [%

'Text' | $T8 %] >>>

=item 2.

Add [%- USE T8 %] at the top if something needs to be translated

=back

Note! This script is written to help with the process of migrating old

templates. It is assumed that anyone working on Lx-Office is working with a

version control system. This script will change your files. You have been

warned.

Due to the nature of the previous locale system, it is not easily possible to

migrate translates in other template blocks. As of this writing this is used in

about 20 occurances throughout the code. If such a construct is found, a

warning will be generated. lib uses of this will have to trap the warning.

=head1 DIAGNOSIS

=head2 found I<NUM> occurances of inline translates in file I<FILE>

If a processed file has <translate> blocks in template blocks, these will be

ignored.  This warning is thrown at the end of processing.

=head2 unbalanced tokens in file I<FILE>

The script could not resolve pairs of <translate> </translate>s. The file will

not be changed in this case.

=head1 AUTHOR

Sven Schoeling E<lt>s.schoeling@linet-services.deE<gt>

=cut