Namespace cleaning, 5 subs are now exported.

Yard.pm

@@ -31,7 +31,9 @@ package Yard;
 use vars qw(@ISA @EXPORT %EXPORT_TAGS);
 use Exporter;
 @ISA = qw(Exporter);
-@EXPORT =  qw();
+@EXPORT =  qw(kernel_version_check read_contents_file extra_links 
+              library_dependencies hard_links space_check
+              create_filesytem);
 
 use strict;
 use File::Basename;
@@ -39,75 +41,23 @@ use File::Path;
 use FileHandle;
 use Cwd; #  I am not even sure if this is being used here now
 use English;  # I think this can be ditched for portability
-#use lib "@config_dest@", "@lib_dest@";
-#use yardconfig;# this exports these things $scripts_dest 
-                # $lib_dest $config_dest %_path
 use File::Find; # used by check_root_fs
 
-# YARDCONFIG.PM
+my (%Included, %replaced_by, %links_to, %is_module, %hardlinked, 
-##########################################
+    %strippable, %lib_needed_by, @Libs);
-##########################################
+my $cf_line = 0;
-
+my $BLKGETSIZE_ioctl = 4704; 
-#$scripts_dest = "@scripts_dest@";
+my $BLKFLSBUF_ioctl  = 4705; 
-#$lib_dest     = "@lib_dest@";
+my $EXT2_BLOCK_SIZE  = 1024; 
-#$config_dest  = "@config_dest@";
+my $INODE_SIZE       = 1024;
-
+my $objcopy = "objcopy";
-#unshift(@::INC, $config_dest);
-
-# Ironically this is only used once for objcopy.    
-#%_path =( 'perl'	 => '@PERL@',
-#	  'ldd'		 => '@LDD@',
-#	  'ldconfig'	 => '@LDCONFIG@',
-#	  'chroot'	 => '@CHROOT@',
-#	  'sync'	 => '@SYNC@',
-#	  'mount'	 => '@MOUNT@',
-#	  'umount'	 => '@UMOUNT@',
-#	  'rm'		 => '@RM@',
-#	  'dd'		 => '@DD@',
-#	  'mke2fs'	 => '@MKE2FS@',
-#	  'rdev'	 => '@RDEV@',
-#	  'gzip'	 => '@GZIP@',
-#	  'uname'	 => '@UNAME@',
-#	  'objcopy'	 => '@OBJCOPY@'
-#	);
-
-############################################
-############################################
-# Probably will make this local .. actually don't need them
-
-# FROM YARD_UTILS.PL
-
-# constant.pm not introduced until 5.003_96, so these are
-# just global variables.
-# Constants from /usr/src/linux/arch/i386/kernel/setup.c:
-#$::RAMDISK_IMAGE_START_MASK   =	0x07FF;
-#$::RAMDISK_PROMPT_FLAG        =	0x8000;
-#$::RAMDISK_LOAD_FLAG          = 0x4000;
-
-# ioctls from /usr/include/linux/fs.h:
-#$::BLKGETSIZE_ioctl = 4704;
-#$::BLKFLSBUF_ioctl  = 4705;
-
-# ext2 fs constants, both in bytes
-#$::EXT2_BLOCK_SIZE   = 1024;
-#$::INODE_SIZE        = 1024;
-
-##########################
-###########################
-
-# BEGIN { require "yard_utils.pl"; }
-# Supplied by gBootroot
-#require "Config.pl";
 
 STDOUT->autoflush(1);
 
-start_logging_output();
+#@@ start_logging_output();
 
-info(0, "root_fs\n");
+#@@ info(0, "root_fs\n");
-info(1, "(running under Perl $PERL_VERSION)\n");
+#@@ info(1, "(running under Perl $PERL_VERSION)\n");
-
-#my($objcopy) = $_path{'objcopy'}; # Define objcopy path if executable exists
-my $objcopy = "objcopy";
 
 my($Warnings) = 0;
 sub warning {
@@ -144,40 +94,67 @@ sub warning {
 # 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();
+#@@ check_device();
 
 #  Make sure $::device isn't already mounted and $::mount_point is free
-load_mount_info();
+#@@ load_mount_info();
 
-if (defined($::mounted{$::device})) {
+## This is put here for reference, and is from Config.pl
+## loopback is the standard for building a filesytem in gBootRoot.
+##  No choice here.
+#  $device: string (device name)
+#
+#  The device for building the filesystem.  This can be /dev/ram0 or a        
+#  spare partition.  You can turn off swapping temporarily and use the
+#  swap partition on your hard disk.  You can use a loopback device if
+#  your kernel supports them -- see the section "Using a Loopback
+#  Device" in the Yard documentation for instructions.
+#  It should not be a symbolic link.                
+#                                    
+#$device =           "/dev/ram0";
 
-  if ($::mounted{$::device} eq $::mount_point) {
+#if (defined($::mounted{$::device})) {
-    #info(1, "Device $::device is already mounted on $::mount_point\n");
-    info(1, "Unmounting it automatically.\n");
-    sys("umount $::mount_point");
 
-  } else {
+#  if ($::mounted{$::device} eq $::mount_point) {
-    error("$::device is already mounted elsewhere (on $::mounted{$::device})\n",
+#    #info(1, "Device $::device is already mounted on $::mount_point\n");
-	  "Unmount it first.\n");
+#    info(1, "Unmounting it automatically.\n");
-  }
+#    sys("umount $::mount_point");
+
+#  } else {
+#    error("$::device is already mounted elsewhere (on $::mounted{$::device})\n",
+#	  "Unmount it first.\n");
+#  }
+
+#} elsif (defined($::mounted{$::mount_point})) {
+#  error("Some other device is already mounted on $::mount_point\n");
+#}
 
-} elsif (defined($::mounted{$::mount_point})) {
-  error("Some other device is already mounted on $::mount_point\n");
-}
 
 #  Have to test this every time so we can work around.
-test_glob();
+## This will get replaced with a readdir loop, no sense relying on people's
+## shells.  Anotherwards, yard_glob get changed.
+#@@ test_glob();
 
 #####  Determine release of $::kernel for modules.
 #####  Set RELEASE environment variable for use in contents.
+## Still need an option for this, may become part of beginners section.
+
+## uses kernel_version .. will probably just run these in relation to
+## gBootRoots checks.
+## 'use Yard; $kernel = "/root/HDB/vmlinuz-2.2.14-ncr"; $kernel_version = "1.2"; kernel_version_check();
+## requires $kernel && $kernel_version
+sub kernel_version_check {
+
     if (defined($::kernel_version)) {
 	#  Check to see if it agrees
 	my($version_guess) = kernel_version($::kernel);
 	if ($version_guess ne $::kernel_version) {
-     # info(0, 
+            ## Is this really necessary, it can be assumed a person knows
-     # "You declared kernel ($::kernel) to be version $::kernel_version\n",
+            ## what they are doing.
-     # "\teven though a probe says $version_guess.",
+	    info(0, 
-     # "\tI'll assume you're right.\n";)
+	    "You declared kernel $::kernel to be version $::kernel_version\n",
+	    "even though a probe says $version_guess.",
+	    "  I'll assume you're right.\n")
 	}
 	$ENV{'RELEASE'} = $::kernel_version;
 
@@ -197,29 +174,41 @@ if (defined($::kernel_version)) {
 	}
     }
 
-warn_about_module_dependencies($ENV{'RELEASE'});
+} # end sub kernel_version 
 
-if ($::disk_set !~ /^(single|double|base\+extra)$/) {
+## This checks lib/modules/$version for rd.o, ext2.o, floppy.o
-  error("Config variable disk_set is set to \"$::disk_set\"\n",
+## Perhaps just extra stuff, this could be made real fancy, too.
-	"which is not a valid value.\n");
+#@@warn_about_module_dependencies($ENV{'RELEASE'});
-}
+
+## gBootRoot does this as a separate process
+#if ($::disk_set !~ /^(single|double|base\+extra)$/) {
+#  error("Config variable disk_set is set to \"$::disk_set\"\n",
+#	"which is not a valid value.\n");
+#}
+
+############################
+#####  READ IN CONTENTS FILE
+############################
+
+## uses info, resolve_file, error, cf_warn, make_link_absolute,
+## make_link_relative, cf_die, must_be_abs, replaced_by, yard_glob,
+## include_file
+## requires $contents_file
+
+sub read_contents_file {
 
-##############################################################################
-#####  READ IN CONTENTS FILE                                             #####
-##############################################################################
     my($contents_file) = resolve_file($::contents_file);
     info(0, "\n\nPASS 1:  Reading $::contents_file");
     #info 0, " ($contents_file)" if $contents_file ne $::contents_file;
     info(0, "\n");
 
-my(%Included);
+    #my(%Included);
-my(%replaced_by);
+    #my(%replaced_by);
-my(%links_to);
+    #my(%links_to);
-my(%is_module);
+    #my(%is_module);
 
     open(CONTENTS, "<$contents_file") or error("$contents_file: $!");
 
-my($cf_line) = 0;
     my($line);
 
   LINE: while (defined($line = <CONTENTS>)) {
@@ -232,11 +221,6 @@ LINE: while (defined($line = <CONTENTS>)) {
       $line =~ s/^\s+//;		# Delete leading/trailing whitespace
       $line =~ s/\s+$//;
 
-#  if ($line =~ /\$RELEASE/) {
-#    cf_warn($line, "Make sure \$RELEASE ($ENV{'RELEASE'}) is correct " .
-#	           "for $::kernel");
-#    }
-
       if ($line =~ /->/) {	#####  EXPLICIT LINK
 	  if ($line =~ /[\*\?\[]/) {
 	      cf_warn($line, "Can't use wildcards in link specification!");
@@ -346,14 +330,20 @@ LINE: while (defined($line = <CONTENTS>)) {
 
     info(0, "\nDone with $contents_file\n\n");
 
-if ($::disk_set eq "base+extra") {
+##if ($::disk_set eq "base+extra") {
-  include_file(find_file_in_path("tar"))
+##  include_file(find_file_in_path("tar"))
-}
+##}
 
     close(CONTENTS) or error("close on $contents_file: $!");
 
+## may or may not include this in read_contents_file
+
+} # end read_contents_file
+
+#####################################
+
+sub extra_links {
 
-##############################################################################
     info(0, "\n\nPASS 2:  Picking up extra files from links...\n");
 
     for (keys %Included) {
@@ -361,8 +351,12 @@ for (keys %Included) {
     }
 
     info(0, "Done.\n\n");
+}
 
-##############################################################################
+
+#####################################
+
+sub library_dependencies {
 
     info(0, "PASS 3:  Checking library dependencies...\n");
     info(1, "(Ignore any 'statically linked' messages.)\n");
@@ -371,9 +365,6 @@ info(1, "(Ignore any 'statically linked' messages.)\n");
     #  X -> Y:  X in %links_to, Y in %Included
     #  X <= Y:  X in %Included and %replaced_by
 
-my(%strippable);
-my(%lib_needed_by);
-
     my($file);
     foreach $file (keys %Included) {
 
@@ -408,6 +399,7 @@ foreach $file (keys %Included) {
 
 	    #####  EXECUTABLE LOADABLE BINARY
 	    #####  Run ldd to get library dependencies.
+	    my $line;
 	    foreach $line (`ldd $file`) {
 		my($lib) = $line =~ / => (\S+)/;
 		next unless $lib;
@@ -446,10 +438,10 @@ foreach $file (keys %Included) {
 	}
     }
 
-##############################################################################
+    ####################################
-#####  Check libraries and loader(s)                                     #####
+    #####  Check libraries and loader(s)
-##############################################################################
+    ####################################
-my(@Libs) = keys %lib_needed_by;
+    (@Libs) = keys %lib_needed_by;
 
     my($seen_ELF_lib, $seen_AOUT_lib);
     my(%full_name);
@@ -484,7 +476,7 @@ if (@Libs) {
 		}
 		$line .= $binary . " ";
 	    }
-	#info(1, $line, "\n" if $line);
+	    ##info(1, $line, "\n" if $line);
 
 	    if (!($seen_ELF_lib and $seen_AOUT_lib)) {
 
@@ -544,10 +536,15 @@ if ($seen_AOUT_lib) {
 
     info(0, "Done\n\n");
 
+} # end sub library_dependencies
+
+sub hard_links {
+
     info(0, "PASS 4:  Recording hard links...\n");
 
     #####  Finally, scan all files for hard links.
-my(%hardlinked);
+
+    my($file);
     foreach $file (keys %Included) {
 
 	next if $links_to{$file} or $replaced_by{$file};
@@ -564,11 +561,17 @@ foreach $file (keys %Included) {
 
     info(0, "Done.\n\n");
 
-##############################################################################
+} # end sub hard_links
+
+##########################
+
+sub space_check {
+
     info(0, "Checking space needed.\n");
     my($total_bytes) = 0;
     my(%counted);
 
+    my ($file);
     foreach $file (keys %Included) {
 
 	my($replacement, $devino);
@@ -600,8 +603,8 @@ foreach $file (keys %Included) {
 	    }
 
 	} elsif (-d $file) {
-      $total_bytes += $::INODE_SIZE;
+	    $total_bytes += $INODE_SIZE;
-      info(1, "Directory $file = ", $::INODE_SIZE, " bytes\n");
+	    info(1, "Directory $file = ", $INODE_SIZE, " bytes\n");
 
 	} elsif ($file =~ m|^/proc/|) {
 	    #####  /proc files screw us up (eg, /proc/kcore), and there's no
@@ -631,14 +634,22 @@ if (bytes_to_K($total_bytes) > $::fs_size) {
 
     info(0, "\n");
 
-##############################################################################
+} # end sub space_check
-#####  Create filesystem
-##############################################################################
-sync();
-sys("dd if=/dev/zero of=$::device bs=1k count=$::fs_size");
-sync();
 
-#info(0, "Creating ${::fs_size}K ext2 file system on $::device\n");
+#######################
+#####  Create filesystem
+########################
+#@@sync();
+#@@sys("dd if=/dev/zero of=$::device bs=1k count=$::fs_size");
+#@@sync();
+
+
+# This could be broken up into a lot of functions
+sub create_filesystem {
+
+    my $file;
+
+    ##info(0, "Creating ${::fs_size}K ext2 file system on $::device\n");
 
     if (-f $::device) {
 	#####  If device is a plain file, it means we're using some loopback
@@ -654,7 +665,6 @@ sys("rm -rf $::mount_point/lost+found");
 
     sync();
 
-
     #####  Setting up the file structure is tricky.  Given a tangled set
     #####  of symbolic links and directories, we have to create the
     #####  directories, symlinks and files in the right order so that no
@@ -712,7 +722,6 @@ info(0, "\nCopying files to $::device\n");
 
     my(%copied);
 
-my($file);
     while (($file) = each %Included) {
 	my($floppy_file) = $::mount_point . $file;
 
@@ -769,8 +778,6 @@ while (($file) = each %Included) {
     }
 
 
-##############################################################################
-
     info(0, "\nFinished creating root filesystem.\n");
 
     if (@Libs) {
@@ -786,7 +793,8 @@ info(0, "\nDone with $PROGRAM_NAME.  $Warnings warnings.\n",
 
     exit( $Warnings>0 ? -1 : 0);
 
-
+} # end sub create_filesystem
+
 #############################################################################
 #####  Utility subs for make_root_fs.pl
 #############################################################################
@@ -900,15 +908,14 @@ sub copy_strip_file {
 ##############################################################
 ##############################################################
 ##############################################################
-
 ###############################################################
 ###############################################################
 
-##############################################################################
+########################################################
 ##
 ##      YARD_UTILS.PL -- Utilities for the Yard scripts.
 ##
-##############################################################################
+########################################################
 
 
 # Get device number of /proc filesystem
@@ -1124,7 +1131,7 @@ sub get_device_size_K  {
 
   my($result) = pack("L", 0);
   open(FD, $device) or die "open($device): $!";
-  my($return) = ioctl(FD, $::BLKGETSIZE_ioctl, $result);
+  my($return) = ioctl(FD, $BLKGETSIZE_ioctl, $result);
   close(FD);
   if ($return) {
     my($bytes) = unpack("L", $result) * $DEV_BSIZE;
@@ -1147,7 +1154,7 @@ sub flush_device_buffer_cache {
   my($device) = @_;
   my($junk) = "stuff";
 
-  open(FD, $device) && ioctl(FD, $::BLKFLSBUF_ioctl, $junk);
+  open(FD, $device) && ioctl(FD, $BLKFLSBUF_ioctl, $junk);
   close(FD);
 }
 
@@ -1243,7 +1250,7 @@ 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/;
-    $version
+    return $version
   }
 }
 
@@ -1378,10 +1385,10 @@ sub bytes_allocated {
 
   my($size) = -s $file;
 
-  if ($size % $::EXT2_BLOCK_SIZE == 0) {
+  if ($size % $EXT2_BLOCK_SIZE == 0) {
     $size
   } else {
-    (int($size / $::EXT2_BLOCK_SIZE) + 1) * $::EXT2_BLOCK_SIZE
+    (int($size / $EXT2_BLOCK_SIZE) + 1) * $EXT2_BLOCK_SIZE
   }
 }
 
@@ -1976,4 +1983,4 @@ sub check_termcap {
 }
 
 #####  END OF CHECK_ROOT_FS
-=end
+=cut