#!/usr/local/bin/perl # # Simple-minded little Perl 4 script to extract specific files from the tar # file that contains the Database for Galaxy Evolution Modeling, Leitherer # et al., PASP, 108, 996, on the AAS CD-ROM Series, Volume VII. # # AUTHOR: Lee E. Brotzman, Advanced Data Solutions # # USAGE NOTES # # The script assumes that it is being started from the CD-ROM directory # that contains the tar file, table of contents, and this script. # The user provides the script with the output directory to extract # the files into and the prefix for the files. One should consult table.doc # in this directory for a listing of the components of the database and their # prefixes. # # If your system does not set execute permission for files on CD-ROM, # or if your version of perl is in a location other /usr/local/bin/perl, # you can invoke the script directly as follows: # # $ perl extract.pl output-dir prefix # # See the usage message below. # # This script has been tested under perl4.036 and perl5.001 under Solaris and # Linux; it should work pretty well under other OS's, too, except possibly a # DOS/Windows or Mac system without Perl or tar programs. The algorithm is # quite simple: it compares the given prefix against the database directory # listing in the file database.toc. Every matching file name is saved in a # list and then the tar command is used to extract only those files. require 'pwd.pl'; # Use the old-style directory handler &initpwd; $cdrom_dir = $ENV{'PWD'}; # What is this directory path? if ($#ARGV < 1) { # Print usage if no arguments given print "Usage: perl extract.pl output-dir prefix\n"; print "Example: perl extract.pl ~/database ALRV\n"; exit 0; } die "Output directory $ARGV[0] does not exist?!" unless -d $ARGV[0]; # Load the file names from the table of contents $files = &loadTOC($ARGV[1]); die "No files matching $ARGV[1] found ?!" unless length($files); # Now change to the output directory and extract the requested files &chdir($ARGV[0]); $database = "$cdrom_dir/database.tar"; system("tar -xvf $database $files"); exit; # This subroutine will either return an array of filenames or a scalar string # of blank-separated filenames, depending on the context. sub loadTOC { local($prefix) = shift; # Just in case the user used the trailing asterisk that appears in the # list of datasets in table.doc, trim it off here (it will mess with # the pattern matching) chop($prefix) if $prefix =~ /\*$/; open(TOC, "$cdrom_dir/database.toc") || die "Could not open file $cdrom_dir/database.toc"; local(@files); local($line); $line = ; # Skip the first line while ($line = ) { # Go through each line and snip the file name chop $line; if ($line =~ /.{45}$prefix/) { # Save the name if it matches the prefix push(@files, substr($line,45)); } } return wantarray ? @files : join(' ', @files); }