1: 2eval 'exec perl -wS $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# 32# check_xml.pl - check xml,xcs,xcu files size, NULL character 33# 34 35my 36$is_debug=0; 37my $err = 0; 38my $path = $ENV{'SOLARVERSION'} . '/' . $ENV{'INPATH'} . '/xml' . "$ENV{'UPDMINOREXT'}/"; 39my $pck_path = $ENV{'SOLARVERSION'} . '/' . $ENV{'INPATH'} . '/pck' . "$ENV{'UPDMINOREXT'}/"; 40my $unzipexe="unzip"; 41 42#Path of the directory from which the recursion starts (must have ending '/'). 43print "Checking:$path\n"; 44# Initiate the recursion 45&RecurseDirs($path); 46$err += &check_registry_zips($pck_path); 47if ($err > 0) 48{ 49 print "Error: $err damaged files encountered\n"; 50 exit(1); # stop dmake 51} else 52{ 53 print "ok.\n"; 54} 55exit; 56 57#### SUBROUTINES SECTION #### 58 59# Function that recurses through the directory tree calling FileFunction on all files 60sub RecurseDirs { 61 my ($path) = @_; 62 my $file; #Variable for a file 63 64 opendir (DIRECTORY, $path) or 65 die "Can't read $path\n"; 66 my @all_files = grep (!/^\.\.?$/, readdir (DIRECTORY)); #Read all the files except for '.' and '..' 67 closedir (DIRECTORY); 68 69 foreach $file (@all_files) { 70 if (-d "$path$file/") { 71 &RecurseDirs("$path$file/"); 72 } else { 73 &check($path, $file); 74 } 75 } 76} 77 78############################################################################ 79sub check #04.02.2005 13:40 80############################################################################ 81 { 82 my $path = shift; 83 my $file = shift; 84 print "$path$file\n" if ((-e "$path$file") && $is_debug); 85 return if ( $file !~ /.+\.(xcu|xml|xcs)/ ); #check xml and xcu files only 86 if ( -z "$path$file" ) { 87 print "Error: $path$file 0 Bytes!\n"; 88 $err++; 89 } else 90 { 91 open( FH, "<$path$file" ); 92 while ( $line = <FH> ) { 93 #print $line; 94 if ( $line =~ /\000+/ ) { 95 print "Error: NULL characters detected in $path$file\n"; 96 $err++; 97 } 98 } 99 close(FH); 100 } 101 } 102 103 ############################################################################ 104 sub check_registry_zips #20.04.2005 18:47 105 ############################################################################ 106 { 107 my $path = shift; 108 my $error = 0; 109 my $commandargs; 110 opendir (DIRECTORY, $path) or 111 die "Can't read $path\n"; 112 my @all_files = grep (!/^\.\.?$/, readdir (DIRECTORY)); #Read all the files except for '.' and '..' 113 closedir (DIRECTORY); 114 foreach $file (@all_files) { 115 if ( $file =~ /registry_.+\.zip$/ ) { 116 $commandargs="$path$file"; 117 # Cygwin's perl needs escaped \ in system() and open( COMMAND ... ) 118 if ( "$^O" eq "cygwin" ) { $commandargs =~ s/\\/\\\\/g; } 119 print "file=$commandargs\n" if ($is_debug); 120 open(UNZIP,"$unzipexe -l $commandargs |"); 121 my $ferror = 0; 122 while ( $line = <UNZIP> ) { 123 #print $line; 124 my @param = split(" ",$line); 125 if ( $param[0] =~ /\d+/ ) { 126 if ( $param[0] == 0 && $param[3] =~ /.+\.xcu$/) 127 { 128 $error++; $ferror=1; 129 } 130 } 131 } 132 if ( $ferror ) { 133 print "Error: $commandargs contains files with 0 byte size\n"; 134 } 135 close(UNZIP); 136 } 137 } 138 139 ($error); 140 } ##check_registry_zips 141