: eval 'exec perl -wS $0 ${1+"$@"}' if 0; #************************************************************** # # Licensed to the Apache Software Foundation (ASF) under one # or more contributor license agreements. See the NOTICE file # distributed with this work for additional information # regarding copyright ownership. The ASF licenses this file # to you under the Apache License, Version 2.0 (the # "License"); you may not use this file except in compliance # with the License. You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, # software distributed under the License is distributed on an # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY # KIND, either express or implied. See the License for the # specific language governing permissions and limitations # under the License. # #************************************************************** # # # check_xml.pl - check xml,xcs,xcu files size, NULL character # my $is_debug=0; my $err = 0; my $path = $ENV{'SOLARVERSION'} . '/' . $ENV{'INPATH'} . '/xml' . "$ENV{'UPDMINOREXT'}/"; my $pck_path = $ENV{'SOLARVERSION'} . '/' . $ENV{'INPATH'} . '/pck' . "$ENV{'UPDMINOREXT'}/"; my $unzipexe="unzip"; #Path of the directory from which the recursion starts (must have ending '/'). print "Checking:$path\n"; # Initiate the recursion &RecurseDirs($path); $err += &check_registry_zips($pck_path); if ($err > 0) { print "Error: $err damaged files encountered\n"; exit(1); # stop dmake } else { print "ok.\n"; } exit; #### SUBROUTINES SECTION #### # Function that recurses through the directory tree calling FileFunction on all files sub RecurseDirs { my ($path) = @_; my $file; #Variable for a file opendir (DIRECTORY, $path) or die "Can't read $path\n"; my @all_files = grep (!/^\.\.?$/, readdir (DIRECTORY)); #Read all the files except for '.' and '..' closedir (DIRECTORY); foreach $file (@all_files) { if (-d "$path$file/") { &RecurseDirs("$path$file/"); } else { &check($path, $file); } } } ############################################################################ sub check #04.02.2005 13:40 ############################################################################ { my $path = shift; my $file = shift; print "$path$file\n" if ((-e "$path$file") && $is_debug); return if ( $file !~ /.+\.(xcu|xml|xcs)/ ); #check xml and xcu files only if ( -z "$path$file" ) { print "Error: $path$file 0 Bytes!\n"; $err++; } else { open( FH, "<$path$file" ); while ( $line = ) { #print $line; if ( $line =~ /\000+/ ) { print "Error: NULL characters detected in $path$file\n"; $err++; } } close(FH); } } ############################################################################ sub check_registry_zips #20.04.2005 18:47 ############################################################################ { my $path = shift; my $error = 0; my $commandargs; opendir (DIRECTORY, $path) or die "Can't read $path\n"; my @all_files = grep (!/^\.\.?$/, readdir (DIRECTORY)); #Read all the files except for '.' and '..' closedir (DIRECTORY); foreach $file (@all_files) { if ( $file =~ /registry_.+\.zip$/ ) { $commandargs="$path$file"; # Cygwin's perl needs escaped \ in system() and open( COMMAND ... ) if ( "$^O" eq "cygwin" ) { $commandargs =~ s/\\/\\\\/g; } print "file=$commandargs\n" if ($is_debug); open(UNZIP,"$unzipexe -l $commandargs |"); my $ferror = 0; while ( $line = ) { #print $line; my @param = split(" ",$line); if ( $param[0] =~ /\d+/ ) { if ( $param[0] == 0 && $param[3] =~ /.+\.xcu$/) { $error++; $ferror=1; } } } if ( $ferror ) { print "Error: $commandargs contains files with 0 byte size\n"; } close(UNZIP); } } ($error); } ##check_registry_zips