#!/usr/bin/perl
# -----------------------------------------------------------------------------
# TWC
# Treuwert-Computer GmbH
# Schloßbergring 9
# 79098 Freiburg
#
# -----------------------------------------------------------------------------
# Programm-Daten
# -----------------------------------------------------------------------------
# Projekt  : Tools
# System   : Linux
# Programm : ImportInDB.pl
# Modul    : $RCSfile: CreatePoFiles.pl,v $
# Version  : $Revision: 1.6 $
# Stand von: $Date: 2001/01/25 12:49:24 $
# Status   : $State: Exp $
#
# Description:
# Translate perl messages
#
# -----------------------------------------------------------------------------
# -----------------------------------------------------------------------------
# $Log: CreatePoFiles.pl,v $
# Revision 1.6  2001/01/25 12:49:24  k_reger
# - scan date-format-fields also
#
# Revision 1.5  2000/10/12 13:39:08  k_reger
# - remove po-files with length 0
# - split records in the .*\,-*-format
#
# Revision 1.4  2000/09/21 07:27:07  k_reger
# - little Comments
#
# Revision 1.3  2000/03/30 13:51:25  klaus
# Checkpoint before Release 0.0.7
#
# Revision 1.2  2000/03/24 11:04:03  klaus
# Checkpoint
#
# Revision 1.1  2000/02/24 11:27:45  klaus
# - Internationalization
# - New OO-Classes
#
# Revision 1.1  2000/02/02 21:38:56  klaus
# Preparing WWWdb for 0.0.6
#
#
# -----------------------------------------------------------------------------

use vars qw($opt_D $opt_d $opt_V $opt_l $opt_p %hMessagesGL);

use Text::DelimMatch;
use Getopt::Std;
use File::Basename;

use strict;

my %hMessagesGL = ();

$main::cVersionMGL = '$Date: 2001/01/25 12:49:24 $$Revision: 1.6 $ ';
$main::cProgramMGL = basename($0);

$opt_p = "fixme ";

getopts("dp:DV") || Usage();

$opt_l = shift @ARGV;

# Print version
if ($opt_V)
{
    print "$0: $main::cVersionMGL\n";
    exit;
}

# Append space if needed
$opt_p .= " "
    if ($opt_p =~ /^.+\S$/);

Usage() unless @ARGV && $opt_l;

Main();


# --- show the usage of the script  ---------------------------------------------
sub Usage()
{
    print <<EOF;
    Call:
        $main::cProgramMGL [-dDV] [-p Prefix] language file ...

    Switches:
        -d         Delete unnecessary entries
        -p Prefix  Prefix untranslated or unnecesary entries with this
                   Text. (Default: FIXME)
        -D         Debugging-mode
        -V         show version

    Description:

        $main::cProgramMGL scans the files (.pl, .pm, .cgi, .rc, .po)
        for the given path for messages, which can be translated. For
        every message, an entry in a po-file is created.

EOF
    exit 0;
}




# --- Main-procedure ----------------------------------------------------------
sub Main () {

    my $cFileName;
    my $cBaseName;

    ($cBaseName = $ARGV[0]) =~ s/\.\w+$//;

    # printf STDERR "Basename: $cBaseName\n";

    &ScanSource($cBaseName . ".pl")
        if -f $cBaseName . ".pl";
    &ScanSource($cBaseName . ".pm")
        if -f $cBaseName . ".pm";
    &ScanSource($cBaseName . ".cgi")
        if -f $cBaseName . ".cgi";

    &ScanConfigFile($cBaseName . ".rc")
        if -f $cBaseName . ".rc";

    &ScanPoFile($cBaseName . "_" . $opt_l . ".po")
        if -f $cBaseName . "_" . $opt_l . ".po";

    &WritePoFile($cBaseName . "_" . $opt_l . ".po");
} # sub Main




sub ScanSource ($)
{
   my $cSourceFileName = shift;

   my $cLine;
   my $cFile;
   my $cMatch;
   my $cPrefix;
   my $mc;
   my $cMessage;

   open SOURCE, "<$cSourceFileName"
       or die "Can't open $cSourceFileName";

   print STDERR "Scan $cSourceFileName ...\n"
       if $opt_D;

   while (<SOURCE>)
   {
      chomp;

      $cFile .= $_;
   }
   close SOURCE;

   $mc = new Text::DelimMatch;

   $mc->delim("(gettext|i18n)\\(", "\\)");
   $mc->quote('[\"]');
   $mc->escape("\\");
   $mc->double_escape('"');
   $mc->case_sensitive(1);


   # Scan translatable messages out
   while ($cFile)
   {

      ($cPrefix, $cMatch, $cFile) = $mc->match($cFile);

      no strict;

      $cMessage = eval $cMatch;

      $hMessagesGL{$cMessage} = uc($opt_p) . $cMessage;

      use strict;

   }

}


sub ScanPoFile($)
{

   my $cPoFileName = shift;

   my $cMsgId  = "";
   my $cBuffer = "";

   open PO, "<$cPoFileName"
       or die "Can't open $cPoFileName";

   print STDERR "Scan $cPoFileName ...\n"
       if $opt_D;

   while (<PO>)
   {
      chomp;


      if (/^msgid +\"(.*)\"\s*$/)
      {
         if($cMsgId)
         {
            $cBuffer =~ s/\\n/\n/g;
            $cBuffer =~ s/\\"/"/g;

            if (defined $hMessagesGL{$cMsgId})
            {
               $hMessagesGL{$cMsgId} = $cBuffer;
            }
            else
            {
               my $cTextToRemove = sprintf ("(%s)+", lc($opt_p));

               # remove this text if already existing
               $cBuffer =~ s/$cTextToRemove//g;

               $hMessagesGL{$cMsgId} = lc($opt_p) . $cBuffer
                   unless $opt_d;
            }
         }

         $cMsgId   = "";
         $cBuffer  = $1;
      }
      elsif(/^msgstr +\"(.*)\"\s*$/)
      {
         my $cMessage = $1;

         $cBuffer =~ s/\\n/\n/g;
         $cBuffer =~ s/\\"/"/g;

         $cMsgId = $cBuffer;
         $cBuffer = $cMessage;
      }
      elsif(/^\"(.*)\"\s*$/)
      {
         $cBuffer .= $1;
      }
   }

   if($cMsgId)
   {
      $cBuffer =~ s/\\n/\n/g;
      $cBuffer =~ s/\\"/"/g;

      if (defined $hMessagesGL{$cMsgId})
      {
         $hMessagesGL{$cMsgId} = $cBuffer;
      }
      else
      {
         $hMessagesGL{$cMsgId} = lc($opt_p) . $cBuffer
             unless $opt_d;
      }
   }

   close PO;

}



sub WritePoFile($)
{

   my $cPoFileName = shift;

   return
       unless %hMessagesGL;

   open PO, ">$cPoFileName"
       or die "Can't open $cPoFileName";

   foreach (sort keys %hMessagesGL)
   {
      my $cLine;

      if($_)
      {

         my $cMsgId  = $_;
         my $cMsgStr = $hMessagesGL{$_};

         # replace \n with \\n"\n"
         $cMsgId =~ s/\n/\\n\"\n\"/g;
         $cMsgId = '"' . $cMsgId . '"';

         $cMsgStr =~ s/\n/\\n\"\n\"/g;
         $cMsgStr = '"' . $cMsgStr . '"';

         printf PO ("msgid  %s\nmsgstr %s\n\n", $cMsgId, $cMsgStr);
      }
   }

   close PO;

   if(-z $cPoFileName)
   {
      unlink $cPoFileName;
   }
   else
   {
      chmod 0666, $cPoFileName;
   }
}



sub ScanConfigFile($)
{

   my $cConfigFileName = shift;

   my $cKey;

   open CONFIG, "<$cConfigFileName"
       or die "Can't open $cConfigFileName";

   print STDERR "Scan $cConfigFileName ...\n"
       if $opt_D;

   while (<CONFIG>)
   {
      chomp;

      foreach $cKey ("Table",
                     "Title",
                     "Header",
                     "Text",
                     "Help",
                     "Label",
                     "Value",
                     "Values",
                     "Btn\\w+",
                     "UpdFields",
                     "QryFields",
                     "DatePrintFormat",
                     "DateScanFormats"
                     )
      {

         if (/^ *${cKey} *= *(.*)$/)
         {
            my $cMessage = $1;

            if($cMessage =~ /^<< *(\w+)$/)
            {
               my $cEofMarker = $1;


               $cMessage = "";

               while (<CONFIG>)
               {
                  chomp;

                  if ($_ eq $cEofMarker)
                  {
                     # remove last trailing \n
                     $cMessage =~ s/\n$//;
                     last;
                  }

                  $cMessage .= $_ . "\n";
               }

            }

            if($cMessage =~ /^\"(.*)\"$/)
            {
               $cMessage = $1;
            }

            # Here we have a list of fields
            if ($cKey eq "UpdFields" or
                $cKey eq "QryFields" )
            {
               my $cField;

               foreach $cField (split / *, */, $cMessage)
               {
                  $hMessagesGL{$cField} = uc($opt_p) . $cField;
               }
            }
            # this may be a <<EOF-List of Values
            elsif (($cKey eq "Values") &&
                   ($cMessage !~ /^ *select */i))
            {
               my $cField;

               foreach $cField (split /\n/, $cMessage)
               {
                  # make entry only if it contains other entries then
                  # digits, komma and \
                  unless ($cField =~ /^[\d\\,]+$/)
                  {
                     # separate key and value
                     if($cField =~ /^(.*)\\,(.*)$/)
                     {
                        $hMessagesGL{$1} = uc($opt_p) . $1;
                        $hMessagesGL{$2} = uc($opt_p) . $2;

                     }
                     else
                     {
                        $hMessagesGL{$cField} = uc($opt_p) . $cField;
                     }
                  }
               }
            }
            else
            {

               $hMessagesGL{$cMessage} = uc($opt_p) . $cMessage;
            }
         }
      }
   }
   close CONFIG;

}



sub i18n ($)
{
   return &gettext(shift);
}




sub gettext ($)
{
   my $cMess = shift;

#   printf ("msgid  \"%s\"\nmsgstr \"%s\"\n\n",
#           $cMess,
#           $cMess);

   return $cMess;
}