openoffice-dpack-lang.pl

   1 #! /usr/bin/perl
   2
   3 use strict;
   4
   5 #- Define full path to unzip command
   6 my $UnzipCommand = "/usr/bin/unzip";
   7
   8 #- Define the default setup file
   9 my $SetupConf = "setup.ins";
  10
  11 #- Define the zipfiles dir (will be the same as of setup.ins)
  12 my $SetupDir = ".";
  13
  14 #- Define destination directory
  15 my $DestDir = "/usr/lib/openoffice";
  16
  17 #- Define to extract help files
  18 my $ExtractHelp = 0;
  19
  20 sub dirname { local $_ = shift; s|[^/]*/*\s*$||; s|(.)/*$|$1|; $_ || '.' }
  21 sub cat_ { local *F; open F, $_[0] or return; my @l = <F>; wantarray() ? @l : join '', @l }
  22
  23 sub mkdir_p {
  24   my ($dir) = @_;
  25   if (-d $dir) {
  26     # nothing to do
  27   } elsif (-e $dir) {
  28     die "mkdir: error creating directory $dir: $dir is a file and i won't delete it\n";
  29   } else {
  30     mkdir_p(dirname($dir));
  31     mkdir($dir, 0755) or die "mkdir: error creating directory $dir: $!\n";
  32   }
  33   1;
  34 }
  35
  36 while ( $ARGV[0] =~ /^-/ ) {
  37         $_ = shift;
  38         if (m/^-d=(\S+)/) {
  39                 $DestDir=$1;
  40         }
  41         elsif (m/^-z=(\S+)/) {
  42                 $UnzipCommand=$1;
  43         }
  44         elsif (m/^-i=(\S+)/) {
  45                 $SetupConf=$1;
  46                 $SetupDir=dirname $SetupConf;
  47         }
  48         elsif (m/^-h/) {
  49                 $ExtractHelp = 1;
  50         }
  51         else {
  52                 print STDERR "$0: Unknown option $_";
  53         }
  54 }
  55
  56 # Parse enough of <setup.ins> to get correct Directory and File sections.
  57 sub ReadSetup($) {
  58         my ($file) = @_;
  59     my $e;
  60     my %entries;
  61     foreach (cat_("$file")) {
  62                 if (/^([_A-Za-z]+)\s*([_A-Za-z0-9]+)/) {
  63                         $entries{$1}{$2} = $e = { };
  64                 }
  65                 elsif (/\s*([_A-Za-z]+)\s*=\s*\"?([^;\"]+)\"?;/) {
  66                         $e->{$1} = $2;
  67                 }
  68     }
  69
  70         # Expand predefined dirs to de $DestDir variable
  71         $entries{Directory}{$_} = { HostName => "$DestDir" } foreach
  72                 qw( PREDEFINED_HOMEDIR  PREDEFINED_PROGDIR PREDEFINED_CONFIGDIR );
  73
  74     \%entries;
  75 }
  76
  77 sub DumpEntries(\%$) {
  78     my $entries = shift;
  79     my ($basename) = @_;
  80     my $sections = $entries->{$basename} if $entries->{$basename};
  81     while (my ($key, $value) = each(%$sections)) {
  82         print "$basename $key\n";
  83         $value->{$_} and print "\t$_\t= \"$value->{$_}\";\n"
  84             foreach qw(Bitmap Date DefaultDestPath DefaultLanguage
  85                        Description FadeType FileName fontsDirFile
  86                        fontsDirGlobalFile fontspath HostName ID Key
  87                        Languages Name PackedName Path ProcName
  88                        ProductName ProductVersion Section Text Time
  89                        Value VendorBitmap);
  90         $value->{$_} and print "\t$_\t= $value->{$_};\n"
  91             foreach qw(ArchiveFiles ArchiveSize BitmapPosX BitmapPoxY
  92                        Carrier Default Dir DiskNo FileID FontSize
  93                        Minimal ModuleID NetDir Order ParentID
  94                        ProfileID RegistryID ScriptVersion Size
  95                        TextHeight TextWidth UnixRights);
  96         print "End\n\n";
  97     }
  98 }
  99
 100 sub GetFullPath {
 101     my $dirs = shift;
 102     my ($id) = @_;
 103         return ( $dirs->{$id}->{ParentID} ? GetFullPath($dirs, $dirs->{$id}->{ParentID}) . "/" : "" )
 104                    . $dirs->{$id}->{HostName};
 105 }
 106
 107 # Parse the file and get all entries
 108 die "$0: Can't open $SetupConf\n" if ( ! -r $SetupConf );
 109 my $setup = ReadSetup($SetupConf);
 110 #DumpEntries %$setup, "Directory";
 111 #DumpEntries %$setup, "File";
 112
 113 die "$UnzipCommand not found, please set the full path to the unzip command\n" if
 114     ( ! -x "$UnzipCommand" );
 115
 116 while (my ($key, $value) = each (%{$setup->{File}})) {
 117     if ($value->{PackedName}) {
 118                 my $zipfile = "$SetupDir/$value->{PackedName}";
 119                 die "$0: zip file $zipfile not accessible" if
 120                         ( ! -r "$zipfile" );
 121
 122                 # Find language-specific candidates
 123                 if ($key =~ /_Lang$/ || $value->{Name} =~ /\.res$/
 124                         || ($ExtractHelp && $key =~ /File_Help/ && $value->{Dir} =~ /gid_Dir_Help_Isolanguage/)) {
 125                         print "Unpacking $zipfile... ";
 126                         # Prefer NetDir path over simple Dir
 127                         my $outpath = GetFullPath \%{$setup->{Directory}}, $value->{NetDir} ? $value->{NetDir} : $value->{Dir};
 128                         -d $outpath or mkdir_p($outpath);
 129                         system("$UnzipCommand $zipfile -d $outpath");
 130                 }
 131     }
 132 }
 133