solenv/bin/modules/installer/filelists.pm

   1 #
   2 # This file is part of the LibreOffice project.
   3 #
   4 # This Source Code Form is subject to the terms of the Mozilla Public
   5 # License, v. 2.0. If a copy of the MPL was not distributed with this
   6 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
   7 #
   8
   9 package installer::filelists;
  10
  11 use strict;
  12 use warnings;
  13
  14 use File::stat;
  15
  16 use installer::files;
  17 use installer::globals;
  18 use installer::logger;
  19 use installer::pathanalyzer;
  20
  21 sub resolve_filelist_flag
  22 {
  23     my ($files, $links, $outdir) = @_;
  24     my @newfiles = ();
  25     my $error = 0;
  26
  27     foreach my $file (@{$files})
  28     {
  29         my $is_filelist = 0;
  30         my $use_internal_rights = 0;
  31         if ($file->{'Styles'})
  32         {
  33             if ($file->{'Styles'} =~ /\bFILELIST\b/)
  34             {
  35                 $is_filelist = 1;
  36             }
  37             if ($file->{'Styles'} =~ /\bUSE_INTERNAL_RIGHTS\b/ && !$installer::globals::iswin)
  38             {
  39                 $use_internal_rights = 1;
  40             }
  41         }
  42
  43         if ($is_filelist)
  44         {
  45             my $filelist_path = $file->{'sourcepath'};
  46             my $filelist = read_filelist($filelist_path);
  47             if (@{$filelist})
  48             {
  49                 my $destination = $file->{'destination'};
  50                 installer::pathanalyzer::get_path_from_fullqualifiedname(\$destination);
  51
  52                 foreach my $path (@{$filelist})
  53                 {
  54                     my $is_symlink = 0;
  55
  56                     if ((index $path, $outdir) != 0)
  57                     {
  58                         installer::logger::print_error("file '$path' is not in '$outdir'");
  59                         $error = 1;
  60                     }
  61                     if ($path =~ '\/\/')
  62                     {
  63                         installer::logger::print_error("file '$path' contains 2 consecutive '/' which breaks MSIs");
  64                         $error = 1;
  65                     }
  66                     if (-l $path)
  67                     {
  68                         $is_symlink = 1;
  69                     }
  70                     else
  71                     {
  72                         if (!-e $path)
  73                         {
  74                             installer::logger::print_error("file '$path' does not exist");
  75                             $error = 1;
  76                         }
  77                     }
  78
  79                     my $subpath = substr $path, ((length $outdir) + 1); # drop separator too
  80
  81                     my %newfile = ();
  82                     %newfile = %{$file};
  83                     $newfile{'Name'} = $subpath;
  84                     $newfile{'sourcepath'} = $path;
  85                     $newfile{'destination'} = $destination . $subpath;
  86                     $newfile{'filelistname'} = $file->{'Name'};
  87                     $newfile{'filelistpath'} = $file->{'sourcepath'};
  88
  89                     if ($is_symlink)
  90                     {
  91                         # FIXME: for symlinks destination is mangled later in
  92                         # get_Destination_Directory_For_Item_From_Directorylist
  93                         $newfile{'DoNotMessWithSymlinks'} = 1;
  94                         $newfile{'Target'} = readlink($path);
  95                         push ( @{$links}, \%newfile );
  96                     }
  97                     else
  98                     {
  99                         if ($use_internal_rights)
 100                         {
 101                             my $st = stat($path);
 102                             $newfile{'UnixRights'} = sprintf("%o", $st->mode & 0777);
 103                         }
 104
 105                         push @newfiles, \%newfile;
 106                     }
 107                 }
 108             }
 109             else
 110             {
 111                 installer::logger::print_message("filelist $filelist_path is empty\n");
 112             }
 113         }
 114         else # not a filelist, just pass the current file over
 115         {
 116             push @newfiles, $file;
 117         }
 118     }
 119
 120     if ( $error )
 121     {
 122         installer::exiter::exit_program("ERROR: error(s) in resolve_filelist_flag");
 123     }
 124
 125     return (\@newfiles, $links);
 126 }
 127
 128 sub read_filelist
 129 {
 130     my ($path) = @_;
 131     my $content = installer::files::read_file($path);
 132     my @filelist = ();
 133
 134     # split on space, but only if followed by / (don't split within a filename)
 135     my $splitRE = qr!\s+(?=/)!;
 136     # filelist on win have C:/cygwin style however - also reading dos-file under
 137     # cygwin retains \r\n - so chomp below still leaves \r to strip in the RE
 138     $splitRE    = qr!\s+(?:$|(?=[A-Z]:/))! if ($installer::globals::os eq "WNT");
 139
 140     foreach my $line (@{$content})
 141     {
 142         chomp $line;
 143         foreach my $file (split $splitRE, $line)
 144         {
 145             if ($file ne "")
 146             {
 147                 push @filelist, $file;
 148             }
 149         }
 150     }
 151
 152     return \@filelist;
 153 }
 154
 155 1;
 156
 157 # vim: set expandtab shiftwidth=4 tabstop=4: