#!/usr/local/bin/perl -w # Walk dependency tables to do rebuilds. # (sort of a Unix "make" replacement.) # Author: John Halleck. # Copyright 2000 by John Halleck. # Feel free to use this code for non-commercial purposes. # (That means don't sell it... commercial companies using it in house is fine) # I suspect a current copy of this is availiable at # http://www.cc.utah.edu/~nahaj/utilities/ =head1 NAME rebuild - perl script to do unix "make" style operations with a much more powerfull and interesting syntax. =head1 SYNOPSIS rebuild {targets} General options. -a Show processing of action lines.. -A '... => ...' Provide an action line. -b Brief output -d Debugging -e Suppress Echoing of commands -m Show macro assignments -M '...=...' Make macro assignment -o file Output file for copy of commands -v Verbose output -V Version of rebuild "Make" related options. -c file Config file -f Force rebuild of everything -F Force rebuild of things older than config file -l Annotated Listing -make file Produce a Unix Make compatable output. -n Don't do the build -N Don't do partial build if missing prerequisites -r List reasons for building target -R List reasons for considering target -s Summary information Misc. Topics: =head1 DESCRIPTION This started as a sort of replacement for Unix make. The syntax was chosen to make it easier to do certain sorts of operations that I do frequently.. It was later pointed out that the syntax was usefull "as is" for little "one-liner" system housekeeping operations. So this product has idled as that project is worked on. Comments are done with a line starting with "#". They may not be put on command lines.... (Sorry, but the issues were way to grim... Macro expansion and replacement takes place between any unquoted { ... } pair on a line. A pair can be shielded from evaluation by marking them with a backslash. For example: \{ ... } will not be evaluated. Filtering of lists is possible. For example, { dir(.) | -f | minus(*.c) } returns a list of all the files in the current directory that don't have *.c extensions. { dir(.) | -d | only(test*) } returns a list of all the sub directory names that start with "test" in the current directory. { dir(.) | *.c => *.o} returns a *.o file name for each *.c file in the current directory. Filters: (Borrowed from Perl) -f !-f files -d !-d directories -e !-e existing files. -z !-z Zero size. -l !-l Link -S !-S Socket -p !-p Pipes. List modifiers: only() Only the forms lists. minus() Everything except the forms listed. plus() Add these files on. unique() Only one copy of things. Pattern match: pattern => output is only those things matching the pattern, are are rewritten to the output pattern. Patterns are text with at most one embedded "*". For example: *.txt => *.wrd =head1 EXAMPLES { dir(.) | -f | minus(*.c) } returns a list of all the files in the current directory that don't have *.c extensions. { dir(.) | -d | only(test*) } returns a list of all the directory names that start with "test". { dir(.) | only(test*) only(*.c) } files that start with "test" *OR* that end in ".c" { dir(.) | only(test*) only(*.c) | unique() } same list with duplicates removed. { dir(.) | *.c => *.o} returns a *.o file name for each *.c file in the current directory. { dir(.) | *.c => *.o | -e } Same as above, but only returns name if the .o file exists. { dir (.) | *.c => *.h | -e | *.h => *.c } List of the .c files that have matching .h files. { dir (.) | *.c => *.h | !-e | *.h => *.c } A list of the .c files that DON'T have matching .h files. { dir(.) | -f | -z } List of all zero length files. { dir(.) | -f -z } List of things that are files *OR* have zero length. =head1 GENERAL MACROS All environment variables are imported as macros. In addition, we have: LOGIN - User name we are running as. THISDIRECTORY - What the current directory is. (for example '/home/users/nahaj') DIRECTORYNAME - Short form of above (for the above example 'nahaj') REBUILD - Name this program was invoked with OPTIONS - options this program was invoked with. TARGETS - what was it asked to build? REBUILDFILE - What configuration file are we processing. REBUILDFILEAGE - Age of rebuild file. DATE - A current date string suitable for printing. DATESUFFIX - A date that can be used in a filename 19990716 DEFINES - List of current defines. CC - CC compiler, if any. CFLAGS - 'Standard' flags. SHELL - Unix shell SHELLOPTIONS - Default options for it. =head1 EXECUTION MACROS children - Files that depend on this. parents - Files that this depends on. ancestors - All files this depends on (including who parents depend on.) newparents - Files newer than us that we depend on. file - The file name part of the current target. target - The full name of the current target. =head1 COMMANDS include file - include the contents of a file here. define MACRONAME as .... - define a macro. define MACRONAME nill definition. targets <= parents - Define dependencies. => code - and code to execute to create the node. => code => ... target : parents - Alternate form of the above (For consistancy with makedepend) =head1 AUTHOR John Halleck =head1 COPYRIGHT (C) Copyright 2000 by John Halleck =cut # ============================================================================== # ============================================================================== require 5.004; # I use foreach my $variable (... use strict; # Let us promote good programming practice. # Note also -w in the invocation line. # ============================================================================== # Deal with command line input and options. use vars qw ( $VERSION ) ; $VERSION = "rebuild 0.05.03 from 2001-04-07T18:00:00-6.00 John Halleck"; # Added nil define, made names more flexable. # $VERSION = "rebuild 0.05.02 from 2000-04-24T18:00:00-6.00 John Halleck"; # Removed includeq, added ability to have macros on include line. # $VERSION = "rebuild 0.05.01 from 2000-03-13T17:00:00-7.00 John Halleck"; # Added includeq for possible includes. # $VERSION = "rebuild 0.04.10 from 2000-03-06T17:00:00-7.00 John Halleck"; # Fixed bad line numbers on "at line xxx" messages. # $VERSION = "rebuild 0.04.09 from 2000-03-01T18:20:00-7.00 John Halleck"; # Unix Make bug fixes. Addition of DIRECTORYNAME macro. # $VERSION = "rebuild 0.04.08 from 2000-01-18T17:15:00-7.00 John Halleck"; # Bug fixes in Command Line Macros. # Unix Make output added. # $VERSION = "rebuild 0.04.07 from 1999-09-23T17:20:00-7.00 John Halleck"; # Made non-existant macro return {NAME} instead of NAME # $VERSION = "rebuild 0.04.06 from 1999-09-13T17:00:00-7.00 John Halleck"; # Made non-existant target give an error message. # $VERSION = "rebuild 0.04.05 from 1999-08-17T17:00:00-7.00 John Halleck"; # Added continuation lines. # $VERSION = "rebuild 0.04.04 from 1999-07-28T15:43:00-7.00 John Halleck"; # Move "force" flag test to after status update. # $VERSION = "rebuild 0.04.03 from 1999-07-26T12:00:00-7.00 John Halleck"; # Tracking down pattern match bug. # $VERSION = "rebuild 0.04.02 from 1999-07-14T16:22:00-7.00 John Halleck"; # If a parent is rebuilt, all the children of that parent must be. # Added more documentation. # $VERSION = "requild 0.04.01 From 1999-03-12T18:00:00-7.00 John Halleck"; # Fixed some argumentless functions to have empty ()'s. # $VERSION = "rebuild 0.04.00 From 1998-12-14T18:00:00-7:00 John Halleck"; # Futzed some time zone stuff. It now matches ISO-8601 (With offset) # Added first code to support command line actions. # Added first code to prepare for it having a real parser. # Added first code to handle list => command # style lines. # Added some default POD stuff for Perl. # Added -z -l -S -p # 0.03.05 1998-11-12T17:00:00-7:00 # Optimized late expansion of pedigrees. # Added code to report circular dependencies. # Disentangled -v and -d options a little bit. # 0.03.04 1998-11-12T10:00:00-7:00 # Modified order of some parse rules in input file processing. # (Match specifics before default cases) # Modified rules for existant out of date files with no instructions. # 0.03.03 1998-11-11T10:00:00-7:00 # Changed searchfile path to look in Rebuild.host.THISHOSTSNAME # and Rebuild.user.THISUSERSNAME before going after default config # file. # (To help support fork with remotely mounted file systems.) # Moved load of command line macros to after environment macros. # (To let command line override environment.) # Renamed some variables for readability. # Let macro define on command line have full macro forms instead # of just allowing text. # Expanded pattern match allowable forms. # 0.03.02 1998-11-10T17:00:00-7:00 # Misc bug fixes to dependency list handling. # 0.03.01 1998-11-09T10:00:00-7:00 # More rework of pattern match. # 0.03.00 1998-11-07T17:00:00-7:00 # Redid pattern match stuff. # 0.02.08 1998-11-01T21:00:00-7:00 # Fixed misc macro bugs. # Fixed build bug. (Expand pedigree on walking build tree) # 0.02.08 1998-10-30T20:00:00-7:00 # Added conditional macros. # Enabled List operations. # Redid some "node to build" housekeeping. # 0.02.07 1998-10-28T20:00:00-7:00 # Tracked down -r build bug, fixed. # Build order changes. # 0.02.06 1998-10-26T17:00:00-7:00 # Rethought shell options. # Added pattern match to targets instead of just tree nodes. # Corrected error output to not print line if file completely read. # Corrected date to marginally match ISO8601 # Redid some cases of pattern match to be more obvious. # Added degenerate match. # 0.02.04 # Pipe symbol to separate macro filters. (Instead of space) # Allow targets to use ":" notation to match makedepend's output. # Rewrote IO to allow include files. Added include files. # 0.02.03 # Rethinking macro defaults. # Added CFLAGS # Rethinking "list intersection" # 0.02.02 # Redid "Must Build" inheritence. # 0.02.01 # Added computational macros. # Add *.ext output pattern match. # ---------------------------------------------------------------- # Default environment processing. use vars qw ( $hostname $username $thisdirectory $thisdirectoryname $thistimezone ); # Process environment # What is the portable way to do hostname??? $hostname = `hostname`; $hostname = '' if !defined $hostname; chomp $hostname; $username = getlogin; $username = '' if !defined $username; $thisdirectory = $ENV{'PWD'}; $thisdirectory = './' if !defined $thisdirectory; if ($thisdirectory =~ m;/([^/]+)/?$;) { $thisdirectoryname = $1; } else { $thisdirectoryname = ''; print "$thisdirectory didn't match.\n"; } sub gettimezone { my ($ghour,$gmin) = (gmtime 12*60*60)[2,1]; my ($lhour,$lmin) = (localtime 12*60*60)[2,1]; my $hoffset = $lhour - $ghour; my $moffset = $lmin - $gmin; my $sign = '+'; if ($hoffset < 0) { $sign = '-'; $hoffset = -$hoffset; if ($moffset != 0) { $moffset = 60 - $moffset; $hoffset -= 1; } } $hoffset ='0'.$hoffset if $hoffset<10; $moffset ='0'.$moffset if $moffset<10; return $sign . $hoffset . ':' . $moffset; } $thistimezone = &gettimezone(); # ---------------------------------------------------------------- # Argument processing. use vars qw ( $verbose $brief $listing $summary $version $nobuild $nocullbuild $debugging $noecho $forcebuild $considerreasons $reasons $forceconfig $macroassigns $configfile $outputfile $makefile @TARGETS $fail @options %defines $defined @Actions ); # Process arguments. # Initialize options $verbose = $brief = $listing = $summary = $version = $nobuild = $nocullbuild = $debugging = $noecho = $forcebuild = $reasons = $forceconfig = $macroassigns = $considerreasons = 0; # Scanned nothing yet. @options = (); # We've scanned no options yet. @TARGETS = (); # Nothing to do yet. %defines = (); # Nothing defined yet. $defined = ''; # so no defines to remember. $configfile = undef; # No user specified config file. $outputfile = undef; # No user supplied output file. @Actions = (); # No command line actions yet. undef $makefile; # None yet. $fail = 0; # We haven't failed yet. # Process command line looking for arguments. if (@ARGV == 0) { ### ??? This text should probably be made to agree with ### ??? the text in the POD. warn "-b Brief output\n"; warn "-c file Config file\n"; warn "-d Debugging\n"; warn "-e Suppress Echoing of commands\n"; warn "-f Force rebuild of everything\n"; warn "-F Force rebuild of things older than config file\n"; warn "-l Annotated Listing\n"; warn "-m Show macro assignments\n"; warn "-M a=b Macro Assign b to macro A\n"; warn "-make file Produce a Unix Makefile\n"; warn "-n Don't do the build\n"; warn "-N Don't do partial build if missing prerequisites\n"; warn "-o file Output file for copy of build\n"; warn "-r List reasons for building target\n"; warn "-R list reasons for considering target\n"; warn "-s Summary information\n"; warn "-V Version ($VERSION)\n"; warn "-v Verbose output\n"; warn "$0 \{options\} targets\n"; exit 0; } my $argument; while (defined ($argument = shift @ARGV)) { if ($argument =~ m/^-.+$/) { push @options, $argument; if ($argument eq '-A') { $argument = shift @ARGV; if ($argument =~ m/^([^\=]+)\=\>(.*)$/) { push @Actions, $argument; } else { warn "??? Malformed action on command line: $argument\n"; $fail++; } } elsif ($argument eq '-c') { if (@ARGV == 0) { warn "??? No file given for config file option.\n"; $fail ++; } else { $configfile = shift @ARGV; push @options, $configfile; if (!-e $configfile) { warn "??? Specified config file ($configfile) doesn't exist.\n"; $fail ++; } } } elsif ($argument eq '-d') { $debugging = $verbose = $version = $listing = $macroassigns = $summary = $reasons = $considerreasons = $nobuild = 1; } elsif ($argument eq '-e') { $noecho = 1 } elsif ($argument eq '-f') { $forcebuild = 1 } elsif ($argument eq '-F') { $forceconfig = 1 } elsif ($argument eq '-b') { $brief = 1 } elsif ($argument eq '-l') { $listing = 1 } elsif ($argument eq '-m') { $macroassigns = 1 } elsif ($argument eq '-M') { if (@ARGV == 0) { warn "??? No macro assignment given for -M option\n"; $fail ++; } else { $argument = shift @ARGV; if (!defined $argument) { warn "??? No value for command line Macro definition\n"; $fail++; } elsif ($argument =~ m/^([^\=]+)\=(.*)$/) { $defines{$1} = $2; $defined .= ' ' if $defined ne ''; $defined .= $argument; } else { warn "??? Malformed macro on command line: $argument\n"; $fail++; } } } elsif ($argument eq '-make') { if (@ARGV == 0) { warn "??? No macro assignment given for -M option\n"; $fail ++; } else { $makefile = shift @ARGV; push @options, $makefile; } } elsif ($argument eq '-n') { $nobuild = 1 } elsif ($argument eq '-N') { $nocullbuild = 1 } elsif ($argument eq '-o') { if (@ARGV == 0) { warn "??? No file give for output file option.\n"; $fail ++; } else { $outputfile = shift @ARGV; push @options, $outputfile; } } elsif ($argument eq '-r') { $reasons = 1 } elsif ($argument eq '-R') { $considerreasons = 1 } elsif ($argument eq '-s') { $summary = 1 } elsif ($argument eq '-v') { $verbose = $listing = $version = $summary = $reasons = $considerreasons = 1; } elsif ($argument eq '-V') { $version = 1 } else { warn "??? Unknown option $argument\n"; $fail ++; } } else { push @TARGETS, $argument; } } # Anything to do? if ($fail) { die "*** Processing terminated ($fail errors handling arguments)\a\n" } print $VERSION, "\n" if $version; if (@TARGETS == 0) { print "Assuming $0 @options all\n"; @TARGETS = ('all'); } if ($verbose) { print "INFO: Option: -c $configfile Configuration file\n" if defined $configfile; print "INFO: Option: -d Debugging\n" if $debugging; print "INFO: Option: -e Supress echo\n" if $noecho; print "INFO: Option: -f Force rebuild\n" if $forcebuild; print "INFO: Option: -F Rebuild older than config\n" if $forceconfig; print "INFO: Option: -l Listing\n" if $listing; print "INFO: Option: -m Macro assignments print\n" if $macroassigns; print "INFO: Option: -make $makefile Make Unix Make file\n" if defined $makefile; print "INFO: Option: -n No Build\n" if $nobuild; print "INFO: Option: -N No build on cull\n" if $nocullbuild; print "INFO: Option: -o $outputfile Output file\n" if defined $outputfile; print "INFO: Option: -r Reasons for building target\n" if $reasons; print "INFO: Option: -R Reasons for considering target\n" if $considerreasons; print "INFO: Option: -s Summary\n" if $summary; print "INFO: Option: -v Verbose\n" if $verbose; print "INFO: Option: -V Print Version\n" if $version; print "INFO: Targets: @TARGETS\n"; if (@Actions > 0) { print "INFO: Canned actions:\n"; my $index = 0; my $temp; while ($index < @Actions) { my $temp = $Actions[$index++]; $temp =~ s/"/\"/g; print "INFO: -M \"$temp\"\n"; } } print "\n"; } # ============================================================================== # Configuration file stuff. use vars qw ( @OURFILE $configurationopen $configurationfile $configurationage $lastline @FILEHANDLES @filenames @prefixes $listingprefix $currenthandle $currentfilename %openfiles ); # Where do we get our configuration file? @OURFILE = ('Rebuild', '.rebuild', 'rebuild.data'); unshift @OURFILE, "Rebuild.host.$hostname" if $hostname ne ''; unshift @OURFILE, "Rebuild.user.$username" if $username ne ''; unshift @OURFILE, "Rebuild.host.$hostname.user.$username" if $hostname ne '' && $username ne ''; $lastline = undef; # Nothing read yet. @FILEHANDLES = (); # No stacked includes. @filenames = (); # No stacked names either. %openfiles = (); # Open file names (So we can test for loop) $listingprefix = ''; # Not nested in includes, so no note to that effect. $currenthandle = undef; $currentfilename = ""; # -------------------------------------------------------- # Get a file to process. if (defined $configfile) { unshift @OURFILE, $configfile; } $configurationfile =''; $configurationage =''; $configurationopen = 0; my $file; foreach $file (@OURFILE) { if (-e $file) { &pushfile ($file); $configurationage = -M $file; $configurationfile = $file; $configurationopen = 1; last; } } if (!$configurationopen) { if (@Actions == 0) { die "Unable to find a rebuild file to process (Tried @OURFILE)\n"; } } # -------------------------------------------------------- # dump a line to the output listing. sub dumpline { if (!$configurationopen) { return } my $line = shift; $line = $lastline if !defined $line; $line = '*** line sent to output image...' if !defined $line; my $count = $.; $count = 0 if !defined $count; while (length($count) < 4) { $count = ' ' . $count } print $listingprefix . $count, ':', $line, "\n"; } # -------------------------------------------------------- # Push a file onto the input stack. sub dumpfilestack { if (@filenames > 0) { my $file; foreach $file (@filenames) { warn "We were reading in $file...\n" if $verbose; } } } use FileHandle; sub pushfile { my $filename = shift; my $fail = 0; # Save old state of the world. if ($currentfilename ne '') { push @filenames, $filename; push @FILEHANDLES, $currenthandle; push @prefixes, $listingprefix; $listingprefix .= $currentfilename . '.' . $. . '-' . $filename; } $currentfilename = $filename; $currenthandle = new FileHandle; if (defined $openfiles{$filename}) { warn "Looped includes, $filename\n"; $fail ++ } elsif (open ($currenthandle, "<$filename")) { $openfiles{$filename} = 1; } else { warn "Unable to open file $filename ($!)\n"; $fail ++; } if ($fail > 0) { &dumpfilestack(); die "Unable to open file $filename\n"; } } # -------------------------------------------------------- # Pop a file from the input stack. sub popfile { my $fail = 0; if (!close ($currenthandle)) { warn "Unable to close $currentfilename ($!)\n"; &dumpfilestack(); die "File problems.\n"; } undef $openfiles{$currentfilename}; $currenthandle = pop @FILEHANDLES; $currentfilename = pop @filenames; $listingprefix = pop @prefixes; if (!defined $currentfilename || $currentfilename eq '') { $configurationopen = 0; return undef; } else { return &getline() } } # -------------------------------------------------------- # Get a line from the input stream. sub getline { my $result = ""; my $thisline; if (!$configurationopen) { return undef } while (defined ($lastline = <$currenthandle>)) { chomp $lastline; if ($lastline =~ m/^(.*)\\$/) { &dumpline('*'.$lastline) if $listing; $result .= $1; } else { &dumpline(' '.$lastline) if $listing; $result .= $lastline; return $result; } } # Exited loop? lastline must be indefined. return &popfile(); } # ============================================================================== # Misc support. use vars qw ( %targetsdefined ); %targetsdefined = (); # ---------------- # Handle reporting an error. sub giveerror { my $message = shift; if ($configurationopen) { # This really should have it's own tag. &dumpline() if !$verbose; } warn '*** ' . $message . "\n"; $fail ++; } # ------------------------------------------- # Bust items out of a list. sub makelist { my $given = shift; $given =~ s/^\s+//g; $given =~ s/\s+$//; return (split (/\s+/, $given)); } # ------------------------------------------- # Change Perl's "... days old ..." for files to # an absolute age for printing. sub datefromage { return localtime ($^T - 24*60*60*shift) } # ------------------------------------------- # Make a version of the date suitable for file suffixes. sub suffixfromdate { my $given = shift; $given = time if !defined $given; my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdist) = localtime $given; $mon ++; $year += 1900; $mon = '0' . $mon if $mon < 10; $mday = '0' . $mday if $mday < 10; $hour = '0' . $hour if $hour < 10; $min = '0' . $min if $min < 10; $sec = '0' . $sec if $sec < 10; return $year . '-' . $mon . '-' . $mday . 'T' . $hour . ':' . $min . ':' . $sec . $thistimezone; } # Make a version of the date suitable for human beings. sub humandate { my $when = shift; $when = $^T if !defined $when; my ($day, $month, $year) = (localtime($when)) [3,4,5]; my @months = ('January', 'February', 'March', 'April', 'May', 'June', 'July', 'August', 'September', 'October', 'November', 'December' ); my @dates = ( '1st', '2nd', '3rd', '4th', '5th', '6th', '7th', '8th', '9th', '10th', '11th', '12th', '13th', '14th', '15th', '16th', '17th', '18th', '19th', '20th', '21st', '22nd', '23rd', '24th', '25th', '26th', '27th', '28th', '29th', '30th', '31st' ); my $today = $months[$month] . ' ' . $dates[$day-1] . ', ' . ($year+1900); return $today; } # ============================================================================== # process patterns. use vars qw ( @matchnames ); @matchnames = (); # stored matches. # ============================================================================== # Deal with target tables. use vars qw ( %nodes %target %isfile %age %parents %children %pedigree %mustbuild %wantbuilt %canbuild %commands %status %matchstring %matchedstring %ismatch @canbuildorder %outofdate $currentcommands %dependenciesleft %ancestors ); %nodes = (); # node defined? %target = (); # Are they targets? %isfile = (); # Is it the name of a file? %age = (); # How old is it? %parents = (); # What files does it depend on? %children = (); # What files does it support? %mustbuild = (); # Do we have to build this file? %wantbuilt = (); # Do we want this target built? %canbuild = (); # Can we build this file? %commands = (); # Commands to build this file. @canbuildorder = (); # What order can they be built in? %outofdate = (); # Is this item out of date? %pedigree = (); # Unprocessed dependencies. %ismatch = (); # Is it a pattern match? %dependenciesleft = (); # count of remaining dependencies. %status = (); # computed status. %matchstring = (); # Pattern that created this node, if any. %matchedstring = (); # and what string matched it. %ancestors = (); # Full list of ancestors. $currentcommands = []; # commands we may be accumulating. # -------------------------------------------------------- # Print list of nodes. sub dumpnode { my $node = shift; print " $node"; if (!defined $nodes{$node}) { print " ??\n"; return } print ", PATTERNMATCH" if defined $ismatch{$node}; print ", Target" if defined $target{$node}; print ", IS FILE" if defined $isfile{$node}; print ", age $age{$node}" if defined $age{$node}; print ", Can build" if defined $canbuild{$node}; print ", Must build" if defined $mustbuild{$node}; print ", Want Built" if defined $wantbuilt{$node}; print ", OUTOFDATE" if defined $outofdate{$node} && $outofdate{$node} != 0; print ", CURRENT" if defined $outofdate{$node} && $outofdate{$node} == 0; print ", $status{$node}" if defined $status{$node}; print ", $dependenciesleft{$node} dependencies" if defined $debugging && defined $dependenciesleft{$node}; print "\n"; print " Pattern used: $matchedstring{$node}\n" if defined $matchedstring{$node}; print " Match string: $matchstring{$node}\n" if defined $matchstring{$node}; print " Pedigree : $pedigree{$node}\n" if defined $pedigree{$node}; print " Parents : @{$parents{$node}}\n" if defined $parents{$node} && @{$parents{$node}} > 0; print " Children : @{$children{$node}}\n" if defined $children{$node} && @{$children{$node}} > 0; print " Ancestors: @{$ancestors{$node}}\n" if defined $ancestors{$node} && @{$ancestors{$node}} > 0; if ($verbose && defined $commands{$node} && @{$commands{$node}} > 0) { print " -- Has commands defined\n"; my $command; foreach $command (@{$commands{$node}}) { print " =$command\n"; } } print "\n"; } # ------- # Dump all nodes. sub dumpnodes { my $message = shift; $message = "Node Summary" if !defined $message; $message .= ':' if $message !~ m/\:$/; print $message, "\n\n"; my $node; foreach $node (sort (keys %nodes)) { &dumpnode ($node); } print "\nEnd $message\n"; } # -------------------------------------------------------- # Note a [new] node. sub processnode { my $node = shift; if (!defined $nodes{$node}) { $nodes{$node} = 1; $parents{$node} = []; $children{$node} = []; } } # -------------------------------------------------------- # Process a dependency. sub processdependency { my $child = shift; my $parent = shift; &processnode ($child) if !defined $nodes{$child}; &processnode ($parent) if !defined $nodes{$parent}; # Parents support children. if (grep ($_ eq $child, @{$children{$parent}}) == 0) { push @{$children{$parent}}, $child; } # Children depend on parents. if (grep ($_ eq $parent, @{$parents{$child}}) == 0) { push @{$parents{$child}}, $parent; } } # -------------------------------------------------------- # Process a list of targets. sub processtargets { my $index; foreach $index (@_) { $targetsdefined {$index} = 1; if (defined $target{$index} && defined $commands{$index} && @{$commands{$index}} > 0) { &giveerror ("$index is already a target with commands at line $target{$index}"); } else { $target{$index} = $listingprefix . tell $currenthandle; &processnode ($index); } $commands{$index} = $currentcommands; } } # -------------------------------------------------------- # process a list of dependencies sub processdependencies { my $index; foreach $index (@_) { &processnode ($index); } } # -------------------------------------------------------- # Process a dependency relation. sub processtargetdef { my $targets = shift; my $pedigrees = shift; my $child; my $parent; my @processedlist; my @targetlist = &makelist ($targets); &processtargets (@targetlist); foreach $child (@targetlist) { if ($pedigrees ne '') { if (defined $pedigree{$child}) { $pedigree{$child} .= ' ' . $pedigrees; } else { $pedigree{$child} = $pedigrees; } } &processnode ($child); &parsenode ($child); $target{$child} = 1 if not defined $target{$child}; if ($child =~ m/\*/) { push @matchnames, $child; $ismatch {$child} = 1; } &clearnodeparse(); } } # ============================================================================== # Process directory and file lists. # -------- # Get contents of directory. # Get it as a list. sub getdirectory { my $directoryname = shift; my $dodots = shift; $dodots = 0 if !defined $dodots; my @result = (); my $next; if (!opendir (DIRECTORY, $directoryname)) { warn "??? Unable to open \'$directoryname\' directory? ($!)\n"; die "*** Processing terminated\a\n"; } while (defined ($next = readdir DIRECTORY)) { if (!$dodots && $next =~ m/^\./) {next} if (-d $next && !-l $next && $next !~ m/\/$/) { $next .= '/' } push @result, $next; } return sort (@result); } # or as text. sub getdirectorytext { my $given = shift; my @list = &getdirectory ($given); return "@list"; } # ===================== # Routines to deal with file lists. # ---------- # Cull list down. sub cullfiles { my $test = shift; my $item; my @result = ();; if (!&testtest($test)) { return ("{?BadTest=$test?}") } foreach $item (@_) { if ( ($test eq '-e' && -e $item) || ($test eq '!-e' && !-e $item) || ($test eq '-f' && -f $item) || ($test eq '!-f' && !-f $item) || ($test eq '-d' && -d $item) || ($test eq '!-d' && !-d $item) || ($test eq '-z' && -z $item) || ($test eq '!-z' && !-z $item) || ($test eq '-l' && -l $item) || ($test eq '!-l' && !-l $item) || ($test eq '-S' && -S $item) || ($test eq '!-S' && !-S $item) || ($test eq '-p' && -p $item) || ($test eq '!-p' && !-p $item) ) { push @result, $item } } return @result; } # Cull text list down. sub cullfilestext { my @result = &cullfiles (shift, &makelist(shift)); return "@result"; } # -- # Is this a valid test for cullfiles? # (This is here with cullfiles, so that hopefully they'll always get updated # together...) sub testtest { my $test = shift; if ($test =~ m/^\!?\-(e|f|d|z|l|S|p)$/) { return 1 } else { return 0 } } # ---------- # Union sub listunion { my $list = shift; die "Bad call" if !ref($list); my @new = @_; my @result = (); my $test; foreach $test (@{$list}) { if (scalar(grep ($_ eq $test, @result))) { push @result, $test; } } return @result; } # --------- # Intersection sub listintersection { my $list = shift; die "Bad call" if !ref($list); my @new = @_; my @result = (); my $test; foreach $test (@{$list}) { if (1 == scalar(grep (&comparenodes($_, $test), @new))) { push @result, $test; } } return @result; } # --------- # Difference sub listdifference { my $list = shift; die "Bad call" if !ref($list); my @new = @_; my @result = (); my $test; foreach $test (@{$list}) { if (0 == scalar(grep (&comparenodes($_, $test), @new))) { push @result, $test; } } return @result; } # --------- # addition sub listaddition { my $list = shift; die "Bad call" if !ref($list); my @new = @_; my @result = @{$list}; my $test; foreach $test (@new) { push @result, $test; } return @result; } # --------- # Difference sub unique { my @result = (); my $test; foreach $test (@_) { if (0 == scalar(grep (&comparenodes($_, $test), @result))) { push @result, $test; } } return [@result]; } # ============================================================================== # macro processing. use vars qw ( %macros ); # --------------------- # evaluate complex macro expression. sub evaluatemacro { my $given = shift; my $match = shift; # (May not have been given) $given =~ s/^\s+//g; $given =~ s/\s+$//; my @todo = split (/\s*\|\s*/, $given); my @result = (); my $rawitem; while (defined ($rawitem = shift @todo)) { # File tests. my $item = &replace($rawitem); if (&testtest($item)) { @result = &cullfiles ($item, @result); } elsif ($item =~ m/^(\S*)\s*\=\>\s*(\S*)$/) { @result = &remaplist ($1, $2, @result); } elsif ($item =~ m/^ifndef\s*\(\s*(\w+)\s*\,(.*)\)$/) { if (!defined $macros{$1}) {push @result, &makelist(&replace($2))} } elsif ($item =~ m/^ifdef\s*\(\s*(\w+)\s*\,(.*)\)$/) { if (defined $macros{$1}) {push @result, &makelist(&replace($2))} } elsif ($item =~ m/^minus\s*\((.*)\)$/) { @result = &listdifference (\@result, &makelist($1)); } elsif ($item =~ m/^only\s*\((.*)\)$/) { @result = &listintersection (\@result, &makelist($1)); } elsif ($item =~ m/^plus\s*\((.*)\)$/) { @result = &listaddition (\@result, &makelist($1)); } elsif ($item =~ m/^unique\s*\((.*)\)$/) { @result = &unique (@result); } elsif ($item =~ m/^sort\s*\((.*)\)$/) { @result = sort @result; } elsif ($item =~ m/^rsort\s*\((.*)\)$/) { @result = reverse (sort (@result)); } elsif ($item =~ m/^dir\s*\((.*)\)$/) { push @result, &getdirectory($1); } elsif ($item =~ m/^age\s*\((.*)\)$/) { if ($1 eq '') { push @result, -1 } elsif (!-e $1) { push @result, -1 } else { push @result, (-M $1)} } elsif ($item =~ m/^agesuffix\s*\((.*)\)$/) { if ($1 eq '') {} # Do nothing. elsif (!-e $1) { push @result, '' } else { push @result, &suffixfromdate(&datefromage(-M $1)) } } elsif ($item =~ m/\*/) { @result = &remaplist ($item, '', @result); } elsif (defined $macros{$item}) { push @result, $macros{$item}; } elsif ($item =~ m/^\w+$/) { push @result, $item; } else { push @result, &makelist ($item); } } return "@result"; } # --------------------- # Extract the first macro from the line. sub trymacromatch { my $given = shift; my $count = 0; my $pre = ''; my $image = ''; while ($given =~ m/^(.)(.*)$/) { my $test = $1; $given = $2; if ($test eq '{') { if ($count++ == 0) { next } } elsif ($test eq '}') { $count --; if ($count == 0) { return ($pre, $image, $given) } } if ($count > 0) { $image .= $test } else { $pre .= $test } } if ($given ne '' && $count != 0) {return ($pre . '{?' . $image . ':' . $given . '?}') } return ($pre, $image, ''); } # ---------------------- # Extract each macro in a line stitching together results. sub replace { my $given = shift; if (defined $macros{$given}) { return $macros{$given} } my $result = ''; my $rest = $given; my ($pre, $process) = ('', ''); while ($rest ne '') { # While we have stuff to do. ($pre, $process, $rest) = &trymacromatch ($rest); if ($pre =~ m/^(.*)\\$/) { # If it is quoted, processing is to unquote. $pre = $1 . '{' . $process . '}'; $process = ''; } elsif ($process =~ m/^\?/) { # If we are passing on an error... $pre .= '{?' . $process . '?}'; $process = ''; } elsif ($process =~ m/^\s*$/) { $process = ''; } else { $process = &evaluatemacro($process); } $result .= $pre . $process; }; return $result; } # --------------- # Initialization # Predefined macros. %macros = %ENV; # Preload environment. $macros{'REBUILD'} = $0; # What program is this? $macros{'OPTIONS'} = "@options"; # What options was it envoked with? $macros{'TARGETS'} = "@TARGETS"; # What was it asked to build? $macros{'DATE'} = &humandate(); # When was it run. $macros{'DATESUFFIX'} = &suffixfromdate($^T); # A version of that date useful for file names. $macros{'LOGIN'} = $username; # Who was running this? $macros{'REBUILDFILE'} = $configurationfile; # Configuration file we are processing. $macros{'REBUILDFILEAGE'} = &datefromage($configurationage); $macros{'DEFINES'} = $defined; $macros{'THISDIRECTORY'} = $thisdirectory; $macros{'DIRECTORYNAME'} = $thisdirectoryname; # short form. my $name; # Preload command line. foreach $name (keys %defines) { $macros{$name} = &replace($defines{$name}); } ### Local(?) defaults? $macros{'CC'} = 'gcc' if !defined $macros{'CC'}; $macros{'CFLAGS'} = '' if !defined $macros{'CFLAGS'}; if (!defined $macros{'SHELL'}) { $macros{'SHELL'} = '/bin/sh'; $macros{'SHELLOPTIONS'} = ''; } elsif (!defined $macros{'SHELLOPTIONS'}) { $macros{'SHELLOPTIONS'} = ''; } ### # Cleanup $macros{'THISDIRECTORY'} .= '/' if defined $macros{'THISDIRECTORY'} && $macros{'THISDIRECTORY'} !~ m/\/$/; if ($debugging) { print "Macro's defined in setup:\n"; my $item; foreach $item (sort (keys %macros)) { print " \{$item\} = $macros{$item}\n" } print "\n"; } # --- # parse node name. sub parsenode { my $node = shift; my ($file, $ext) = ($node, ''); if ($node =~ m/^(.*)\.([^\.]*)$/) { $file = $1; $ext = '.' . $2; } $macros{'file'} = $file; $macros{'ext'} = $ext; $macros{'target'} = $node; } # --- # Compare node and pattern sub matchnodes { my $pattern = shift; my $node = shift; my $result = undef; if ($pattern eq '' || $pattern eq '*' || $node eq $pattern) { $result = $node; } elsif ($pattern =~ m/^(.*)\*(.*)$/) { my ($pre, $post) = ($1, $2); $pre = quotemeta $pre; $post = quotemeta $post; if ($node =~ /^$pre(.+)$post$/) { $result = $1; } } return $result; } sub mapoutput { my $part = shift; return undef if !defined $part; my $out = shift; return undef if !defined $out; $out =~ s/\*/$part/g; return $out; } sub mapnodes { my $pattern = shift; my $node = shift; my $outform = shift; return &mapoutput (&matchnodes($pattern, $node), $outform); } sub comparenodes { my $pattern = shift; my $node = shift; return defined &matchnodes($pattern, $node); } # ------- # Clear out the parse of a node. sub clearnodeparse { $macros{'file'} = undef; $macros{'ext'} = undef; $macros{'target'} = undef; $macros{'*'} = undef; } # ----------- # remap a list by a pattern. sub remaplist { my $pat = shift; my $out = shift; my @list = @_; my @result = (); my $item; my $matched; foreach $item (@list) { if (defined ($matched = &mapnodes($pat, $item, $out))) { push @result, $matched; } } return @result; } # --- # remap a string form of list. sub remaplisttext { my ($pat, $out, $list) = @_; my @result = &remaplist ($pat, $out, &makelist($list)); return "@result"; } # ============================================================================== # Process input file. use vars qw ( $currentstate @currentdependencies $processingtarget ); $currentstate = ''; $processingtarget = 0; @currentdependencies = (); # ---------------- # Keep track of internal state, handling state change housekeeping. sub setstate { my $state = shift; my $new = shift; if (!defined $new && $currentstate eq $state) { return } $processingtarget = $state eq 'target'; $currentstate = $state; $currentcommands = []; @currentdependencies = (); } # --------------------- # Dump information to output listing. sub dumpinfo { if (!($verbose && $listing)) {return} my $text = shift; print "INFO: $text\n"; } # --------------------- # Process a macro define line. sub processdefine { my $command = shift; &setstate ('macro'); # define # NAME [keeping [existing] pattern [converting [existing] rewrite ]] as ... if ($command =~ m/^\s*(\S+)\s+as\s*(.*)$/) { my $name = $1; my $final = $2; my $replaced = &replace ($final); $macros {$name} = $replaced; print " Final assignment was $name = $replaced\n" if $macroassigns; } elsif ($command =~ m/^\s*(\S+)\s*$/) { $macros {$1} = ''; print " Nil macro assignment.\n" if $macroassigns; } else { &giveerror("Invalid macro define line: $command"); } } # ============================================================================== # Extra documentation for purposes of tracking source control. use vars qw ( @tooldoc ); @tooldoc = (); # ============================================================================== # ============================================================================== # Process input file. # -------------------------------------------------------- my $line; while (defined ($line = &getline())) { $line =~ s/\s+$//; $line =~ s/^\s+//g; if ($line eq '') { next } if ($line =~ m/^\s*\#/) { next } if ($line =~ m/^\=\>\s*(.+)$/) { # code line. my $code = '> ' . $1; &dumpinfo ("Code line $1"); if (!$processingtarget) {&giveerror ("Code line not part of target")} push @{$currentcommands}, $code; } elsif ($line =~ m/^\=\:\s+(\S.+)$/) { # Execute time macro. my $code = ': ' . $1; &dumpinfo ("Build time macro. $code"); if (!$processingtarget) {&giveerror ("Execution time macro not part of target")} push @{$currentcommands}, $code; } elsif ($line =~ m/^define\s+(\S.*)$/i) { &processdefine ($1); } elsif ($line =~ m/^tools?\s+(\S.*)$/i) { my @list = &makelist (&replace($1)); &dumpinfo ("Tool documentation line @list"); my $item; foreach $item (@list) { if (!-e $item) { &giveerror ("Tool $item either not fully qualified, or non-existant") } } unshift @tooldoc, @list; } elsif ($line =~ m/^include\s+(\S.*)+$/) { my $given = $1; &dumpinfo ("File include line is: $given"); $given =~ s/\s+$//; $given = &replace($given); &dumpinfo (" Include translates: $given"); if ($given !~ m/\S/) { &dumpinfo (" (No include file)"); } elsif (!-e $given) { &giveerror ("Include file $given not found."); } else { pushfile ($given); } } elsif ($line =~ m/(\S+[^\:\<]*)\s*(?:\<\=|\:)\s*(.*)$/) { # Target definition line. my $name = $1; my $parents = $2; &dumpinfo ("Target definition line: $name <= $parents"); my $expanded = &replace($name); &dumpinfo (" Targets map to : $expanded"); &setstate ('target', 'new'); if ($expanded ne '') {&processtargetdef ($expanded, $parents)} else { &dumpinfo ("No final targets.") } } else { # *** CRAP *** &giveerror ("??? Unknown line type $.: $line"); } } &setstate (''); # We no longer have a processing state. if ($fail) {die "*** Processing terminated ($fail errors reading file)\a\n"; } if ($debugging || $summary) { &dumpnodes ("Summary after processing input file"); } # ============================================================================== # Prepare the graph. # ============================================================================== use vars qw ( @nodestobuild @nodescanbuild $totaltobuild ); @nodestobuild = (); # Which nodes we really care about. @nodescanbuild = (); # Nodes we can actually build. $totaltobuild = 0; # Total number of nodes we will build. my @nodelist = sort (keys %nodes); # ----- # recusively walk the tree, marking things we want to build. # Expand the tree to match wildcards. # Locate a node matching a given form. sub findnodematch { my $node = shift; my $result = undef; my $match; my $actualmatch; foreach $match (@matchnames) { if (defined ($actualmatch = &matchnodes($match, $node))) { &processnode ($node) if !defined $nodes{$node}; $result = $match; $matchstring{$node} = $actualmatch; $matchedstring{$node} = $match; $commands{$node} = $commands{$match}; $pedigree{$node} = $pedigree{$match}; if (!defined $parents{$node}) {$parents{$node} = []} if (defined $pedigree{$match}) { &parsenode($node); $macros{'*'} = $actualmatch; my @newparents = &makelist(&mapnodes( $match, $node, &replace($pedigree{$match}))); my $newparent; foreach $newparent (@newparents) { &processdependency ($node, $newparent); } &clearnodeparse(); } last; } } return $result; } # --- sub marktobuild { my $node = shift; # If we've already seen it, it is already processed. if (defined $wantbuilt{$node}) { return } # If it is a leaf, find what it matches, if any. if (!defined $pedigree{$node}) { &findnodematch ($node); if (defined $matchstring{$node} && $considerreasons) { print " (Looked up as a pattern match $matchedstring{$node})\n"; } } $wantbuilt{$node} = 1; push @nodestobuild, $node; # If we have pedigree, but no parents, form the parents. if (defined $pedigree{$node} && @{$parents{$node}} == 0) { &parsenode ($node); my @additionalparents = &makelist(&mapoutput($node, &replace($pedigree{$node}))); &clearnodeparse(); my $newparent; foreach $newparent (@additionalparents) { &processdependency ($node, $newparent); } } # Handle parents. my $parent; foreach $parent (@{$parents{$node}}) { print "Examining $parent, as parent of $node\n" if $considerreasons; &marktobuild($parent); } } # -------- # Identify targets we really want to build. if (!@TARGETS) { die "??? No targets to build given.\n"; } my $node; foreach $node (@TARGETS) { print "Examining $node, user asked it to be built.\n" if $considerreasons; if (!defined $targetsdefined {$node} ) { if (!defined $matchstring{$node}) { warn "*** Target $node is not defined\a\n"; next; } } &marktobuild ($node); } if ($debugging) { &dumpnodes ("Summary after build pass file"); } # What did we get? if ($summary || $verbose) { print "Nodes we want built:\n"; foreach $node (@nodestobuild) { print ' ', $node, "\n" } print "\n"; } if (@nodestobuild == 0) { die "??? No processable targets.\n"; } # ============================================================================== # Find buildable stuff. # This is stuff that we want built, that we can find instructions for. # (This is not the same as what we want built if there are circular # dependecies) # Determine each node's status. foreach $node (@nodestobuild) { # Is it a file? if (-e $node) { $isfile {$node} = 1; $age {$node} = -M $node; } # how many parents does it depend on? if (!defined $parents{$node}) { $dependenciesleft{$node} = 0; } else { $dependenciesleft{$node} = @{$parents{$node}}; } # Regularize the form of entries. if (defined $commands{$node} && @{$commands{$node}} == 0) { undef $commands{$node}; } } sub markcanbuild { my $node = shift; if ( defined $canbuild{$node}) { return } if (!defined $wantbuilt{$node}) { return } $canbuild{$node} = 1; push @nodescanbuild, $node; my $child; foreach $child (@{$children{$node}}) { $dependenciesleft{$child} --; &markcanbuild($child) if $dependenciesleft{$child} == 0; } } foreach $node (reverse @nodestobuild) { if (!$canbuild{$node} && $dependenciesleft {$node} eq 0) { &markcanbuild ($node); } } if (scalar(@nodestobuild) == 0) { &dumpnodes("Summary after deciding we had no nodes to build") if $debugging; die "??? We don't know how to build ANYTHING wanted???\n"; } if ($debugging || ($verbose && $summary)) { print "Nodes we can build\n"; foreach $node (@nodescanbuild) { print ' ', $node, "\n"; } print "\n"; } # Can we build everything we need? my %possiblecirculars = (); foreach $node (@nodestobuild) { if (!defined $canbuild{$node}) { if (!$fail) { print "Nodes we don't know how to build. (Including circular dependencies)\n" } print ' ', $node, "\n"; my @unknowns = grep (! defined $canbuild{$_}, @{$parents{$node}}); if (@unknowns != 0) { my $parent; foreach $parent (@unknowns) { print " Couldn't make parent: $parent\n"; } $possiblecirculars{$node} = [@unknowns] } $fail ++; } } if ($fail) { # Let's try to identify circular dependencies. # Prune leaf notes. my $needprune = 1; while ($needprune) { $needprune = 0; foreach $node (keys %possiblecirculars) { $needprune = 0; if (!defined $possiblecirculars{$node}) { next } my $parent; my @newerparents = (); foreach $parent (@{$possiblecirculars{$node}}) { if (defined $possiblecirculars{$node}) { push @newerparents, $parent } } if (@newerparents == 0) { $needprune = 1; undef $possiblecirculars{$node}; } else { $possiblecirculars{$node} = [@newerparents]; } } } # report resulting graph. $needprune = scalar %possiblecirculars; print "Attempt to identify circular dependencies...\n" if $needprune; while ($needprune) { $needprune = 0; my @temp = keys %possiblecirculars; my $thisone = shift @temp; print "Loop structure starting at $thisone:\n"; while (defined $possiblecirculars{$thisone}) { my @itsparents = @{$possiblecirculars{$thisone}}; print "$thisone has parents:\n"; delete $possiblecirculars{$thisone}; $thisone = undef; my $report; foreach $report (@itsparents) { print " $report"; if (defined $possiblecirculars{$report}) { $thisone = $report if !defined $thisone; } else { print " *** Which is already a child of it above." } print "\n"; } $thisone = shift @itsparents; while (scalar(@itsparents) > 0 && !defined $possiblecirculars{$thisone}) { $thisone = shift @itsparents } $needprune = scalar %possiblecirculars; } } } if ($debugging) { &dumpnodes("SUMMARY after calculating buildables") } if ($fail) { die "*** Processing terminated. ($fail unbuildable nodes)\a\n" } # ============================================================================== # OK, we've identified what's wanted, and identified what in that # list is buildable. # Now we need to decide what we should really build. # Ok, add this to the "must build" list. sub saybuildit { my $node = shift; if (defined $mustbuild{$node}) { return } $mustbuild{$node} = 1; $totaltobuild++; # Update 15 jul 1999. Children of rebuild must be rebuilt. my $child; print "Forcing rebuild (as children of $node)\n @{$children{$node}}\n" if $reasons; foreach $child (@{$children{$node}}) { if ($canbuild{$child} && !$mustbuild{$child}) { saybuildit ($child); } } } my $candidate; print "Determination of whether to build\n" if $reasons; foreach $candidate (@nodescanbuild) { print "Considering $candidate for build: " if $reasons; # identify all ancestors. if (defined $parents{$candidate} && @{$parents{$candidate}} > 0) { my $parent; my @ancestorlist = @{$parents{$candidate}}; foreach $parent (@{$parents{$candidate}}) { if (defined $ancestors{$parent} && @{$ancestors{$parent}}>0) { push @ancestorlist, @{$ancestors{$parent}}; } } $ancestors{$candidate} = &unique (@ancestorlist); } if ($forcebuild) { print " Building being forced by option\n" if $reasons; &saybuildit ($candidate); next; } if ($mustbuild{$candidate}) { next } # Already done in some manner. my $hascommands = defined $commands{$candidate} && @{$commands{$candidate}} > 0; if (defined $parents{$candidate} && @{$parents{$candidate}} == 0) { # leaf. print " is leaf" if $reasons; if ($hascommands) { print " with commands to build it. Building.\n" if $reasons; &saybuildit ($candidate); } elsif (!defined $isfile{$candidate}) { print " without instructions to build??\n" if $reasons; $status{$candidate} = "Place holder target"; $canbuild{$candidate} = 0; } else { print " parentless file\n" if $reasons; $outofdate{$candidate} = 0; $status{$candidate} = "Source file"; } } else { # has parents. # Since we are working in build order, all ancestors have # already been processed, if they are processable. print " Has ancestors" if $reasons; my $parent; # How old are the immediate ancestors? my $youngestancestor; foreach $parent (@{$parents{$candidate}}) { if (!defined $youngestancestor) { $youngestancestor = $age{$parent} if defined $age{$parent}; } elsif (defined $age{$parent}) { $youngestancestor = $age{$parent} if $age{$parent} < $youngestancestor; } } # try to make a decision based on age.. if (defined $age{$candidate} && defined $youngestancestor) { if ($age{$candidate} >= $youngestancestor) { print " is older than ancestor. Building\n" if $reasons; &saybuildit($candidate); $age{$candidate} = 0 if $hascommands; # There may be a new file created. } else { print " is younger than its ancestors\n" if $reasons; $outofdate{$candidate} = 0; } } elsif (!defined $age{$candidate} && defined $youngestancestor) { $age{$candidate} = $youngestancestor; if ($hascommands) { print " doesn't exist but has commands to build it. Building\n" if $reasons; &saybuildit ($candidate); $age{$candidate} = 0; # Brand new file. } else { print " doesn't exist and has no commands to build it.\n" if $reasons; } } else { print "??? Huh?\n" if $reasons; $outofdate{$candidate} = 0; } } } if (!$nocullbuild) {$fail = 0} if ($summary && $verbose) { &dumpnodes ("Summary after decisions on building:"); } if ($debugging || ($summary && $verbose)) { print "Nodes we will try to build:\n"; foreach $candidate (@nodescanbuild) { if ($mustbuild{$candidate}) { print ' ', $candidate, "\n"; } } print "\n"; } if ($fail) { warn "??? Prerequisites missing\n"; die "*** Processing terminated\a\n"; } # ============================================================================== # spew out generated code. if ($totaltobuild == 0) { warn "Everything was up to date.\n"; exit 0; } if (defined $outputfile) { open (OUTPUT, ">$outputfile") or die "Unable to open output file ($outputfile) ($!)\n"; } if (!$nobuild) { if (!$noecho && $verbose) { $macros{'SHELLOPTIONS'} .= ' -v'; } open (COMMAND, "|$macros{'SHELL'} $macros{'SHELLOPTIONS'}") or die "Unable to open execution shell $macros{'SHELL'} ($!)\n"; } # Dump a line, echoing output if needed. # Execution should probably go here too... sub dooutput { my $line = shift; print $line, "\n" if !$noecho; print OUTPUT $line, "\n" if defined $outputfile; if (!$nobuild) { my $worked = print COMMAND $line, "\n"; if (!$worked) { warn "Command output failed. ($!) on $line\n"; close (COMMAND) or die "ALREADY CLOSED\n"; $nobuild = 1; } select((select(STDOUT), $| = 1, select(COMMAND), $| = 1)[0]) # Sync output. } } # pipes to the shell shouldn't start with which SHELL to switch to. my $suppressfirstline = $nobuild; $nobuild = 1; &dooutput ("#!$macros{'SHELL'} $macros{'SHELLOPTIONS'}"); $nobuild = $suppressfirstline; # Put out documentation block for managers that really bother to # keep documentation. &dooutput ("###############################################"); &dooutput ("# Build script built by $0"); &dooutput ("# Version $VERSION"); &dooutput ("# Generating on $macros{'DATE'}"); &dooutput ("# In directory $macros{'THISDIRECTORY'}"); &dooutput ("# $macros{'REBUILD'} $macros{'OPTIONS'} $macros{'DEFINES'} $macros{'TARGETS'}"); if (@Actions > 0) { foreach my $item (@Actions) { $item =~ s/"/\"/g; &dooutput("# -A \"$item\""); } } &dooutput ("# config file $macros{'REBUILDFILE'} ($macros{'REBUILDFILEAGE'})"); &dooutput ("# by $macros{'LOGIN'}"); if (@tooldoc > 0) { # They want tool documentation also? &dooutput ("# Tools used:"); my $tool; foreach $tool (@tooldoc) { if (-e $tool) { &dooutput ("# $tool"); my $age = &datefromage (-M $tool); &dooutput ("# $age"); } else { &dooutput ("# $tool *** does not exist"); } } } &dooutput ("###############################################"); sub markunbuildable { my $node = shift; if (@{$children{$node}} > 0) { my $child; foreach $child (@{$children{$node}}) { $canbuild{$child} = 0; &dooutput ("# ---- Therefore child '$child' can't be built."); } } } # ----------------------------------------------- my $currentnode; sub selectnode { my $given = shift; &parsenode($given); $macros{'children'} = ''; $macros{'children'} = "@{$children{$given}}" if @{$children{$given}} > 0; $macros{'newparents'} = ''; $macros{'parents'} = ''; if (defined $matchstring {$given}) { $macros{'*'} = $matchstring {$given} } else { $macros{'*'} = $given } if (defined $parents{$given}) { $macros{'parents'} = "@{$parents{$given}}" if defined $parents{$given}; if (defined $isfile{$given}) { my $age = $isfile{$given}; my $parent; my @newguys = (); foreach $parent (@{$parents{$given}}) { if (defined $isfile{$parent} && $isfile{$parent} < $age) { push @newguys, $parent; } } $macros{'newparents'} = ''; $macros{'newparents'} = "@newguys" if @newguys > 0; } } $macros{'target'} = $given; if ($given =~ m/^(.*)\.([^.]*)$/) { $macros{'file'} = $1; $macros{'ext'} = $2 } if (!defined $ancestors{$given} || @{$ancestors{$given}} == 0) { $macros{'ancestors'} = ""; } else { $macros{'ancestors'} = "@{$ancestors{$given}}"; } } sub deselectnode { undef $macros{'ancestors'}; undef $macros{'parents'}; undef $macros{'children'}; undef $macros{'newparents'}; undef $macros{'target'}; undef $macros{'file'}; undef $macros{'ext'}; } # ----------------------------------------------- # Do we need to do a Unix Makefile? if (defined $makefile) { if (!open (MAKEFILE, ">$makefile")) { warn ("??? Couldn't open makefile $makefile ($!)\n"); } else { print MAKEFILE "#!/usr/bin/make\n"; foreach $currentnode (@nodescanbuild) { &selectnode ($currentnode); my $commandline; my $newline; my @actual_parents; my @commands; if (defined $parents{$currentnode}) { my @result = (); my $testresult; foreach $testresult (@{$parents{$currentnode}}) { next if $testresult =~ m/\-I/; next if $testresult =~ m/\-l/; push @result, $testresult; } @actual_parents = (@result); } else { @actual_parents = (); } if (defined $commands{$currentnode}) { @commands = @{$commands{$currentnode}}; } else { @commands = (); } if ((@actual_parents == 0) && (@commands == 0)) { next } print MAKEFILE "$currentnode:@actual_parents\n"; foreach $commandline (@commands) { if ($commandline =~ m/^> (.*)$/) { my $code = &replace($1); printf MAKEFILE "\t$code\n"; } elsif ($commandline =~ m/^\:\s+define\s+(\w+)\s+(.*)$/) { } else { &dooutput ("# Internal error processing command: $commandline"); } } print MAKEFILE "\n"; &deselectnode(); } close (MAKEFILE); } } # ----------------------------------------------- # --------------------------------------------- # OK, Show time.... (Process each node wanted.) foreach $currentnode (@nodescanbuild) { if (!$mustbuild{$currentnode} && defined $status{$currentnode}) { &dooutput ("###### target $currentnode : $status{$currentnode}"); next; } elsif (defined $outofdate{$currentnode} && $outofdate{$currentnode} == 0) { &dooutput ("###### target $currentnode was up to date."); next; } elsif (!defined $canbuild{$currentnode} || $canbuild{$currentnode} == 0) { &dooutput ("###### *** target $currentnode can't be built."); &markunbuildable ($currentnode); next; } elsif (!defined $commands{$currentnode}) { &dooutput ("###### target $currentnode: no commands needed to build."); next; } else { &dooutput ("###### target $currentnode -------"); } &selectnode ($currentnode); if ($verbose) { &dooutput ("# --- Parents: $macros{'parents'}") if $macros{'parents'} ne ''; &dooutput ("# --- (New): $macros{'newparents'}") if $macros{'newparents'} ne '' && $macros{'newparents'} ne $macros{'parents'}; &dooutput ("# --- Children: $macros{'children'}") if $macros{'children'} ne ''; &dooutput ("# --- '*' : $macros{'*'}") if $macros{'*'} ne $currentnode; &dooutput ("# --- pattern: $matchedstring{$currentnode}") if defined $matchedstring{$currentnode}; # &dooutput ("#") # if $macros{'children'} ne '' # || $macros{'parents'} ne '' # || $macros{'newparents'} ne ''; } my $commandline; my $newline; foreach $commandline (@{$commands{$currentnode}}) { if ($commandline =~ m/^> (.*)$/) { my $code = &replace($1); &dooutput ("$code"); # PROCESS CODE. } elsif ($commandline =~ m/^\:\s+define\s+(\w+)\s+(.*)$/) { my $name = $1; my $rest = $2; &processdefine ($name . ' ' . $rest); &dooutput("# $name = $macros{$name}"); } else { &dooutput ("# Internal error processing command: $commandline"); } } &dooutput("#"); &deselectnode(); } &dooutput ("##################################################"); &dooutput ("# Done"); &dooutput ("exit 0"); if (!$nobuild) { close (COMMAND) or die "Unable to close execution shell ($!)\n"; } if (defined $outputfile) { close (OUTPUT) or die "Unable to close output file ($outputfile) ($!)\n"; chmod 0700, $outputfile; } if ($fail) { die "*** Processing terminated. ($fail errors building nodes)\a\n" } exit 0;