solenv/bin/oochkpatch.pl

   1 :
   2     eval 'exec perl -S $0 ${1+"$@"}'
   3         if 0;
   4 #*************************************************************************
   5 #
   6 # DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
   7 #
   8 # Copyright 2000, 2010 Oracle and/or its affiliates.
   9 #
  10 # OpenOffice.org - a multi-platform office productivity suite
  11 #
  12 # This file is part of OpenOffice.org.
  13 #
  14 # OpenOffice.org is free software: you can redistribute it and/or modify
  15 # it under the terms of the GNU Lesser General Public License version 3
  16 # only, as published by the Free Software Foundation.
  17 #
  18 # OpenOffice.org is distributed in the hope that it will be useful,
  19 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 # GNU Lesser General Public License version 3 for more details
  22 # (a copy is included in the LICENSE file that accompanied this code).
  23 #
  24 # You should have received a copy of the GNU Lesser General Public License
  25 # version 3 along with OpenOffice.org.  If not, see
  26 # <http://www.openoffice.org/license.html>
  27 # for a copy of the LGPLv3 License.
  28 #
  29 #*************************************************************************
  30 #
  31 # oochkpatch - check patch flags against CWS modules
  32 #
  33
  34 require File::Temp;
  35 require File::Find;
  36 require Getopt::Long;
  37 require Pod::Usage;
  38 use Pod::Usage;
  39 use Getopt::Long;
  40 use File::Temp qw/ tempfile tempdir /;
  41 use File::Find;
  42
  43
  44 # configuration goes here
  45 ##########################################################
  46
  47 # uncomment this, if in pure OOo environment
  48 #my $toplevel_module = "instsetoo_native";
  49 #my $scp_module     = "scp2";
  50 #my $setup_file     = "setup_osl";
  51
  52 # uncomment this, if within the StarOffice environment
  53 my $toplevel_module = "instset_native";
  54 my $scp_module      = "scp2so";
  55 my $setup_file      = "setup";
  56
  57 my $deliver = "solenv/bin/deliver.pl";
  58 my $build   = "solenv/bin/build.pl";
  59
  60 # list of hardcoded exceptions (files that are _never_ considered
  61 # missing from the patch)
  62 my %hardcoded_exceptions = ('build.lst' => 1);
  63
  64
  65 # no configuration below this point, please!
  66 ##########################################################
  67
  68 # defaults
  69 my $from_module = "";
  70 my $verbose     = '';
  71 my $help        = '';
  72 my $man         = '';
  73 my $modules     = '';
  74 my $from        = '';
  75 my $perl        = '';
  76
  77 GetOptions('help|?'  => \$help,
  78            'man'     => \$man,
  79            'verbose' => \$verbose,
  80            'from=s'  => \$from_module ) or pod2usage(2);
  81 pod2usage(1) if $help;
  82 pod2usage(-exitstatus => 0, -verbose => 2) if $man;
  83
  84 # process remaining args
  85 print "Processing args...\n" if $verbose;
  86 foreach my $argument (@ARGV)
  87 {
  88     print " Checking module ", $argument, "\n" if $verbose;
  89     push @modules, $argument;
  90 }
  91
  92 # platform-dependent stuff
  93 if( $^O eq 'MSWin32' )
  94 {
  95     $perl = "$ENV{COMSPEC} -c $ENV{PERL}";
  96     $setup_file = $setup_file . ".inf";
  97 }
  98 else
  99 {
 100     $perl = 'perl';
 101     $setup_file = $setup_file . ".ins";
 102 };
 103
 104 # read some SOLAR stuff from env
 105 my $SRC_ROOT = $ENV{"SRC_ROOT"};
 106 my $INPATH = $ENV{"INPATH"};
 107
 108 # process --from modules
 109 if( $from_module )
 110 {
 111     print "Checking all modules upwards and including ", $from_module, "\n" if $verbose;
 112
 113     # append build.pl-generated list of modules
 114     chdir "$SRC_ROOT/$toplevel_module" or
 115         chdir "$SRC_ROOT/$toplevel_module.lnk" or die "ERROR: cannot cd to $SRC_ROOT/$toplevel_module!";
 116     open(ALLMODULES,
 117          "$perl $SRC_ROOT/$build --all:$from_module --show 2>&1 |") or die "ERROR: cannot build --show!\n";
 118     while(<ALLMODULES>)
 119     {
 120         if( /Building project/ )
 121         {
 122             my @module = split( /\s+/, $_ );
 123             print " which is ", $module[2], "\n" if $verbose;
 124             push(@modules,$module[2]);
 125         }
 126     }
 127 }
 128
 129 die "ERROR: no modules to check!\n" if !@modules;
 130
 131 $tempdir = tempdir( TMPDIR => 1, CLEANUP => 1);
 132
 133 # generate list of files with PATCH flag
 134 print "Generating list of files which have the PATCH flag...\n" if $verbose;
 135
 136 my $path_to_setup_file = $SRC_ROOT."/".$scp_module."/".$INPATH."/bin/osl/".$setup_file;
 137 my $alternate_path_to_setup_file = $SRC_ROOT."/".$scp_module.".lnk/".$INPATH."/bin/osl/".$setup_file;
 138 my $in_file_block=0;
 139 my $patch_flag=0;
 140 my $file_name='';
 141 my $base;
 142 my $ext;
 143 my %pack_files;
 144 open(SETUP, "<".$path_to_setup_file) or
 145    open(SETUP, "<".$alternate_path_to_setup_file) or die "ERROR: cannot open $path_to_setup_file!\n";
 146 while(<SETUP>)
 147 {
 148     if( /^File\s+/ && !$in_file_block )
 149     {
 150         $in_file_block = 1;
 151         $patch_flag=0;
 152         $file_name='';
 153     }
 154     elsif( /^End/ && $file_name ne '' && $in_file_block )
 155     {
 156         $file_name =~ s/["']//g;
 157         $pack_files{$file_name} = $patch_flag;
 158
 159         if( $patch_flag )
 160         {
 161             print( " File $file_name included in patch\n") if $verbose;
 162         }
 163         else
 164         {
 165             print( " File $file_name NOT included in patch\n") if $verbose;
 166         }
 167
 168         $in_file_block = 0;
 169     }
 170     elsif( /^\s+Styles\s*=\s*.*PATCH/ && $in_file_block )
 171     {
 172         $patch_flag = 1;
 173     }
 174     elsif( ($res) = /^\s+Name\s*=\s*(.*);/ )
 175     {
 176         $file_name = $res;
 177     }
 178 }
 179
 180 # generate list of delivered files
 181 print "Generating list of delivered libs...\n" if $verbose;
 182
 183 # first, deliver all modules to tempdir
 184 foreach my $module (@modules)
 185 {
 186     print " dummy-delivering $module...\n" if $verbose;
 187     chdir "$SRC_ROOT/$module" or
 188         chdir "$SRC_ROOT/$module.lnk" or die "ERROR: cannot cd to $SRC_ROOT/$module!";
 189     `$perl $SRC_ROOT/$deliver $tempdir`;
 190 }
 191
 192 # now, check all files in delivered dirs for containedness in PATCH
 193 # set
 194 print "Checking against delivered files...\n" if $verbose;
 195 find(\&wanted, $tempdir );
 196
 197 sub wanted
 198 {
 199     my $fname;
 200
 201     if( -f )
 202     {
 203         $fname = $_;
 204         if( !exists $pack_files{$fname} )
 205         {
 206             print " File $fname is not packed.\n" if $verbose;
 207         }
 208         elsif( $pack_files{$fname} == 0 )
 209         {
 210             if( !$hardcoded_exceptions{ $fname } )
 211             {
 212                 # file not in patch set, and not in exception list
 213                 print " File $fname is packed, but NOT included in patch set and part of delivered output\n" if $verbose;
 214                 print "$fname\n" if !$verbose;
 215             }
 216             else
 217             {
 218                 print " File $fname is NOT included in patch set, but member of hardcoded exception list\n" if $verbose;
 219             }
 220         }
 221         elsif( $pack_files{$fname} == 1 )
 222         {
 223             print " File $fname packed and patched.\n" if $verbose;
 224         }
 225     }
 226 }
 227
 228
 229 __END__
 230
 231 =head1 NAME
 232
 233 oochkpatch.pl - Verify patch flags against module libraries
 234
 235 =head1 SYNOPSIS
 236
 237 oochkpatch.pl [options] [module-name ...]
 238
 239  Options:
 240    --help|-h         brief help message
 241    --man|-m          full documentation
 242    --verbose|-v      tell what's happening
 243    --from=module     check all modules from
 244                      given one upwards
 245
 246 =head1 OPTIONS
 247
 248 =over 8
 249
 250 =item B<--help>
 251
 252 Print a brief help message and exits.
 253
 254 =item B<--man>
 255
 256 Prints the manual page and exits.
 257
 258 =item B<--verbose>
 259
 260 Verbosely tell what's currently happening
 261
 262 =item B<--from=module>
 263
 264 Assumes OOo was built incompatibly from given module
 265 upwards, and check against all libs from all upwards modules.
 266 Further modules can be given at the command line, which are merged
 267 with the ones generated from this option
 268
 269 =back
 270
 271 =head1 DESCRIPTION
 272
 273 B<This program> will compare all libs delivered from the specified modules
 274 against the set of files marked with the B<patch> flag in scp2. Useful to check
 275 if the patch set is complete. Please note that this program needs to be run in
 276 a solar shell, i.e. the OOo build environment needs to be set up in the shell.
 277
 278 There's kind of a heuristic involved, to determine exactly which files
 279 to check against includedness in the patch set (since e.g. all headers
 280 are delivered, but clearly need not be checked against patch
 281 flags). It works by first collecting all files that are mentioned in
 282 the pack master file, and then checking all files delivered from the
 283 specified modules against that pack list: if the file is not packed,
 284 or if it's packed and has the patch flag set, all is well. Otherwise,
 285 the file in question potentially misses the patch flag (because one of
 286 the modified modules contains it).
 287
 288 =head1 EXAMPLE
 289
 290 To determine the set of libs not yet carrying the patch flag for a CWS
 291 containing sfx2, svx, and vcl, which is incompatible from sfx2
 292 upwards, use something like this:
 293
 294 oochkpatch.pl --from=sfx2 `cwsquery modules`
 295
 296 This puts every module upwards and including sfx2 in the check list,
 297 plus vcl. Note that with this approach, you'll usually get a larger
 298 set of files for the patch than necessary - but at least you get all
 299 files that might have changed theoretically.
 300
 301 =cut