1cdf0e10cSrcweir: 2cdf0e10cSrcweireval 'exec perl -wS $0 ${1+"$@"}' 3cdf0e10cSrcweir if 0; 4*7e90fac2SAndrew Rist#************************************************************** 5*7e90fac2SAndrew Rist# 6*7e90fac2SAndrew Rist# Licensed to the Apache Software Foundation (ASF) under one 7*7e90fac2SAndrew Rist# or more contributor license agreements. See the NOTICE file 8*7e90fac2SAndrew Rist# distributed with this work for additional information 9*7e90fac2SAndrew Rist# regarding copyright ownership. The ASF licenses this file 10*7e90fac2SAndrew Rist# to you under the Apache License, Version 2.0 (the 11*7e90fac2SAndrew Rist# "License"); you may not use this file except in compliance 12*7e90fac2SAndrew Rist# with the License. You may obtain a copy of the License at 13*7e90fac2SAndrew Rist# 14*7e90fac2SAndrew Rist# http://www.apache.org/licenses/LICENSE-2.0 15*7e90fac2SAndrew Rist# 16*7e90fac2SAndrew Rist# Unless required by applicable law or agreed to in writing, 17*7e90fac2SAndrew Rist# software distributed under the License is distributed on an 18*7e90fac2SAndrew Rist# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 19*7e90fac2SAndrew Rist# KIND, either express or implied. See the License for the 20*7e90fac2SAndrew Rist# specific language governing permissions and limitations 21*7e90fac2SAndrew Rist# under the License. 22*7e90fac2SAndrew Rist# 23*7e90fac2SAndrew Rist#************************************************************** 24*7e90fac2SAndrew Rist 25*7e90fac2SAndrew Rist 26cdf0e10cSrcweir 27cdf0e10cSrcweir# 28cdf0e10cSrcweir# packimages.pl - pack images into archives 29cdf0e10cSrcweir# 30cdf0e10cSrcweir 31cdf0e10cSrcweiruse strict; 32cdf0e10cSrcweiruse Getopt::Long; 33cdf0e10cSrcweiruse File::Find; 34cdf0e10cSrcweiruse File::Basename; 35cdf0e10cSrcweiruse Archive::Zip qw(:ERROR_CODES :CONSTANTS); 36cdf0e10cSrcweir 37cdf0e10cSrcweir#### globals #### 38cdf0e10cSrcweir 39cdf0e10cSrcweirmy $img_global = '%GLOBALRES%'; # 'global' image prefix 40cdf0e10cSrcweirmy $img_module = '%MODULE%'; # 'module' image prefix 41cdf0e10cSrcweir 42cdf0e10cSrcweirmy $out_file; # path to output archive 43cdf0e10cSrcweirmy $tmp_out_file; # path to temporary output file 44cdf0e10cSrcweirmy $global_path; # path to global images directory 45cdf0e10cSrcweirmy $module_path; # path to module images directory 46cdf0e10cSrcweirmy $sort_file; # path to file containing sorting data 47cdf0e10cSrcweirmy @custom_path; # path to custom images directory 48cdf0e10cSrcweirmy @imagelist_path; # pathes to directories containing the image lists 49cdf0e10cSrcweirmy $verbose; # be verbose 50cdf0e10cSrcweirmy $extra_verbose; # be extra verbose 51cdf0e10cSrcweirmy $do_rebuild = 0; # is rebuilding zipfile required? 52cdf0e10cSrcweir 53cdf0e10cSrcweirmy @custom_list; 54cdf0e10cSrcweir#### script id ##### 55cdf0e10cSrcweir 56cdf0e10cSrcweir( my $script_name = $0 ) =~ s/^.*\b(\w+)\.pl$/$1/; 57cdf0e10cSrcweir 58cdf0e10cSrcweirmy $script_rev; 59cdf0e10cSrcweirmy $id_str = ' $Revision: 1.17 $ '; 60cdf0e10cSrcweir$id_str =~ /Revision:\s+(\S+)\s+\$/ 61cdf0e10cSrcweir ? ($script_rev = $1) : ($script_rev = "-"); 62cdf0e10cSrcweir 63cdf0e10cSrcweirprint "$script_name -- version: $script_rev\n"; 64cdf0e10cSrcweir 65cdf0e10cSrcweir#### main ##### 66cdf0e10cSrcweir 67cdf0e10cSrcweirparse_options(); 68cdf0e10cSrcweirmy $image_lists_ref = get_image_lists(); 69cdf0e10cSrcweirmy %image_lists_hash; 70cdf0e10cSrcweirforeach ( @{$image_lists_ref} ) { 71cdf0e10cSrcweir $image_lists_hash{$_}=""; 72cdf0e10cSrcweir} 73cdf0e10cSrcweir$do_rebuild = is_file_newer(\%image_lists_hash) if $do_rebuild == 0; 74cdf0e10cSrcweirmy ($global_hash_ref, $module_hash_ref, $custom_hash_ref) = iterate_image_lists($image_lists_ref); 75cdf0e10cSrcweir# custom_hash filled from filesystem lookup 76cdf0e10cSrcweirfind_custom($custom_hash_ref); 77cdf0e10cSrcweirmy $zip_hash_ref = create_zip_list($global_hash_ref, $module_hash_ref, $custom_hash_ref); 78cdf0e10cSrcweir$do_rebuild = is_file_newer($zip_hash_ref) if $do_rebuild == 0; 79cdf0e10cSrcweirif ( $do_rebuild == 1 ) { 80cdf0e10cSrcweir create_zip_archive($zip_hash_ref); 81cdf0e10cSrcweir replace_file($tmp_out_file, $out_file); 82cdf0e10cSrcweir print_message("packing $out_file finished."); 83cdf0e10cSrcweir} else { 84cdf0e10cSrcweir print_message("$out_file up to date. nothing to do."); 85cdf0e10cSrcweir} 86cdf0e10cSrcweir 87cdf0e10cSrcweirexit(0); 88cdf0e10cSrcweir 89cdf0e10cSrcweir#### subroutines #### 90cdf0e10cSrcweir 91cdf0e10cSrcweirsub parse_options 92cdf0e10cSrcweir{ 93cdf0e10cSrcweir my $opt_help; 94cdf0e10cSrcweir my $p = Getopt::Long::Parser->new(); 95cdf0e10cSrcweir my @custom_path_list; 96cdf0e10cSrcweir my $custom_path_extended; 97cdf0e10cSrcweir my $success =$p->getoptions( 98cdf0e10cSrcweir '-h' => \$opt_help, 99cdf0e10cSrcweir '-o=s' => \$out_file, 100cdf0e10cSrcweir '-g=s' => \$global_path, 101cdf0e10cSrcweir '-s=s' => \$sort_file, 102cdf0e10cSrcweir '-m=s' => \$module_path, 103cdf0e10cSrcweir '-c=s' => \@custom_path_list, 104cdf0e10cSrcweir '-e=s' => \$custom_path_extended, 105cdf0e10cSrcweir '-l=s' => \@imagelist_path, 106cdf0e10cSrcweir '-v' => \$verbose, 107cdf0e10cSrcweir '-vv' => \$extra_verbose 108cdf0e10cSrcweir ); 109cdf0e10cSrcweir push @custom_path_list, $custom_path_extended if ($custom_path_extended); 110cdf0e10cSrcweir if ( $opt_help || !$success || !$out_file || !$global_path 111cdf0e10cSrcweir || !$module_path || !@custom_path_list || !@imagelist_path ) 112cdf0e10cSrcweir { 113cdf0e10cSrcweir usage(); 114cdf0e10cSrcweir exit(1); 115cdf0e10cSrcweir } 116cdf0e10cSrcweir #define intermediate output file 117cdf0e10cSrcweir $tmp_out_file="$out_file"."$$".$ENV{INPATH}; 118cdf0e10cSrcweir # Sanity checks. 119cdf0e10cSrcweir 120cdf0e10cSrcweir # Check if out_file can be written. 121cdf0e10cSrcweir my $out_dir = dirname($out_file); 122cdf0e10cSrcweir 123cdf0e10cSrcweir # Check paths. 124cdf0e10cSrcweir foreach ($out_dir, $global_path, $module_path, @imagelist_path) { 125cdf0e10cSrcweir print_error("no such directory: '$_'", 2) if ! -d $_; 126cdf0e10cSrcweir print_error("can't search directory: '$_'", 2) if ! -x $_; 127cdf0e10cSrcweir } 128cdf0e10cSrcweir print_error("directory is not writable: '$out_dir'", 2) if ! -w $out_dir; 129cdf0e10cSrcweir 130cdf0e10cSrcweir # Use just the working paths 131cdf0e10cSrcweir @custom_path = (); 132cdf0e10cSrcweir foreach (@custom_path_list) { 133cdf0e10cSrcweir if ( ! -d $_ ) { 134cdf0e10cSrcweir print_warning("skipping non-existing directory: '$_'", 2); 135cdf0e10cSrcweir } 136cdf0e10cSrcweir elsif ( ! -x $_ ) { 137cdf0e10cSrcweir print_error("can't search directory: '$_'", 2); 138cdf0e10cSrcweir } 139cdf0e10cSrcweir else { 140cdf0e10cSrcweir push @custom_path, $_; 141cdf0e10cSrcweir } 142cdf0e10cSrcweir } 143cdf0e10cSrcweir} 144cdf0e10cSrcweir 145cdf0e10cSrcweirsub get_image_lists 146cdf0e10cSrcweir{ 147cdf0e10cSrcweir my @image_lists; 148cdf0e10cSrcweir my $glob_imagelist_path; 149cdf0e10cSrcweir 150cdf0e10cSrcweir foreach ( @imagelist_path ) { 151cdf0e10cSrcweir $glob_imagelist_path = $_; 152cdf0e10cSrcweir # cygwin perl 153cdf0e10cSrcweir chomp( $glob_imagelist_path = qx{cygpath -u "$glob_imagelist_path"} ) if "$^O" eq "cygwin"; 154cdf0e10cSrcweir push @image_lists, glob("$glob_imagelist_path/*.ilst"); 155cdf0e10cSrcweir } 156cdf0e10cSrcweir if ( !@image_lists ) { 157cdf0e10cSrcweir print_error("can't find any image lists in '@imagelist_path'", 3); 158cdf0e10cSrcweir } 159cdf0e10cSrcweir 160cdf0e10cSrcweir return wantarray ? @image_lists : \@image_lists; 161cdf0e10cSrcweir} 162cdf0e10cSrcweir 163cdf0e10cSrcweirsub iterate_image_lists 164cdf0e10cSrcweir{ 165cdf0e10cSrcweir my $image_lists_ref = shift; 166cdf0e10cSrcweir 167cdf0e10cSrcweir my %global_hash; 168cdf0e10cSrcweir my %module_hash; 169cdf0e10cSrcweir my %custom_hash; 170cdf0e10cSrcweir 171cdf0e10cSrcweir foreach my $i ( @{$image_lists_ref} ) { 172cdf0e10cSrcweir parse_image_list($i, \%global_hash, \%module_hash, \%custom_hash); 173cdf0e10cSrcweir } 174cdf0e10cSrcweir 175cdf0e10cSrcweir return (\%global_hash, \%module_hash, \%custom_hash); 176cdf0e10cSrcweir} 177cdf0e10cSrcweir 178cdf0e10cSrcweirsub parse_image_list 179cdf0e10cSrcweir{ 180cdf0e10cSrcweir my $image_list = shift; 181cdf0e10cSrcweir my $global_hash_ref = shift; 182cdf0e10cSrcweir my $module_hash_ref = shift; 183cdf0e10cSrcweir my $custom_hash_ref = shift; 184cdf0e10cSrcweir 185cdf0e10cSrcweir print_message("parsing '$image_list' ...") if $verbose; 186cdf0e10cSrcweir my $linecount = 0; 187cdf0e10cSrcweir open(IMAGE_LIST, "< $image_list") or die "ERROR: can't open $image_list: $!"; 188cdf0e10cSrcweir while ( <IMAGE_LIST> ) { 189cdf0e10cSrcweir $linecount++; 190cdf0e10cSrcweir next if /^\s*#/; 191cdf0e10cSrcweir next if /^\s*$/; 192cdf0e10cSrcweir # clean up trailing whitespace 193cdf0e10cSrcweir tr/\r\n//d; 194cdf0e10cSrcweir s/\s+$//; 195cdf0e10cSrcweir # clean up backslashes and double slashes 196cdf0e10cSrcweir tr{\\}{/}s; 197cdf0e10cSrcweir tr{/}{}s; 198cdf0e10cSrcweir # hack "res" back into globals 199cdf0e10cSrcweir if ( /^\Q$img_global\E\/(.*)$/o ) { 200cdf0e10cSrcweir $global_hash_ref->{"res/".$1}++; 201cdf0e10cSrcweir next; 202cdf0e10cSrcweir } 203cdf0e10cSrcweir if ( /^\Q$img_module\E\/(.*)$/o ) { 204cdf0e10cSrcweir $module_hash_ref->{$1}++; 205cdf0e10cSrcweir next; 206cdf0e10cSrcweir } 207cdf0e10cSrcweir # parse failed if we reach this point, bail out 208cdf0e10cSrcweir close(IMAGE_LIST); 209cdf0e10cSrcweir print_error("can't parse line $linecount from file '$image_list'", 4); 210cdf0e10cSrcweir } 211cdf0e10cSrcweir close(IMAGE_LIST); 212cdf0e10cSrcweir 213cdf0e10cSrcweir return ($global_hash_ref, $module_hash_ref, $custom_hash_ref); 214cdf0e10cSrcweir} 215cdf0e10cSrcweir 216cdf0e10cSrcweirsub find_custom 217cdf0e10cSrcweir{ 218cdf0e10cSrcweir my $custom_hash_ref = shift; 219cdf0e10cSrcweir my $keep_back; 220cdf0e10cSrcweir for my $path (@custom_path) { 221cdf0e10cSrcweir find({ wanted => \&wanted, no_chdir => 0 }, $path); 222cdf0e10cSrcweir foreach ( @custom_list ) { 223cdf0e10cSrcweir if ( /^\Q$path\E\/(.*)$/ ) { 224cdf0e10cSrcweir $keep_back=$1; 225cdf0e10cSrcweir if (!defined $custom_hash_ref->{$keep_back}) { 226cdf0e10cSrcweir $custom_hash_ref->{$keep_back} = $path; 227cdf0e10cSrcweir } 228cdf0e10cSrcweir } 229cdf0e10cSrcweir } 230cdf0e10cSrcweir } 231cdf0e10cSrcweir} 232cdf0e10cSrcweir 233cdf0e10cSrcweirsub wanted 234cdf0e10cSrcweir{ 235cdf0e10cSrcweir my $file = $_; 236cdf0e10cSrcweir 237cdf0e10cSrcweir if ( $file =~ /.*\.png$/ && -f $file ) { 238cdf0e10cSrcweir push @custom_list, $File::Find::name; 239cdf0e10cSrcweir } 240cdf0e10cSrcweir} 241cdf0e10cSrcweir 242cdf0e10cSrcweirsub create_zip_list 243cdf0e10cSrcweir{ 244cdf0e10cSrcweir my $global_hash_ref = shift; 245cdf0e10cSrcweir my $module_hash_ref = shift; 246cdf0e10cSrcweir my $custom_hash_ref = shift; 247cdf0e10cSrcweir 248cdf0e10cSrcweir my %zip_hash; 249cdf0e10cSrcweir my @warn_list; 250cdf0e10cSrcweir 251cdf0e10cSrcweir print_message("assemble image list ...") if $verbose; 252cdf0e10cSrcweir foreach ( keys %{$global_hash_ref} ) { 253cdf0e10cSrcweir # check if in 'global' and in 'module' list and add to warn list 254cdf0e10cSrcweir if ( exists $module_hash_ref->{$_} ) { 255cdf0e10cSrcweir push(@warn_list, $_); 256cdf0e10cSrcweir next; 257cdf0e10cSrcweir } 258cdf0e10cSrcweir if ( exists $custom_hash_ref->{$_} ) { 259cdf0e10cSrcweir $zip_hash{$_} = $custom_hash_ref->{$_}; 260cdf0e10cSrcweir next; 261cdf0e10cSrcweir } 262cdf0e10cSrcweir # it's neither in 'module' nor 'custom', record it in zip hash 263cdf0e10cSrcweir $zip_hash{$_} = $global_path; 264cdf0e10cSrcweir } 265cdf0e10cSrcweir foreach ( keys %{$module_hash_ref} ) { 266cdf0e10cSrcweir if ( exists $custom_hash_ref->{$_} ) { 267cdf0e10cSrcweir $zip_hash{$_} = $custom_hash_ref->{$_}; 268cdf0e10cSrcweir next; 269cdf0e10cSrcweir } 270cdf0e10cSrcweir # it's not in 'custom', record it in zip hash 271cdf0e10cSrcweir $zip_hash{$_} = $module_path; 272cdf0e10cSrcweir } 273cdf0e10cSrcweir 274cdf0e10cSrcweir if ( @warn_list ) { 275cdf0e10cSrcweir foreach ( @warn_list ) { 276cdf0e10cSrcweir print_warning("$_ is duplicated in 'global' and 'module' list"); 277cdf0e10cSrcweir } 278cdf0e10cSrcweir } 279cdf0e10cSrcweir 280cdf0e10cSrcweir return \%zip_hash 281cdf0e10cSrcweir} 282cdf0e10cSrcweir 283cdf0e10cSrcweirsub is_file_newer 284cdf0e10cSrcweir{ 285cdf0e10cSrcweir my $test_hash_ref = shift; 286cdf0e10cSrcweir my $reference_stamp = 0; 287cdf0e10cSrcweir 288cdf0e10cSrcweir print_message("checking timestamps ...") if $verbose; 289cdf0e10cSrcweir if ( -e $out_file ) { 290cdf0e10cSrcweir $reference_stamp = (stat($out_file))[9]; 291cdf0e10cSrcweir print_message("found $out_file with $reference_stamp ...") if $verbose; 292cdf0e10cSrcweir } 293cdf0e10cSrcweir return 1 if $reference_stamp == 0; 294cdf0e10cSrcweir 295cdf0e10cSrcweir foreach ( sort keys %{$test_hash_ref} ) { 296cdf0e10cSrcweir my $path = $test_hash_ref->{$_}; 297cdf0e10cSrcweir $path .= "/" if "$path" ne ""; 298cdf0e10cSrcweir $path .= "$_"; 299cdf0e10cSrcweir print_message("checking '$path' ...") if $extra_verbose; 300cdf0e10cSrcweir my $mtime = (stat($path))[9]; 301cdf0e10cSrcweir return 1 if $reference_stamp < $mtime; 302cdf0e10cSrcweir } 303cdf0e10cSrcweir return 0; 304cdf0e10cSrcweir} 305cdf0e10cSrcweir 306cdf0e10cSrcweirsub optimize_zip_layout($) 307cdf0e10cSrcweir{ 308cdf0e10cSrcweir my $zip_hash_ref = shift; 309cdf0e10cSrcweir 310cdf0e10cSrcweir if (!defined $sort_file) { 311cdf0e10cSrcweir print_message("no sort file - sorting alphabetically ...") if $verbose; 312cdf0e10cSrcweir return sort keys %{$zip_hash_ref}; 313cdf0e10cSrcweir } 314cdf0e10cSrcweir print_message("sorting from $sort_file ...") if $verbose; 315cdf0e10cSrcweir 316cdf0e10cSrcweir my $orderh; 317cdf0e10cSrcweir my %included; 318cdf0e10cSrcweir my @sorted; 319cdf0e10cSrcweir open ($orderh, $sort_file) || die "Can't open $sort_file: $!"; 320cdf0e10cSrcweir while (<$orderh>) { 321cdf0e10cSrcweir /^\#.*/ && next; # comments 322cdf0e10cSrcweir s/[\r\n]*$//; 323cdf0e10cSrcweir /^\s*$/ && next; 324cdf0e10cSrcweir my $file = $_; 325cdf0e10cSrcweir if (!defined $zip_hash_ref->{$file}) { 326cdf0e10cSrcweir print "unknown file '$file'\n" if ($extra_verbose); 327cdf0e10cSrcweir } else { 328cdf0e10cSrcweir push @sorted, $file; 329cdf0e10cSrcweir $included{$file} = 1; 330cdf0e10cSrcweir } 331cdf0e10cSrcweir } 332cdf0e10cSrcweir close ($orderh); 333cdf0e10cSrcweir 334cdf0e10cSrcweir for my $img (sort keys %{$zip_hash_ref}) { 335cdf0e10cSrcweir push @sorted, $img if (!$included{$img}); 336cdf0e10cSrcweir } 337cdf0e10cSrcweir 338cdf0e10cSrcweir print_message("done sort ...") if $verbose; 339cdf0e10cSrcweir 340cdf0e10cSrcweir return @sorted; 341cdf0e10cSrcweir} 342cdf0e10cSrcweir 343cdf0e10cSrcweirsub create_zip_archive 344cdf0e10cSrcweir{ 345cdf0e10cSrcweir my $zip_hash_ref = shift; 346cdf0e10cSrcweir 347cdf0e10cSrcweir print_message("creating image archive ...") if $verbose; 348cdf0e10cSrcweir my $zip = Archive::Zip->new(); 349cdf0e10cSrcweir 350cdf0e10cSrcweir# FIXME: test - $member = addfile ... $member->desiredCompressionMethod( COMPRESSION_STORED ); 351cdf0e10cSrcweir# any measurable performance win/loss ? 352cdf0e10cSrcweir foreach ( optimize_zip_layout($zip_hash_ref) ) { 353cdf0e10cSrcweir my $path = $zip_hash_ref->{$_} . "/$_"; 354cdf0e10cSrcweir print_message("zipping '$path' ...") if $extra_verbose; 355cdf0e10cSrcweir my $member = $zip->addFile($path, $_); 356cdf0e10cSrcweir if ( !$member ) { 357cdf0e10cSrcweir print_error("can't add file '$path' to image zip archive: $!", 5); 358cdf0e10cSrcweir } 359cdf0e10cSrcweir } 360cdf0e10cSrcweir my $status = $zip->writeToFileNamed($tmp_out_file); 361cdf0e10cSrcweir if ( $status != AZ_OK ) { 362cdf0e10cSrcweir print_error("write image zip archive '$tmp_out_file' failed. Reason: $status", 6); 363cdf0e10cSrcweir } 364cdf0e10cSrcweir return; 365cdf0e10cSrcweir} 366cdf0e10cSrcweir 367cdf0e10cSrcweirsub replace_file 368cdf0e10cSrcweir{ 369cdf0e10cSrcweir my $source_file = shift; 370cdf0e10cSrcweir my $dest_file = shift; 371cdf0e10cSrcweir my $result = 0; 372cdf0e10cSrcweir 373cdf0e10cSrcweir $result = unlink($dest_file) if -f $dest_file; 374cdf0e10cSrcweir if ( $result != 1 && -f $dest_file ) { 375cdf0e10cSrcweir unlink $source_file; 376cdf0e10cSrcweir print_error("couldn't remove '$dest_file'",1); 377cdf0e10cSrcweir } else { 378cdf0e10cSrcweir if ( !rename($source_file, $dest_file)) { 379cdf0e10cSrcweir unlink $source_file; 380cdf0e10cSrcweir print_error("couldn't rename '$source_file'",1); 381cdf0e10cSrcweir } 382cdf0e10cSrcweir } 383cdf0e10cSrcweir return; 384cdf0e10cSrcweir} 385cdf0e10cSrcweir 386cdf0e10cSrcweirsub usage 387cdf0e10cSrcweir{ 388cdf0e10cSrcweir print STDERR "Usage: packimages.pl [-h] -o out_file -g g_path -m m_path -c c_path -l imagelist_path\n"; 389cdf0e10cSrcweir print STDERR "Creates archive of images\n"; 390cdf0e10cSrcweir print STDERR "Options:\n"; 391cdf0e10cSrcweir print STDERR " -h print this help\n"; 392cdf0e10cSrcweir print STDERR " -o out_file path to output archive\n"; 393cdf0e10cSrcweir print STDERR " -g g_path path to global images directory\n"; 394cdf0e10cSrcweir print STDERR " -m m_path path to module images directory\n"; 395cdf0e10cSrcweir print STDERR " -c c_path path to custom images directory\n"; 396cdf0e10cSrcweir print STDERR " -s sort_file path to image sort order file\n"; 397cdf0e10cSrcweir print STDERR " -l imagelist_path path to directory containing image lists (may appear mutiple times)\n"; 398cdf0e10cSrcweir print STDERR " -v verbose\n"; 399cdf0e10cSrcweir print STDERR " -vv very verbose\n"; 400cdf0e10cSrcweir} 401cdf0e10cSrcweir 402cdf0e10cSrcweirsub print_message 403cdf0e10cSrcweir{ 404cdf0e10cSrcweir my $message = shift; 405cdf0e10cSrcweir 406cdf0e10cSrcweir print "$script_name: "; 407cdf0e10cSrcweir print "$message\n"; 408cdf0e10cSrcweir return; 409cdf0e10cSrcweir} 410cdf0e10cSrcweir 411cdf0e10cSrcweirsub print_warning 412cdf0e10cSrcweir{ 413cdf0e10cSrcweir my $message = shift; 414cdf0e10cSrcweir 415cdf0e10cSrcweir print STDERR "$script_name: "; 416cdf0e10cSrcweir print STDERR "WARNING $message\n"; 417cdf0e10cSrcweir return; 418cdf0e10cSrcweir} 419cdf0e10cSrcweir 420cdf0e10cSrcweirsub print_error 421cdf0e10cSrcweir{ 422cdf0e10cSrcweir my $message = shift; 423cdf0e10cSrcweir my $error_code = shift; 424cdf0e10cSrcweir 425cdf0e10cSrcweir print STDERR "$script_name: "; 426cdf0e10cSrcweir print STDERR "ERROR: $message\n"; 427cdf0e10cSrcweir 428cdf0e10cSrcweir if ( $error_code ) { 429cdf0e10cSrcweir print STDERR "\nFAILURE: $script_name aborted.\n"; 430cdf0e10cSrcweir exit($error_code); 431cdf0e10cSrcweir } 432cdf0e10cSrcweir return; 433cdf0e10cSrcweir} 434