diff --git a/Yard.pm b/Yard.pm index 7867871..6fd17e4 100644 --- a/Yard.pm +++ b/Yard.pm @@ -54,6 +54,16 @@ my $objcopy = "objcopy"; my($Warnings) = 0; my $verbosity; +# This solves an annoying problem with the new Perl-5.6 built in glob, +# allowing earlier versions of Perl to run. +# But the new glob is a good thing for this program since it doesn't have to +# depend on outside programs, making Tom's test_glob() history. +BEGIN { + if ($] =~ /006/) { + require File::Glob; + } +} + STDOUT->autoflush(1); sub warning { @@ -61,20 +71,6 @@ sub warning { $Warnings++; } -# This is a good thing to be used for all device checking in -# gBootRoot, but it may be restrictive since sometimes it is a -# good thing to mount a whole device .. cdroms for instance. -# Check for sane device choice before we start using it. -#@@ check_device(); - -# Make sure $::device isn't already mounted and $::mount_point is free -#@@ load_mount_info(); - -# Have to test this every time so we can work around. -## This will get replaced with a readdir loop, no sense relying on people's -## shells. Anotherwards, yard_glob get changed. -#@@ test_glob(); - ## REQUIRES $kernel opt. $kernel_version sub kernel_version_check { @@ -121,7 +117,7 @@ sub kernel_version_check { ## cf_die, must_be_abs, replaced_by, yard_glob ## REQUIRES $contents_file sub read_contents_file { - + my ($contents_file) = @_; info(0, "\n\nPASS 1: Reading $contents_file"); @@ -132,6 +128,7 @@ sub read_contents_file { my($line); LINE: while (defined($line = )) { + my(@files); $cf_line++; chomp $line; @@ -155,14 +152,14 @@ sub read_contents_file { ##### call include_file until pass two after all explicit links ##### have been seen. my($abs_file) = find_file_in_path($file); - $Included{$abs_file} = 1; + $Included{$abs_file} = 1 if $abs_file; #### Have to be careful here. Record the rel link for use #### in setting up the root fs, but use the abs_link in @files #### so next loop gets any actual files. my($abs_link) = make_link_absolute($abs_file, $link); my($rel_link) = make_link_relative($abs_file, $link); - $links_to{$abs_file} = $rel_link; - info(1, "$line links $abs_file to $rel_link\n"); + $links_to{$abs_file} = $rel_link if $abs_file; + info(1, "$line links $abs_file to $rel_link\n") if $abs_file; @files = ($abs_link); } elsif ($line =~ /<=/) { ##### REPLACEMENT SPEC @@ -209,8 +206,8 @@ sub read_contents_file { for $expr (split(' ', $line)) { my(@globbed) = yard_glob($expr); if ($#globbed == -1) { - cf_warn($contents_file, $line, - "Warning: No files matched $expr"); + cf_warn($contents_file, $expr, + "Warning: No files matched $line"); } elsif (!($#globbed == 0 and $globbed[0] eq $expr)) { info(1, "Expanding $expr to @globbed\n"); } @@ -893,6 +890,7 @@ sub sys { 0; # like system() } +## history sub load_mount_info { undef %::mounted; undef %::fs_type; @@ -955,7 +953,7 @@ sub find_file_in_path { if (!@path) { ##### Initialize @pathlist if necessary - if (!defined(@pathlist)) { + if (!@pathlist) { @pathlist = split(':', $ENV{'PATH'}); if (defined(@::additional_dirs)) { unshift(@pathlist, @::additional_dirs); @@ -1012,6 +1010,7 @@ sub make_link_relative { my($abs_file, $link) = @_; my($newlink); + if ($abs_file) { if ($link =~ m|^/(.*)$|) { # It's absolute -- we have to relativize it # The abs_file guaranteed not to have any funny @@ -1023,17 +1022,21 @@ sub make_link_relative { $newlink = $link; } cleanup_link($newlink); + } } # I don't know if this information is worth caching. my(%path_length); sub path_length { my($path) = @_; - return $path_length{$path} if defined($path_length{$path}); - my($length) = -1; - while ($path =~ m|/|g) { $length++ } # count slashes - $path_length{$path} = $length; - $length + + if ($path) { + return $path_length{$path} if defined($path_length{$path}); + my($length) = -1; + while ($path =~ m|/|g) { $length++ } # count slashes + $path_length{$path} = $length; + $length + } } @@ -1169,11 +1172,14 @@ sub kernel_version { # it can also be something like 2.2.15-27mdk. Don't make any assumptions # except that beginning must be dotted triple and it's space delimited. my($version) = $str =~ /^(\d+\.\d+\.\d+\S*)\s/; + return $version + } } +## HISTORY ##### Eventually move this into configure since it doesn't have to be ##### done with every make_root_fs. But yard_glob would have to be ##### configured, and yard_utils.pl isn't configured. @@ -1193,11 +1199,11 @@ sub test_glob { } } - ##### Check glob() -- In some Perl versions it's reported not to work. sub yard_glob { my($expr) = @_; + ## first part HISTORY if ($glob_broken) { my($line) = `echo $expr`; chop($line);