PLEASE do NOT modify these in the repo, as that will break MY builds.
I only moved them here to have all readily available
Note that some still need manual change if used locally
• mconfig
• metaconfig
• metagrep
• metalint
• metaxref
• mlint
• packinit
• patcil
• patpost
• patsend
--- /dev/null
+#!/pro/bin/perl
+
+# This script reorders config_h.SH after metaconfig
+# Changing metaconfig is too complicated
+#
+# Copyright (C) 2005-2005 by H.Merijn Brand (m)'05 [25-05-2005]
+#
+# You may distribute under the terms of either the GNU General Public
+# License or the Artistic License, as specified in the README file.
+
+use strict;
+use warnings;
+
+my ($cSH, $ch, @ch, %ch) = ("config_h.SH");
+open $ch, "<$cSH" or die "Cannot open $cSH: $!\n";
+{ local $/ = "\n\n";
+ @ch = <$ch>;
+ close $ch;
+ }
+
+my @ref;
+sub ch_index ()
+{
+ %ch = ();
+ foreach my $ch (0 .. $#ch) {
+ while ($ch[$ch] =~ m{^/\* ([A-Z]\w+)}gm) {
+ $ch{$1} = $ch;
+ push @{$ref[$ch]}, $1;
+ }
+ }
+ } # ch_index
+
+ch_index;
+my @CH = @ch;
+my %RF;
+foreach my $ch (0 .. $#CH) {
+ $CH[$ch] =~ s{/\*.*?\*/\s*}{}gis;
+ while ($CH[$ch] =~ m{\b([A-Z]\w+)}g) {
+ exists $ch{$1} or next;
+ $ch{$1} == $ch and next;
+ #print STDERR "$ref[$ch][0] ($ch) ref to $1 ($ch{$1})\n";
+ $RF{$1}{$ref[$ch][0]}++;
+ }
+ }
+foreach my $r (sort keys %RF) {
+ my $R = sprintf "%-20s", $r;
+ print " $r => [ qw ( @{[sort keys %{$RF{$r}}]}\t) ],\n";
+ }
+
+my %dep = (
+ # This symbol must be defined BEFORE ...
+ BYTEORDER => [ qw( UVSIZE ) ],
+ LONGSIZE => [ qw( BYTEORDER ) ],
+ MULTIARCH => [ qw( BYTEORDER MEM_ALIGNBYTES ) ],
+ USE_CROSS_COMPILE => [ qw( BYTEORDER MEM_ALIGNBYTES ) ],
+ HAS_QUAD => [ qw( I64TYPE ) ],
+ HAS_GETGROUPS => [ qw( Groups_t ) ],
+ HAS_SETGROUPS => [ qw( Groups_t ) ],
+ );
+
+my $CHANGED = 0;
+my $changed;
+do {
+ $changed = 0;
+ foreach my $sym (keys %dep) {
+ ch_index;
+ foreach my $dep (@{$dep{$sym}}) {
+ print STDERR "Check if $sym\t($ch{$sym}) precedes $dep\t($ch{$dep})\n";
+ $ch{$sym} < $ch{$dep} and next;
+ my $ch = splice @ch, $ch{$sym}, 1;
+ splice @ch, $ch{$dep}, 0, $ch;
+ $changed++;
+ $CHANGED++;
+ ch_index;
+ }
+ }
+ } while ($changed);
--- /dev/null
+#!/usr/bin/perl
+ eval 'exec perl -S $0 "$@"'
+ if $runnning_under_some_shell;
+
+# $Id: jmake.SH 20 2008-01-04 23:14:00Z rmanfredi $
+#
+# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
+#
+# You may redistribute only under the terms of the Artistic Licence,
+# as specified in the README file that comes with the distribution.
+# You may reuse parts of this distribution only within the terms of
+# that same Artistic Licence; a copy of which may be found at the root
+# of the source tree for dist 4.0.
+#
+# $Log: jmake.SH,v $
+# Revision 3.0.1.9 2004/08/22 09:01:42 ram
+# patch71: renamed |test as |case as the construct has its syntax
+# patch71: added |subst section to allow variable substitutions
+#
+# Revision 3.0.1.8 2004/08/21 23:19:46 ram
+# patch71: added '|shell' section to emit verbatim code in Makefile.SH
+# patch71: new '|test' to conditionally generate Makefile sections
+#
+# Revision 3.0.1.7 2004/08/21 20:59:57 ram
+# patch71: replaced old "do foo()" with modern "&foo()" syntax
+# patch71: take care of junk emitted by GNU make when running commands
+# patch71: new ^^^ escape sequence, removing extra spaces afterwards
+#
+# Revision 3.0.1.6 1995/09/25 09:08:01 ram
+# patch59: will now force macro definitions to the left
+#
+# Revision 3.0.1.5 1995/07/25 13:34:47 ram
+# patch56: all error messages are now prefixed with the program name
+#
+# Revision 3.0.1.4 1995/03/21 08:45:27 ram
+# patch52: now invokes cpp through new fixcpp script
+# patch52: first pass now skips cpp comments alltogether
+#
+# Revision 3.0.1.3 1994/10/29 15:47:01 ram
+# patch36: added various escapes in strings for perl5 support
+#
+# Revision 3.0.1.2 1993/08/24 12:12:50 ram
+# patch3: privlib dir was ~name expanded in the wrong place
+#
+# Revision 3.0.1.1 1993/08/19 06:42:13 ram
+# patch1: leading config.sh searching was not aborting properly
+#
+# Revision 3.0 1993/08/18 12:04:17 ram
+# Baseline for dist 3.0 netwide release.
+#
+
+$dir = '/pro/3gl/CPAN/lib/dist/files';
+$cpp = '/usr/bin/cpp';
+$version = '3.5';
+$patchlevel = '0';
+
+($me = $0) =~ s|.*/(.*)|$1|;
+$dir = &tilda_expand($dir); # ~name expansion
+$file = $dir . '/Jmake.tmpl';
+
+$cpp_opt = "-I. "; # For Jmakefile, which is local
+while ($ARGV[0] =~ /^-/) {
+ $_ = shift;
+ last if /--/;
+ $cpp_opt .= "$_ ";
+}
+$cpp_opt .= "-I$dir";
+
+# Pass 0 is looking at the template for "?CP:CP =" lines that are to be
+# emitted if the CP variable is needed. Later on, when we see $(CP) being
+# used, we'll be able to set the $symbol{CP} entry to 1 to have the CP
+# variable initialized by the template.
+
+open(TMPL, $file) || die "$me: can't open $file: $!\n";
+while (<TMPL>) {
+ next unless /^\?([\w_]+):\1\s+=/;
+ $wanted{$1}++;
+}
+close TMPL;
+
+# Thank you HP-UX for having a cpp that blindly strips trailing backslashes
+# in the text. Run through cpp by using the fixcpp script...
+
+open(CPP, "$dir/fixcpp $cpp_opt $file |");
+while (<CPP>) {
+ # Record defined symbols in Jmakefile. We won't catch symbols
+ # in conditional commands, but that's ok, I hope.
+ if ($in_symbol) {
+ $val = $_;
+ $in_symbol = 0 if !($val =~ s/\\\s*$//); # Last line
+ if ($val = /^\|expand/) { # Found an expand command
+ $in_symbol = 0; # Stop gathering value
+ $val .= "void::x"; # Stop any incomplete escape sequence
+ }
+ chop($val);
+ $Makesym{$current_symbol} .= $val;
+ } elsif (/^\s*(\w+)\s*=(.*)/ && !$in_symbol) {
+ # Found a makefile's macro declaration
+ $val = $2;
+ $current_symbol = $1;
+ if ($val =~ s/\\\s*$//) { # Remove final '\'
+ $in_symbol = 1; # This is a continuation line
+ }
+ $Makesym{$current_symbol} = $val;
+ push(@Order, $current_symbol); # Keep track of order
+ }
+ # Protect RCS keyword Id or Header from normal substitution
+ s/\$(Id|Header|Log)/\$X-$1/;
+ # Restore possibly escaped C comments
+ s|/#\*|/*|g;
+ s|\*#/|*/|g;
+ # Remove all ^^^ (null space character) up to next non-space character
+ s|\^\^\^\s*||g;
+ # Remove all ^^ (null space character)
+ s|\^\^||g;
+ # Restore escaped ^^ and ^^^ sequences
+ s|\^\\\^\\\^|^^^|g;
+ s|\^\\\^|^^|g;
+ next if /^#\s+\d+/; # Skip cpp commments
+
+ s/^;#/#/;
+ s/@#\s?/\n/g; # Kept for backward compatibility
+ s/@!\s?/\n/g;
+ s/@@\s?/\n\t/g;
+
+ # A '\r' is added to all lines, in order to let 'split' keep them
+ # As lines ending with '\' won't fit in the next regular
+ # expression (why ?), we have to treat that special case separately
+ s/\n$/\r\n/gm;
+ s/\\\s*$/\\\r/gm; # Remove spaces after final '\' and add '\r'
+ @macro = split(/\n/);
+ for ($i = 0; $i <= $#macro; $i++) {
+ chop($_ = $macro[$i]); # Remove final '\r'
+ s/\s+$//g; # Remove possible useless spaces
+ if (/^TOP\s*=\s*(\S+)/) { # Get the top from generated file
+ $top = $1;
+ }
+ find_wanted($_); # Look for known $(VAR) usage
+ if (s/^\s*>//) { # '>' means "symbol wanted"
+ warn "$me: the '>$_' construct is deprecated for known symbols\n"
+ if $wanted{$_} && !$warned_wanted_symbol_deprecated++;
+ $symbol{$_} = 1;
+ } elsif (s/^\s*\+//) { # '+' means "initialization section"
+ if (s/^\+(\w+)//) { # '++' means add to variable list
+ $added{$1} .= $_;
+ } else { # A single '+' means "add as is".
+ push(@init, $_);
+ }
+ } elsif (s/^\|//) { # Command for us
+ if (/suffix\s+(\S+)/) { # Add suffix
+ push(@suffix, $1) unless $seen{$1};
+ $seen{$1} = 1;
+ } elsif (s/^rule://) { # Add building rule
+ s/^\s(\s*\S+)/\t$1/; # Make sure leading tab is there
+ push(@rule, $_);
+ } elsif (/^skip/) { # Unconditional skip... funny!
+ push(@makefile, "|$_"); # Skip handled in pass 2
+ } elsif (/^expand/) {
+ push(@makefile, "|$_"); # Expand handled in pass 2
+ } elsif (/^once\s+(.*)/) { # Once handled in pass 1
+ if ($Once{$1}++) { # Symbol already seen -- skip
+ for (; $i <= $#macro; $i++) {
+ last if $macro[$i] =~/^-once/;
+ }
+ warn("$me: -once not found for $1")
+ unless $macro[$i] =~/^-once/;
+ }
+ } elsif (/^shell/) { # Escaping to shell
+ push(@makefile, "|$_"); # will be handled in pass 2
+ } elsif (/^case/) { # Conditional generation
+ push(@makefile, "|$_"); # will be handled in pass 2
+ } elsif (/^subst/) { # Section with var substitution
+ push(@makefile, "|$_"); # will be handled in pass 2
+ } else {
+ print "$me: Warning: unknown command $_\n";
+ }
+ } else {
+ next if /^-once/; # Control statement removed
+ push(@makefile, $_);
+ }
+ }
+}
+close CPP;
+
+@key = keys(%added);
+$last_was_blank = 1; # To avoid blank line at the top of the file
+$symbol{'INIT'} = 1 if ($#init >= 0 || $#key >=0); # Initializations
+$symbol{'SUFFIX'} = 1 if ($#suffix >= 0 || $#rule >=0); # Rules or suffixes
+$symbol{'TOP'} = 1 if $top eq '.'; # If imake invoked for the top
+
+$shellmode = 0; # Set to true within "shell" section
+$casemode = 0; # Counts nesting levels within "case" section
+$substmode = 0; # True when within section with variable substitution
+
+$SPIT_START = "\$spitshell >>Makefile <<'!NO!SUBS!'\n";
+$SPIT_END = "!NO!SUBS!\n";
+$GROK_START = "\$spitshell >>Makefile <<!GROK!THIS!\n";
+$GROK_END = "!GROK!THIS!\n";
+
+open(MAKEFILE, ">Makefile.SH");
+# We have to use for instead of foreach to handle 'skip' easily
+line: for ($i = 0; $i <= $#makefile; $i++) {
+ $_ = $makefile[$i];
+ next if /^-skip|-expand/; # They might have made a mistake
+
+ # Strip consecutive blank lines in generated file
+
+ if (/^\s*$/) {
+ next if ($last_was_blank);
+ $last_was_blank = 1;
+ } else {
+ $last_was_blank = 0;
+ }
+
+ # In shell mode, we're transparent, untill we reach a "-shell"
+ # We don't call print_makefile() as we don't want to record
+ # those non-makefile lines in the @Generated array.
+
+ if ($shellmode) {
+ if (/^-shell/) { # Ending shell mode, back to Makefile
+ print MAKEFILE $substmode ? $GROK_START : $SPIT_START;
+ $shellmode = 0;
+ } elsif (/^\|shell/) {
+ die "$me: can't nest 'shell' sections.\n";
+ } else {
+ print MAKEFILE "$_\n";
+ }
+ next;
+ } elsif (/^\|shell/) {
+ print MAKEFILE $substmode ? $GROK_END : $SPIT_END;
+ $shellmode = 1; # Next lines emitted verbatim as shell
+ next;
+ }
+
+ # In subst mode, the section until "-subst" is emitted regularily,
+ # excepted that it will be in a grok section, so its $var will be
+ # substituted by the shell.
+
+ if ($substmode) {
+ if (/^-subst/) { # Ending subst mode, back to regular
+ print MAKEFILE $GROK_END;
+ print MAKEFILE $SPIT_START;
+ $substmode = 0;
+ next;
+ } elsif (/^\|subst/) {
+ die "$me: can't nest 'subst' sections.\n";
+ }
+ # Continue with line
+ } elsif (/^\|subst/) {
+ print MAKEFILE $SPIT_END; # End spit section in Makefile.SH
+ print MAKEFILE $GROK_START;
+ $substmode = 1; # Next lines subject to $ interpretation
+ next;
+ }
+
+ # In a "case" section, the Makefile will be conditionally generated
+ # based on the value of the supplied variable, as evaluated by the shell.
+ # We can nest "case" sections without problems.
+
+ if (/^-case/) { # Ending current case section
+ if ($casemode == 0) {
+ warn "$me: ignoring spurious '-case'\n";
+ next;
+ }
+ print MAKEFILE $substmode ? $GROK_END : $SPIT_END;
+ my $indent = "\t" x ($casemode - 1);
+ print MAKEFILE "${indent}\t;;\n";
+ print MAKEFILE "${indent}esac\n";
+ print MAKEFILE "${indent}", $substmode ? $GROK_START : $SPIT_START;
+ $casemode--;
+ next;
+ }
+
+ if (/^\|case/) {
+ my ($var, $value) = /^\|case\s+(\w+)\s+in\s+(.*)/;
+ die "$me: unparseable directive '$_'\n" if $var eq '';
+ $casemode++;
+ print MAKEFILE $substmode ? $GROK_END : $SPIT_END;
+ my $indent = "\t" x ($casemode - 1);
+ print MAKEFILE "${indent}case \"\$$var\" in\n";
+ print MAKEFILE "${indent}$value)\n";
+ print MAKEFILE "${indent}\t", $substmode ? $GROK_START : $SPIT_START;
+ next;
+ }
+
+ # Process regular line to be generated in Makefile.SH
+
+ s/<TAG>/[jmake $version PL$patchlevel]/;
+
+ # Lines starting with ?SYMBOL: (resp. %SYMBOL:) are to be processed
+ # only if SYMBOL is defined (resp. undefined).
+
+ # Apply in sequence
+ while (/^\s*\?|\s*%/) {
+ if (s/^\s*\?(\w+)://) { # Wanted symbol ?
+ next line unless $symbol{$1};
+ } elsif (s/^\s*%(\w+)://) { # Unwanted symbol ?
+ next line if $symbol{$1};
+ } else {
+ print "$me: Warning: missing ':' in $_\n";
+ last;
+ }
+ }
+
+ # We wish to make sure there is a leading tab if the line starts with
+ # a space to prevent problems later on. However, variable definitions
+ # might want to be aligned on the '=' (imake style). Not all make
+ # may be able to cope with those though, so they are left justified
+ # again.
+
+ s/^\s/\t/ unless /^\s+\w+\s+=/; # Make sure leading tab is there
+ s/^\s+(\w+\s+=)/$1/; # Left justify variable definition
+ s/^;#/#/; # Comments in Jmakefile
+
+ if (s/^\|//) { # Command for us
+ if (/^skip/) { # Skip until -skip
+ for (; $i <= $#makefile; $i++) {
+ last if $makefile[$i] =~ /^-skip/;
+ }
+ } elsif (s/^expand//) {
+ &init_expand($_); # Initializes data structures
+ $i++; # Skip expand line
+ undef @Expand; # Storage for expanded lines
+ $pattern = ''; # Assume no pattern
+ for (; $i <= $#makefile; $i++) {
+ $_ = $makefile[$i];
+ if (s/^-expand//) { # Reached end of expansion
+ if (s/^\s*(.*)/$1/) { # Expand followed by a pattern
+ $pattern = $_; # Get pattern to be removed
+ }
+ last;
+ }
+ s/^\s/\t/; # Make sure leading tab is there
+ push(@Expand, $_); # Line to be expanded
+ }
+ &expand($pattern); # Expand all lines in buffer
+ } else {
+ die "$me: unknown command $_\n";
+ }
+ } elsif (/^INIT/) { # Initialization section
+ # All the initializations are put in the variable substitution
+ # section of the Makefile.SH. Therefore, we have to protect all
+ # the '$' signs that are not followed by an alphanumeric character.
+ foreach (@init) {
+ # Dumps core sometimes with perl 4.0 PL10
+ # &protect_dollars(*_);
+ $_ = &protect_dollars($_);
+ &print_makefile($_);
+ }
+ foreach (@key) { # @key set earlier to keys(%added)
+ $_ .= " = " . $added{$_};
+ # Dumps core sometimes with perl 4.0 PL10
+ # &protect_dollars(*_);
+ $_ = &protect_dollars($_);
+ &print_makefile($_);
+ }
+ } elsif (/^SUFFIX/) { # Suffixes/Rules section
+ # Rules and suffixes are put in the variable substitution
+ # section of the Makefile.SH. Therefore, we have to protect all
+ # the '$' signs that are not followed by an alphanumeric character.
+ if ($#suffix >= 0) {
+ print MAKEFILE ".SUFFIXES:";
+ foreach (@suffix) {
+ # Dumps core sometimes with perl 4.0 PL10
+ # &protect_dollars(*_);
+ $_ = &protect_dollars($_);
+ print MAKEFILE " $_";
+ }
+ print MAKEFILE "\n\n";
+ }
+ foreach (@rule) {
+ # Dumps core sometimes with perl 4.0 PL10
+ # &protect_dollars(*_);
+ $_ = &protect_dollars($_);
+ print MAKEFILE "$_\n";
+ }
+ } else {
+ &print_makefile($_);
+ }
+}
+close MAKEFILE;
+
+sub protect_dollars {
+ # Dumps core sometimes with perl 4.0 PL10
+ # local(*_) = shift(@_);
+ s/\\\$/\\=/g; # Protect already escaped '$'
+ s/(\$\W)/\\$1/g; # Escape unprotected '$'
+ s/\\=/\\\$/g; # Restore escaped '$'
+ $_; # Because perl dumps core... :-(
+}
+
+# Initializes data structures for expansion. If we detect Makefile
+# macro in the 'expand' line (the argument), then we write a small
+# makefile that will do the substitution for us -- I'm lazy today :-)
+sub init_expand {
+ local($_) = shift(@_);
+ undef %Vars; # Reset array of variables
+ $Vars_len = 0; # Number of "symbols" in first expanded
+ if (/\$\(\w+\)/) { # If at least one macro
+ local($make) = "/tmp/mkjm$$";
+ open(MAKE, ">$make") || die "$me: can't create $make: $!\n";
+ &gen_variables(); # Generates already computed variables
+ foreach $var (@Order) { # Print each in order we found them
+ print MAKE "$var = $Makesym{$var}\n" if !$Gvars{$var};
+ }
+ # We prepend OUTPUT: in front of the line that interests us, because
+ # some makes can print extra information, especially GNU make with
+ # its entering/leaving blurb when invoked from another makefile.
+ print MAKE "all:\n\t\@echo 'OUTPUT: $_'\n";
+ close MAKE;
+ chop($_ = `make -f $make all | grep ^OUTPUT:`);
+ unlink($make);
+ }
+ s/^OUTPUT: //;
+ while (s/^\s*(\w+)!([^!]*)!//) {
+ $Vars{$1} = $2;
+ # Record only length for _first_ expanded symbol
+ $Vars_len = split(/\s\s*/, $2) unless $Vars_len;
+ }
+}
+
+# Expand lines in the @Expand array. The argument is a pattern which is to
+# be removed from the last chunk of expanded lines.
+# For each symbol s, !s is replaced by the next item, and !s:p=q does the
+# same after having replaced the pattern 'p' by pattern 'q' in the item.
+# Spaces are NOT allowed in 'p' or 'q'. Substitution is done once (no /g).
+sub expand {
+ local($pattern) = shift; # To-be-removed pattern for last chunk
+ local($_);
+ local($sub);
+ local($i);
+ local(@expands);
+ for ($i = 0; $i < $Vars_len; $i++) {
+ foreach $line (@Expand) {
+ $_ = $line; # Don't modify elements in array
+ foreach $sym (keys %Vars) {
+ @expands = split(/\s\s*/, $Vars{$sym});
+ $sub = $expands[$i];
+ $sub =~ s/\/\///g; # // is a void value
+ while (s/!${sym}:([^\s]*)=([^\s]*)/,x##x,/) {
+ # Replacing item is altered by some pattern
+ local($p) = $1;
+ local($q) = $2;
+ local($subq) = $sub;
+ eval "\$subq =~ s=${p}=${q}=";
+ s/,x##x,/${subq}/;
+ }
+ s/!${sym}/${sub}/g;
+ }
+ # Protect substitution in an 'eval' in case of error
+ eval "s/${pattern}\$//" if $pattern && $i == ($Vars_len - 1);
+ &print_makefile($_);
+ }
+ }
+}
+
+# Prints its argument in MAKEFILE and records it also in Generated
+sub print_makefile {
+ local($_) = shift(@_); # Line to be printed
+ print MAKEFILE "$_\n";
+ push(@Generated, "$_\n");
+}
+
+# Generates in MAKE file all the generated variable we have so far for
+# final Makefile. This is mainly intended to allow expansion of variables
+# which are already defined with an expand.
+sub gen_variables {
+ undef %Gvars; # Reset already generated variables
+ local ($in_symbol) = 0; # True when in variable (Makefile's macro)
+ foreach (@Generated) {
+ if ($in_symbol) {
+ if (/^\s*(\w+)\s*=(.*)/) { # Missed the end of previous macro
+ $in_symbol = 0;
+ $Gvars{$1} = 1; # Definition of variable seen
+ $in_symbol = 1 if (/\\\s*$/); # There is a final '\'
+ print MAKE "void::\n"; # Cut incomplete esc sequence
+ } else {
+ $in_symbol = 0 if !(/\\\s*$/); # Last line
+ }
+ print MAKE;
+ } elsif (/^\s*(\w+)\s*=(.*)/ && !$in_symbol) {
+ # Found a makefile's macro declaration
+ $Gvars{$1} = 1; # Definition of variable seen
+ $in_symbol = 1 if (/\\\s*$/); # There is a final '\'
+ print MAKE;
+ }
+ }
+ print MAKE "void::\n"; # Cut incomplete escape sequence
+}
+
+# Parse line to extract all $(VAR) usage and trigger the symbol if VAR
+# is among the wanted set, as if they had manually said ">VAR" like in
+# the old days.
+sub find_wanted {
+ my ($l) = @_;
+ while ($l =~ s/\$\(([\w_]+)\)//) {
+ $symbol{$1}++ if $wanted{$1};
+ }
+}
+
+# Perform ~name expansion ala ksh...
+# (banish csh from your vocabulary ;-)
+sub tilda_expand {
+ local($path) = @_;
+ return $path unless $path =~ /^~/;
+ $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e; # ~name
+ $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e; # ~
+ $path;
+}
+
--- /dev/null
+#!/bin/sh
+# @(#) Generates a Makefile from a Jmakefile
+
+# $Id: jmkmf.SH 1 2006-08-24 12:32:52Z rmanfredi $
+#
+# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
+#
+# You may redistribute only under the terms of the Artistic Licence,
+# as specified in the README file that comes with the distribution.
+# You may reuse parts of this distribution only within the terms of
+# that same Artistic Licence; a copy of which may be found at the root
+# of the source tree for dist 4.0.
+#
+# $Log: jmkmf.SH,v $
+# Revision 3.0.1.2 2004/08/21 23:18:13 ram
+# patch71: automatically figures the top dir and the current dir
+# patch71: don't run Makefile.SH if the jmake call failed
+#
+# Revision 3.0.1.1 1993/08/19 06:42:14 ram
+# patch1: leading config.sh searching was not aborting properly
+#
+# Revision 3.0 1993/08/18 12:04:19 ram
+# Baseline for dist 3.0 netwide release.
+#
+
+usage="usage: $0 [top_of_sources_pathname [current_directory]]"
+
+curdir=
+
+case $# in
+ 0)
+ if test -f .package; then topdir=.;
+ elif test -f ../.package; then topdir=..;
+ elif test -f ../../.package; then topdir=../..;
+ elif test -f ../../../.package; then topdir=../../..;
+ elif test -f ../../../../.package; then topdir=../../../..;
+ else
+ echo "$0: WARNING: can't determine top package directory" >&2
+ fi
+ ;;
+ 1) topdir=$1 ;;
+ 2) topdir=$1 curdir=$2 ;;
+ *) echo "$usage" 1>&2; exit 1 ;;
+esac
+
+case "$topdir" in
+ -*) echo "$usage" 1>&2; exit 1 ;;
+esac
+
+case "$curdir" in
+'')
+ here=`pwd`
+ top=`cd $topdir; pwd`
+ curdir=`perl -e \
+ 'print substr($ARGV[0], length($ARGV[1])+1), "\n";' $here $top`
+ case "$curdir" in
+ '') curdir=.;;
+ esac
+ ;;
+esac
+
+if test -f Jmakefile; then
+ : ok
+else
+ echo "$0: no Jmakefile found in current directory" >&2
+ exit 1
+fi
+
+if test -f Makefile.SH; then
+ echo mv Makefile.SH Makefile.SH~
+ mv Makefile.SH Makefile.SH~
+fi
+
+args="-DTOPDIR=$topdir -DCURDIR=$curdir"
+
+echo jmake $args
+if jmake $args; then
+ echo sh Makefile.SH
+ sh Makefile.SH
+else
+ echo "jmake failed, aborting" >&2
+ exit 1
+fi
--- /dev/null
+#!/usr/bin/perl
+ eval "exec perl -S $0 $*"
+ if $running_under_some_shell;
+
+# $Id: kitpost.SH 1 2006-08-24 12:32:52Z rmanfredi $
+#
+# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
+#
+# You may redistribute only under the terms of the Artistic Licence,
+# as specified in the README file that comes with the distribution.
+# You may reuse parts of this distribution only within the terms of
+# that same Artistic Licence; a copy of which may be found at the root
+# of the source tree for dist 4.0.
+#
+# $Log: kitpost.SH,v $
+# Revision 3.0.1.2 1994/10/29 15:48:26 ram
+# patch36: don't use rootid as a variable, it is known by metaconfig
+#
+# Revision 3.0.1.1 1994/05/06 13:54:53 ram
+# patch23: created
+#
+
+$inews='inews';
+$mailer='/usr/sbin/sendmail';
+$orgname='PROCURA B.V.';
+$version = '3.5';
+$patchlevel = '0';
+
+$progname = &profile; # Read ~/.dist_profile
+require 'getopts.pl';
+&usage unless $#ARGV >= 0;
+&usage unless &Getopts("hrVm:D:H:");
+
+if ($opt_V) {
+ print STDERR "$progname $version PL$patchlevel\n";
+ exit 0;
+} elsif ($opt_h) {
+ &usage;
+}
+
+$RCSEXT = ',v' unless $RCSEXT;
+if ($inews eq 'inews') {
+ $inews = '/usr/lib/news/inews' if -f '/usr/lib/news/inews';
+}
+
+chdir '..' if -d '../bugs';
+
+&readpackage;
+
+$orgname = &tilda_expand($orgname);
+chop($orgname = `cat $orgname`) if $orgname =~ m|^/|;
+
+if ($opt_r) {
+ $repost = ' (REPOST)';
+}
+
+while ($_ = shift) {
+ if (/^(kit)?[1-9][\d\-]*$/) {
+ s/^kit//;
+ push(@argv,$_);
+ } else {
+ push(@ngroups,$_);
+ }
+}
+$ngroups = join(',',@ngroups) unless $#ngroups < 0;
+$dest = $opt_m;
+&usage unless $ngroups || $dest;
+
+@ARGV = @argv;
+
+if (-f "$package.kit10") {
+ @filelist = <$package.kit[0-9][0-9]>;
+}
+else {
+ @filelist = <$package.kit[0-9]>;
+}
+pop(@filelist) =~ /(\d+)$/ && ($maxnum = $1 + 0);
+
+if ($#ARGV < 0) {
+ $argv = "1-$maxnum";
+ @ARGV = $argv;
+}
+
+$argv = &rangeargs(@ARGV);
+@ARGV = split(' ', $argv);
+
+$argv =~ s/ $//;
+
+if ($#ARGV < 0) {
+ print STDERR "$progname: no kits specified.\n";
+ &usage;
+} else {
+ local($s) = $#ARGV ? 's' : '';
+ print "$progname: posting $package $baserev kit$s $argv to $ngroups...\n"
+ if $ngroups;
+ print "$progname: mailing $package $baserev kit$s $argv to $dest...\n"
+ if $dest;
+}
+
+$desc = "$opt_D, " if $opt_D;
+
+fork && exit;
+
+# Compute a suitable root message ID that all parts will reference, so that
+# threaded news readers will correctly process them.
+# Unfortunately, this works only when all kits are sent.
+($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
+ localtime(time);
+$mon++;
+$rootmid = "$year$mon$mday$hour$min$sec.AA$$";
+$first = $maxnum >= 10 ? "01" : "1";
+$rootmsgid = "<$rootmid.P$first.$maintloc>";
+
+until ($#ARGV < 0) {
+ $kitnum = shift;
+ $kitnum = "0$kitnum" if $kitnum < 10 && $maxnum >= 10;
+ open(FILE, "$package.kit$kitnum") ||
+ die "$progname: can't open $package.kit$kitnum: $!\n";
+ if ($ngroups) {
+ open(INEWS,"|$inews -h") || die "$progname: can't fork $inews: $!\n";
+ }
+ if ($dest) {
+ $opt = '-odq' if $mailer =~ /sendmail/;
+ $dest =~ s/,/ /g;
+ ($to = $dest) =~ s/\s+/, /g;
+ open(MAILER,"|$mailer $opt $dest") ||
+ die "$progname: can't fork $mailer: $!\n";
+ }
+
+ $msg_id = "<$rootmid.P$kitnum.$maintloc>";
+ $msg_id = $rootmsgid if $kitnum == 1;
+ $msg_id .= "\nReferences: $rootmsgid" if $kitnum != 1;
+
+ print INEWS "Newsgroups: $ngroups\n";
+ print MAILER "To: $to\n";
+$head = <<EOH;
+Subject: $package $baserev - ${desc}part$kitnum/$maxnum$repost
+Message-ID: $msg_id
+Organization: $orgname
+
+Submitted-by: $maintname <$maintloc>
+Archive-name: $package-$baserev/part$kitnum
+Environment: UNIX
+
+EOH
+ print INEWS $head;
+ print MAILER $head;
+
+ if ($kitnum == 1 && $opt_H) {
+ open(HEAD, $opt_H) || warn "$progname: can't open $opt_H: $!\n";
+ while (<HEAD>) {
+ print INEWS;
+ print MAILER;
+ }
+ close HEAD;
+ }
+
+ while (<FILE>) {
+ print INEWS;
+ print MAILER;
+ }
+ close FILE;
+ close INEWS;
+ die "$progname: could not post part$kitnum.\n" if $ngroups && $?;
+ close MAILER;
+ die "$progname: could not send part$kitnum.\n" if $dest && $?;
+}
+
+sub usage {
+ print STDERR <<EOM;
+Usage: $progname [-hrV] [-H file] [-D desc] [-m dest1,dest2] [kits] [newsgroups]
+ -h : print this message and exit
+ -m : set-up recipients for (additional) mailing
+ -r : signals a repost
+ -D : specify description string for subject line
+ -H : specify file to be used as header for first part
+ -V : print version number and exit
+EOM
+ exit 1;
+}
+
+sub rangeargs {
+ local($result) = '';
+ local($min,$max,$_);
+ while ($#_ >= 0) {
+ $_ = shift(@_);
+ while (/^\s*\d/) {
+ s/^\s*(\d+)//;
+ $min = $1;
+ if (s/^,//) {
+ $max = $min;
+ }
+ elsif (s/^-(\d*)//) {
+ $max = $1;
+ if ($max == 0 && $maxnum) {
+ $max = $maxnum;
+ }
+ s/^[^,],?//;
+ }
+ else {
+ $max = $min;
+ }
+ for ($i = $min; $i <= $max; ++$i) {
+ $result .= $i . ' ';
+ }
+ }
+ }
+ $result;
+}
+
+sub readpackage {
+ if (! -f '.package') {
+ if (
+ -f '../.package' ||
+ -f '../../.package' ||
+ -f '../../../.package' ||
+ -f '../../../../.package'
+ ) {
+ die "Run in top level directory only.\n";
+ } else {
+ die "No .package file! Run packinit.\n";
+ }
+ }
+ open(PACKAGE,'.package');
+ while (<PACKAGE>) {
+ next if /^:/;
+ next if /^#/;
+ if (($var,$val) = /^\s*(\w+)=(.*)/) {
+ $val = "\"$val\"" unless $val =~ /^['"]/;
+ eval "\$$var = $val;";
+ }
+ }
+ close PACKAGE;
+}
+
+# Perform ~name expansion ala ksh...
+# (banish csh from your vocabulary ;-)
+sub tilda_expand {
+ local($path) = @_;
+ return $path unless $path =~ /^~/;
+ $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e; # ~name
+ $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e; # ~
+ $path;
+}
+
+# Set up profile components into %Profile, add any profile-supplied options
+# into @ARGV and return the command invocation name.
+sub profile {
+ local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
+ local($me) = $0; # Command name
+ $me =~ s|.*/(.*)|$1|; # Keep only base name
+ return $me unless -s $profile;
+ local(*PROFILE); # Local file descriptor
+ local($options) = ''; # Options we get back from profile
+ unless (open(PROFILE, $profile)) {
+ warn "$me: cannot open $profile: $!\n";
+ return;
+ }
+ local($_);
+ local($component);
+ while (<PROFILE>) {
+ next if /^\s*#/; # Skip comments
+ next unless /^$me/o;
+ if (s/^$me://o) { # progname: options
+ chop;
+ $options .= $_; # Merge options if more than one line
+ }
+ elsif (s/^$me-([^:]+)://o) { # progname-component: value
+ $component = $1;
+ chop;
+ s/^\s+//; # Trim leading and trailing spaces
+ s/\s+$//;
+ $Profile{$component} = $_;
+ }
+ }
+ close PROFILE;
+ return unless $options;
+ require 'shellwords.pl';
+ local(@opts);
+ eval '@opts = &shellwords($options)'; # Protect against mismatched quotes
+ unshift(@ARGV, @opts);
+ return $me; # Return our invocation name
+}
+
--- /dev/null
+#!/usr/bin/perl
+ eval 'exec perl -S $0 "$@"'
+ if $running_under_some_shell;
+
+# $Id: kitsend.SH 1 2006-08-24 12:32:52Z rmanfredi $
+#
+# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
+#
+# You may redistribute only under the terms of the Artistic Licence,
+# as specified in the README file that comes with the distribution.
+# You may reuse parts of this distribution only within the terms of
+# that same Artistic Licence; a copy of which may be found at the root
+# of the source tree for dist 4.0.
+#
+# Original Author: Harlan Stenn <harlan@mumps.pfcs.com>
+#
+# $Log: kitsend.SH,v $
+# Revision 3.0.1.2 1994/05/06 13:59:57 ram
+# patch23: random code cleanup to follow pat tools style
+# patch23: made configurable from dist profile
+# patch23: now understands -V and -h options
+# patch23: mails now flagged with a bulk precedence
+# patch23: added X-Mailer header and now calls mailer via open()
+#
+# Revision 3.0.1.1 1993/08/19 06:42:15 ram
+# patch1: leading config.sh searching was not aborting properly
+#
+# Revision 3.0 1993/08/18 12:04:25 ram
+# Baseline for dist 3.0 netwide release.
+#
+
+$orgname='PROCURA B.V.';
+$mailer='/usr/sbin/sendmail';
+$version = '3.5';
+$patchlevel = '0';
+
+$progname = &profile; # Read ~/.dist_profile
+require 'getopts.pl';
+&usage unless &Getopts('hV');
+
+if ($opt_V) {
+ print STDERR "$progname $version PL$patchlevel\n";
+ exit 0;
+} elsif ($opt_h) {
+ &usage;
+}
+
+$orgname = &tilda_expand($orgname);
+chop($orgname = `cat $orgname`) if $orgname =~ m|^/|;
+
+&readpackage;
+
+while ($_ = shift) {
+ if (/^(kit)?[1-9][\d,-]*$/) {
+ s/^kit//;
+ push(@argv, $_);
+ }
+ else {
+ push(@dest, $_);
+ }
+}
+$dest = join(' ',@dest);
+&usage unless $dest;
+
+@ARGV = @argv;
+
+if (-f "$package.kit10") {
+ @filelist = <$package.kit[0-9][0-9]>;
+}
+else {
+ @filelist = <$package.kit[0-9]>;
+}
+pop(@filelist) =~ /(\d+)$/ && ($maxnum = $1 + 0);
+
+if ($#ARGV < 0) {
+ $argv = "1-$maxnum";
+ @ARGV = $argv;
+}
+$argv = &rangeargs(@ARGV);
+@ARGV = split(' ', $argv);
+
+$argv =~ s/ $//;
+
+if ($#ARGV < 0) {
+ die "$progname: no kits specified.\n";
+} elsif ($#ARGV) {
+ print "$progname: sending $package $baserev kits $argv to $dest...\n";
+} else {
+ print "$progname: sending $package $baserev kit $argv to $dest...\n";
+}
+
+fork && exit;
+
+$opt = '-odq' if $mailer =~ /sendmail/;
+
+until ($#ARGV < 0) {
+ $kitnum = shift;
+
+ # Provision for broken mailers...
+ @dest = split(' ', $dest);
+ while (@smalldest = splice(@dest, 0, 50)) {
+ $to = join(', ', @smalldest); # Sensible To: for sendmail
+ $smalldest = join(' ', @smalldest);
+
+ open(MAILER, "|$mailer $opt $smalldest") ||
+ die "$progname: can't fork $mailer: $!\n";
+ print MAILER
+"To: $to
+Subject: $package $baserev kit #$kitnum
+Precedence: bulk
+X-Mailer: dist [version $version PL$patchlevel]
+Organization: $orgname
+
+[There are $maxnum kits for $package version $baserev.]
+
+";
+ $kitnum = "0$kitnum" if $kitnum < 10 && $maxnum >= 10;
+ open(FILE,"$package.kit$kitnum") ||
+ die "$progname: can't open $package.kit$kitnum: $!\n";
+ while (<FILE>) {
+ print MAILER;
+ }
+ close FILE;
+ close MAILER;
+ warn "$progname: ERROR mailing of $package.kit$kitnum to $dest\n" if $?;
+ }
+}
+
+sub usage {
+ print STDERR <<EOM;
+Usage: $progname [-hV] [kits] dest
+ -h : print this message and exit
+ -V : print version number and exit
+EOM
+ exit 1;
+}
+
+sub rangeargs {
+ local($result) = '';
+ local($min,$max,$_);
+ while ($#_ >= 0) {
+ $_ = shift(@_);
+ while (/^\s*\d/) {
+ s/^\s*(\d+)//;
+ $min = $1;
+ if (s/^,//) {
+ $max = $min;
+ }
+ elsif (s/^-(\d*)//) {
+ $max = $1;
+ if ($max == 0 && $maxnum) {
+ $max = $maxnum;
+ }
+ s/^[^,],?//;
+ }
+ else {
+ $max = $min;
+ }
+ for ($i = $min; $i <= $max; ++$i) {
+ $result .= $i . ' ';
+ }
+ }
+ }
+ $result;
+}
+
+sub readpackage {
+ if (! -f '.package') {
+ if (
+ -f '../.package' ||
+ -f '../../.package' ||
+ -f '../../../.package' ||
+ -f '../../../../.package'
+ ) {
+ die "Run in top level directory only.\n";
+ } else {
+ die "No .package file! Run packinit.\n";
+ }
+ }
+ open(PACKAGE,'.package');
+ while (<PACKAGE>) {
+ next if /^:/;
+ next if /^#/;
+ if (($var,$val) = /^\s*(\w+)=(.*)/) {
+ $val = "\"$val\"" unless $val =~ /^['"]/;
+ eval "\$$var = $val;";
+ }
+ }
+ close PACKAGE;
+}
+
+# Perform ~name expansion ala ksh...
+# (banish csh from your vocabulary ;-)
+sub tilda_expand {
+ local($path) = @_;
+ return $path unless $path =~ /^~/;
+ $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e; # ~name
+ $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e; # ~
+ $path;
+}
+
+# Set up profile components into %Profile, add any profile-supplied options
+# into @ARGV and return the command invocation name.
+sub profile {
+ local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
+ local($me) = $0; # Command name
+ $me =~ s|.*/(.*)|$1|; # Keep only base name
+ return $me unless -s $profile;
+ local(*PROFILE); # Local file descriptor
+ local($options) = ''; # Options we get back from profile
+ unless (open(PROFILE, $profile)) {
+ warn "$me: cannot open $profile: $!\n";
+ return;
+ }
+ local($_);
+ local($component);
+ while (<PROFILE>) {
+ next if /^\s*#/; # Skip comments
+ next unless /^$me/o;
+ if (s/^$me://o) { # progname: options
+ chop;
+ $options .= $_; # Merge options if more than one line
+ }
+ elsif (s/^$me-([^:]+)://o) { # progname-component: value
+ $component = $1;
+ chop;
+ s/^\s+//; # Trim leading and trailing spaces
+ s/\s+$//;
+ $Profile{$component} = $_;
+ }
+ }
+ close PROFILE;
+ return unless $options;
+ require 'shellwords.pl';
+ local(@opts);
+ eval '@opts = &shellwords($options)'; # Protect against mismatched quotes
+ unshift(@ARGV, @opts);
+ return $me; # Return our invocation name
+}
+
--- /dev/null
+#!/bin/sh
+
+# $Id: makeSH,v 3.0.1.1 1993/08/19 06:42:16 ram Exp ram $
+#
+# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
+#
+# You may redistribute only under the terms of the Artistic Licence,
+# as specified in the README file that comes with the distribution.
+# You may reuse parts of this distribution only within the terms of
+# that same Artistic Licence; a copy of which may be found at the root
+# of the source tree for dist 4.0.
+#
+# Original Author: Larry Wall <lwall@netlabs.com>
+#
+# $Log: makeSH,v $
+# Revision 3.0.1.1 1993/08/19 06:42:16 ram
+# patch1: leading config.sh searching was not aborting properly
+#
+# Revision 3.0 1993/08/18 12:04:26 ram
+# Baseline for dist 3.0 netwide release.
+#
+
+for file do
+ if test -f $file.SH; then
+ mv $file.SH $file.SH.old
+ echo "makeSH: renaming $file.SH as $file.SH.old."
+ fi
+ base=`basename $file`
+
+ cat >$file.SH <<BLURFL
+case \$CONFIG in
+'')
+ if test -f config.sh; then TOP=.;
+ elif test -f ../config.sh; then TOP=..;
+ elif test -f ../../config.sh; then TOP=../..;
+ elif test -f ../../../config.sh; then TOP=../../..;
+ elif test -f ../../../../config.sh; then TOP=../../../..;
+ else
+ echo "Can't find config.sh."; exit 1
+ fi
+ . \$TOP/config.sh
+ ;;
+esac
+: This forces SH files to create target in same directory as SH file.
+: This is so that make depend always knows where to find SH derivatives.
+case "\$0" in
+*/*) cd \`expr X\$0 : 'X\(.*\)/'\` ;;
+esac
+echo "Extracting $file (with variable substitutions)"
+: This section of the file will have variable substitutions done on it.
+: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
+: Protect any dollar signs and backticks that you do not want interpreted
+: by putting a backslash in front. You may delete these comments.
+\$spitshell >$base <<!GROK!THIS!
+BLURFL
+
+ case `sed q $file` in
+ */bin/sh) echo '$startsh' >>$file.SH ;;
+ esac
+
+ cat >>$file.SH <<BLURFL
+!GROK!THIS!
+
+: In the following dollars and backticks do not need the extra backslash.
+\$spitshell >>$base <<'!NO!SUBS!'
+BLURFL
+
+ sed -e '1{' -e '/#!.*\/bin\/sh$/d' -e '}' $file >>$file.SH
+
+ cat >>$file.SH <<BLURFL
+!NO!SUBS!
+chmod 755 $base
+\$eunicefix $base
+BLURFL
+ chmod 755 $file.SH
+done
--- /dev/null
+#!/usr/bin/perl
+ eval "exec perl -S $0 $*"
+ if $running_under_some_shell;
+
+# $Id: makedist.SH 1 2006-08-24 12:32:52Z rmanfredi $
+#
+# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
+#
+# You may redistribute only under the terms of the Artistic Licence,
+# as specified in the README file that comes with the distribution.
+# You may reuse parts of this distribution only within the terms of
+# that same Artistic Licence; a copy of which may be found at the root
+# of the source tree for dist 4.0.
+#
+# $Log: makedist.SH,v $
+# Revision 3.0.1.2 1994/01/24 13:58:20 ram
+# patch16: modified call to manifake to trap exceptions manually
+# patch16: removed final sed post-processing to allow 'make depend' target
+# patch16: added ~/.dist_profile awareness
+#
+# Revision 3.0.1.1 1993/08/19 06:42:17 ram
+# patch1: leading config.sh searching was not aborting properly
+#
+# Revision 3.0 1993/08/18 12:04:28 ram
+# Baseline for dist 3.0 netwide release.
+#
+
+$version = '3.5';
+$patchlevel = '0';
+
+&profile; # Read ~/.dist_profile
+require 'getopts.pl';
+&usage unless &Getopts('c:f:dhvqs:V');
+
+$ENV{'DIST'} = '/dev/null'; # Disable ~/.dist_profile
+
+if ($opt_V) {
+ print STDERR "makedist $version PL$patchlevel\n";
+ exit 0;
+} elsif ($opt_h) {
+ &usage;
+}
+
+$MAXKITSIZE = 50000 unless $MAXKITSIZE = $opt_s;
+$KITOVERHEAD = 1800;
+$FILEOVERHEAD = 90;
+$CHOPSIZE = $MAXKITSIZE - $KITOVERHEAD - $FILEOVERHEAD;
+
+$NEWMANI = 'MANIFEST.new' unless $NEWMANI = $opt_f;
+$MANI = 'MANIFEST' unless $opt_f;
+$PACKLIST = 'PACKLIST';
+$PACKNOTES = 'PACKNOTES';
+
+$tmpdir = "/tmp/MKst$$"; # Where to copy distribution
+$tmpdir = '.' if $opt_q; # Quick mode: no need to copy distribution
+
+&set_sig('aborted'); # Make sure we clean up in case of emergency
+
+&readpackage;
+&get_patchlevel;
+
+eval '&manifake'; # Want to trap possible die and redirect to fatal
+if ($@ ne '') {
+ chop($@);
+ &fatal($@);
+}
+
+if ($opt_c) { # Copy distribution only, no shell archive
+ &distcopy;
+ exit 0;
+}
+
+&distfake;
+©right'init($copyright) if -f $copyright;
+
+unlink <$package.kit? $package.kit??>;
+chop($curdir = `pwd`);
+chdir $tmpdir || die "Can't chdir to $tmpdir.\n";
+
+&maniread;
+&kitlists;
+&manimake;
+&kitbuild;
+&cleanup;
+exit 0;
+
+# Physically build the kits
+sub kitbuild {
+ $numkits = $#list;
+ if ($numkits > 9) {
+ $sp = '%02d';
+ } else {
+ $sp = '%d';
+ }
+
+ for ($kitnum = 1; $kitnum <= $numkits; $kitnum++) {
+ $list = $list[$kitnum];
+ $kit = sprintf("$package.kit" . $sp,$kitnum);
+ print "*** Making $kit ***\n";
+ open(KIT,">$curdir/$kit") || do fatal("Can't create $curdir/$kit: $!");
+
+ &kitleader;
+
+ @files = split(' ',$list);
+ reset 'X';
+ for $file (@files) {
+ $_ = $file;
+ while (s|^(.*)/.*$|$1|) {
+ push(@Xdirs,$_) unless $Xseen{$_}++;
+ }
+ }
+ print KIT "mkdir ",join(' ', sort @Xdirs)," 2>/dev/null\n";
+
+ foreach $file (@files) {
+ print "\t",$file,"\n" if $opt_v;
+ print KIT "echo Extracting $file\n";
+ print KIT "sed >$file <<'!STUFFY!FUNK!' -e 's/X//'\n";
+ open(FILE, $file);
+ ©right'reset; # Reset copyright for new file
+ while (<FILE>) {
+ # Use Lock[e]r as a pattern in case it is applied on ourselves
+ s|Lock[e]r:.*\$|\$|; # Remove locker mark
+ print KIT ©right'filter($_, 'X');
+ }
+ close FILE;
+ print KIT "!STUFFY!FUNK!\n";
+ -x "$file" && (print KIT "chmod +x $file\n");
+ }
+ &kittrailer;
+ chmod 0755, $kit;
+ }
+}
+
+sub kitlists {
+ for $filename (keys %comment) {
+ next if $filename =~ m|/$|; # Skip directories
+ next if -d $filename; # Better safe than sorry
+ ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+ $blksize,$blocks) = stat($filename);
+
+ # Make sure file is not larger than the CHOPSIZE limit. If it is,
+ # a split is attempted.
+ if ($size > $CHOPSIZE) {
+ print "Splitting $filename...\n" if $opt_v;
+ $file_comment = $comment{$filename};
+ open(FILE, $filename) || die "Can't open $filename: $!\n";
+ $piece = 'AA';
+ ($dir, $name) = ('.', $filename)
+ unless ($dir, $name) = ($filename =~ m|(.*)/(.*)|);
+ $chopped = $dir . '/' . substr($name, 0, 11);
+ $chopped =~ s|^\./||;
+ &fatal("There is already a split file named $chopped")
+ if defined $Chopped{$chopped};
+ $Chopped{$chopped} = $filename; # Association split <-> real file
+ $size = 0;
+ open(CURPIECE, ">$chopped:$piece") ||
+ &fatal("Can't create $chopped:$piece: $!");
+ while (<FILE>) {
+ if ($size + length($_) > $CHOPSIZE) {
+ close CURPIECE;
+ $size{"$chopped:$piece"} = $size;
+ $comment{"$chopped:$piece"} = "$file_comment (part $piece)";
+ push(@files, "$chopped:$piece");
+ print "\t$chopped:$piece ($size bytes)\n" if $opt_v;
+ $size = 0;
+ $piece++; # AA -> AB, etc...
+ open(CURPIECE, ">$chopped:$piece") ||
+ &fatal("Can't create $chopped:$piece: $!");
+ }
+ print CURPIECE $_;
+ $size += length($_);
+ }
+ close FILE;
+ close CURPIECE;
+ $size{"$chopped:$piece"} = $size;
+ $comment{"$chopped:$piece"} = "$file_comment (part $piece)";
+ push(@files, "$chopped:$piece");
+ print "\t$chopped:$piece ($size bytes)\n" if $opt_v;
+ delete $comment{$filename}; # File split, not in PACKLIST
+ } else {
+ $size += 1000000 if $filename =~ /README/;
+ $size{$filename} = $size;
+ push(@files, "$filename");
+ }
+ }
+
+ # Build a file PACKNOTES to reconstruct split files
+ if (defined %Chopped) {
+ open(PACKNOTES, ">$PACKNOTES") || &fatal("Can't create PACKNOTES: $!");
+ foreach (keys %Chopped) {
+ print PACKNOTES <<EOC;
+echo 'Building $Chopped{$_}...'
+cat $_:[A-Z][A-Z] > $Chopped{$_}
+rm -f $_:[A-Z][A-Z]
+EOC
+ }
+ close PACKNOTES;
+ push(@files, $PACKNOTES);
+ $comment{$PACKNOTES} = 'Script to reconstruct split files';
+ ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+ $blksize,$blocks) = stat($PACKNOTES);
+ $size{$PACKNOTES} = $size;
+ }
+
+ # Currently, file PACKLIST does not exist, so its size is unknown and
+ # it cannot be correctly put in one archive. Therefore, we take the
+ # size of MANIFEST.new, which will give us a good estimation.
+ push(@files, 'PACKLIST');
+
+ ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+ $blksize,$blocks) = stat($NEWMANI);
+ $size{$PACKLIST} = $size;
+
+ sub revnum { $size{$a} < $size{$b} ? 1 : $size{$a} > $size{$b} ? -1 : 0; }
+ @files = sort revnum @files;
+
+ for (@files) {
+ $size = $size{$_};
+ $size -= 1000000 if /README/;
+ $i=1;
+ while (($newtot = int($tot[$i] + $size + $size/40 + $FILEOVERHEAD)) >
+ $MAXKITSIZE-$KITOVERHEAD && $tot[$i]) {
+ $i++;
+ }
+ $tot[$i] = $newtot;
+ print "Adding $_ to kit $i giving $newtot bytes\n" if $opt_d;
+ $kit{$_} = $i;
+ $list[$i] .= " $_";
+ }
+}
+
+# Read manifest file and initialize the %comment array.
+sub maniread {
+ do fatal("You don't have a $NEWMANI file. Run manifake")
+ unless -f "$NEWMANI";
+ open(NEWMANI,$NEWMANI) || do fatal("Can't read $NEWMANI: $!");
+ while (<NEWMANI>) {
+ ($key,$val) = split(' ',$_,1) unless ($key,$val) = /^(\S+)\s+(.*)/;
+ $comment{$key} = $val;
+ }
+ close NEWMANI;
+}
+
+# MANIFEST and MANIFEST.new must say the same thing. Create the
+# PACKLIST file (thus avoiding kit numbers in MANIFEST, which causes big
+# patches when only re-ordering occurred). Note that PACKLIST should
+# not appear in MANIFEST.new (the user may remove it).
+sub manimake {
+ # Add built packlist
+ $comment{$PACKLIST} = 'Which files came with which kits';
+
+ open(PACKLIST, ">$PACKLIST") || do fatal("Can't create $PACKLIST: $!");
+ print PACKLIST
+"After all the $package kits are run you should have the following files:
+
+Filename Kit Description
+-------- --- -----------
+";
+ for (sort keys(comment)) {
+ printf PACKLIST "%-27s %2s %.47s\n", $_, $kit{$_}, $comment{$_};
+ }
+ close PACKLIST;
+}
+
+sub kitleader {
+ local($plevel);
+ $plevel = " at patchlevel $patch_level" if $patch_level ne '';
+ print KIT <<EOH;
+#! /bin/sh
+#
+# This is $package version $baserev$plevel.
+# Make a new directory for the $package sources, cd to it, and run kits 1 up
+# to $numkits through sh. When all $numkits kits have been run, read README.
+#
+echo " "
+cat <<EOM
+This is $package $baserev$plevel, kit $kitnum (of $numkits):
+If this shell archive is complete, the line "End of kit $kitnum (of $numkits)"
+will echo at the end.
+EOM
+export PATH || (echo "Please use sh to unpack this archive." ; kill \$\$)
+EOH
+}
+
+sub kittrailer {
+ $rangelist = '';
+ for ($i = 1; $i <= $numkits; $i++) {
+ $rangelist .= ' ' . $i;
+ }
+ print KIT <<EOM;
+echo \"End of kit $kitnum (of $numkits)\"
+echo \" \"
+cat /dev/null >kit${kitnum}isdone
+run=''
+config=''
+for iskit in$rangelist; do
+ if test -f kit\${iskit}isdone; then
+ run=\"\$run \$iskit\"
+ else
+ todo=\"\$todo \$iskit\"
+ fi
+done
+case \$todo in
+ '')
+ echo \"You have run all your kits.\"
+EOM
+ if (defined %Chopped) { # Some splitting occurred
+ print KIT <<EOM;
+ if test -f $PACKNOTES; then
+ sh $PACKNOTES
+ else
+ echo \"You have to rebuild split files by hand (see $PACKLIST).\"
+ fi
+EOM
+ }
+ if (-f "README" && -f "Configure") {
+ print KIT
+" echo \"Please read README and then type Configure.\"
+ chmod 755 Configure\n";
+ } elsif (-f "README") {
+ print KIT
+" echo \"Please read README first.\"\n";
+ } elsif (-f "Configure") {
+ print KIT
+" echo \"Please run Configure first.\"
+ chmod 755 Configure\n";
+ }
+ print KIT <<EOM;
+ rm -f kit*isdone
+ ;;
+ *) echo \"You have run\$run.\"
+ echo \"You still need to run\$todo.\"
+ ;;
+esac
+: Someone might mail this, so exit before signature...
+exit 0
+EOM
+}
+
+sub get_patchlevel {
+ $patch_level = '';
+ if (-f 'patchlevel.h') {
+ open(PL, 'patchlevel.h');
+ while (<PL>) {
+ /^#define\s+PATCHLEVEL\s+(\w+)/ && ($patch_level = $1);
+ }
+ close PL;
+ }
+}
+
+sub distfake {
+ return if $opt_q;
+ local($sw);
+ $sw = 's' unless $opt_v;
+ mkdir($tmpdir, 0700) || die "Can't create directory $tmpdir.\n";
+ print "Building a copy of distribution in $tmpdir...\n" if $opt_v;
+ system 'perl', '-S', 'patcol', "-a$sw", '-f', $NEWMANI, '-d', $tmpdir;
+ system 'cp', $NEWMANI, "$tmpdir/$NEWMANI"
+ unless -f "$tmpdir/$NEWMANI" && !$opt_f;
+}
+
+sub distcopy {
+ local($sw); # Switch to force patcol to copy checked out files
+ &makedir($opt_c);
+ print "Building a copy of distribution in $opt_c...\n" if $opt_v;
+ $sw = 'c' if $opt_q;
+ $sw .= 's' unless $opt_v;
+ system 'perl', '-S', 'patcol', "-aRC$sw", '-f', $NEWMANI, '-d', $opt_c;
+}
+
+sub distrm {
+ return if $opt_q;
+ print "Removing distribution in $tmpdir...\n" if $opt_v;
+ chdir "/"; # Do not stay in removed directory...
+ system '/bin/rm', '-rf', "$tmpdir";
+}
+
+sub splitrm {
+ foreach $base (keys %Chopped) {
+ print "Removing split files for $base:\n" if $opt_v;
+ $piece = 'AA';
+ while (-f "$base:$piece") {
+ print "\t$base:$piece\n" if $opt_v;
+ unlink "$base:$piece";
+ $piece++; # AA -> AB, etc...
+ }
+ }
+}
+
+sub cleanup {
+ &distrm if -d $tmpdir;
+ if ($opt_q) {
+ &splitrm; # Remove in-place split files
+ unlink $PACKLIST, $PACKNOTES;
+ }
+}
+
+sub fatal {
+ local($reason) = shift(@_);
+ &cleanup;
+ die "$reason\n";
+}
+
+sub set_sig {
+ local($handler) = @_;
+ $SIG{'HUP'} = $handler;
+ $SIG{'INT'} = $handler;
+ $SIG{'QUIT'} = $handler;
+ $SIG{'TERM'} = $handler;
+}
+
+sub aborted {
+ &set_sig('IGNORE');
+ $opt_v = 1; # Force verbose message in distrm
+ &cleanup;
+ print "Aborted.\n";
+ exit 1;
+}
+
+sub usage {
+ print STDERR <<EOM;
+Usage: makedist [-dhqvV] [-c dir] [-s size] [-f manifest]
+ -c : copy files in dir, do not build any shell archive.
+ -d : debug mode.
+ -f : use this file as manifest.
+ -h : print this help message and exits.
+ -q : quick mode: use checked-out files.
+ -s : set maximum pack size.
+ -v : verbose mode.
+ -V : print version number and exits.
+EOM
+ exit 1;
+}
+
+sub readpackage {
+ if (! -f '.package') {
+ if (
+ -f '../.package' ||
+ -f '../../.package' ||
+ -f '../../../.package' ||
+ -f '../../../../.package'
+ ) {
+ die "Run in top level directory only.\n";
+ } else {
+ die "No .package file! Run packinit.\n";
+ }
+ }
+ open(PACKAGE,'.package');
+ while (<PACKAGE>) {
+ next if /^:/;
+ next if /^#/;
+ if (($var,$val) = /^\s*(\w+)=(.*)/) {
+ $val = "\"$val\"" unless $val =~ /^['"]/;
+ eval "\$$var = $val;";
+ }
+ }
+ close PACKAGE;
+}
+
+sub manifake {
+ # make MANIFEST and MANIFEST.new say the same thing
+ if (! -f $NEWMANI) {
+ if (-f $MANI) {
+ open(IN,$MANI) || die "Can't open $MANI";
+ open(OUT,">$NEWMANI") || die "Can't create $NEWMANI";
+ while (<IN>) {
+ if (/---/) {
+ # Everything until now was a header...
+ close OUT;
+ open(OUT,">$NEWMANI") ||
+ die "Can't recreate $NEWMANI";
+ next;
+ }
+ s/^\s*(\S+\s+)[0-9]*\s*(.*)/$1$2/;
+ print OUT;
+ print OUT "\n" unless /\n$/; # If no description
+ }
+ close IN;
+ close OUT;
+ }
+ else {
+die "You need to make a $NEWMANI file, with names and descriptions.\n";
+ }
+ }
+}
+
+package copyright;
+
+# Read in copyright file
+sub init {
+ local($file) = @_; # Copyright file
+ undef @copyright;
+ open(COPYRIGHT, $file) || die "Can't open $file: $!\n";
+ chop(@copyright = <COPYRIGHT>);
+ close COPYRIGHT;
+}
+
+# Reset the automaton for a new file.
+sub reset {
+ $copyright_seen = @copyright ? 0 : 1;
+ $marker_seen = 0;
+}
+
+# Filter file, line by line, and expand the copyright string. The @COPYRIGHT@
+# symbol may be preceded by some random comment. A leader can be defined and
+# will be pre-pended to all the input lines.
+sub filter {
+ local($line, $leader) = @_; # Leader is optional
+ return $leader . $line if $copyright_seen || $marker_seen;
+ $marker_seen = 1 if $line =~ /\$Log[:\$]/;
+ $copyright_seen = 1 if $line =~ /\@COPYRIGHT\@/;
+ return $leader . $line unless $copyright_seen;
+ local($comment, $trailer) = $line =~ /^(.*)\@COPYRIGHT\@\s*(.*)/;
+ $comment = $leader . $comment;
+ $comment . join("\n$comment", @copyright) . "\n";
+}
+
+# Filter output of $cmd redirected into $file by expanding copyright, if any.
+sub expand {
+ local($cmd, $file) = @_;
+ if (@copyright) {
+ open(CMD,"$cmd|") || die "Can't start '$cmd': $!\n";
+ open(OUT, ">$file") || die "Can't create $file: $!\n";
+ &reset;
+ local($_);
+ while (<CMD>) {
+ print OUT &filter($_);
+ }
+ close OUT;
+ close CMD;
+ } else {
+ system "$cmd > $file";
+ die "Command '$cmd' failed!" if $?;
+ }
+}
+
+package main;
+
+# Make directories for files
+# E.g, for /usr/lib/perl/foo, it will check for all the
+# directories /usr, /usr/lib, /usr/lib/perl and make
+# them if they do not exist.
+sub makedir {
+ local($_) = shift;
+ local($dir) = $_;
+ if (!-d && $_ ne '') {
+ # Make dirname first
+ do makedir($_) if s|(.*)/.*|\1|;
+ mkdir($dir, 0700) if ! -d $dir;
+ }
+}
+
+# Perform ~name expansion ala ksh...
+# (banish csh from your vocabulary ;-)
+sub tilda_expand {
+ local($path) = @_;
+ return $path unless $path =~ /^~/;
+ $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e; # ~name
+ $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e; # ~
+ $path;
+}
+
+# Set up profile components into %Profile, add any profile-supplied options
+# into @ARGV and return the command invocation name.
+sub profile {
+ local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
+ local($me) = $0; # Command name
+ $me =~ s|.*/(.*)|$1|; # Keep only base name
+ return $me unless -s $profile;
+ local(*PROFILE); # Local file descriptor
+ local($options) = ''; # Options we get back from profile
+ unless (open(PROFILE, $profile)) {
+ warn "$me: cannot open $profile: $!\n";
+ return;
+ }
+ local($_);
+ local($component);
+ while (<PROFILE>) {
+ next if /^\s*#/; # Skip comments
+ next unless /^$me/o;
+ if (s/^$me://o) { # progname: options
+ chop;
+ $options .= $_; # Merge options if more than one line
+ }
+ elsif (s/^$me-([^:]+)://o) { # progname-component: value
+ $component = $1;
+ chop;
+ s/^\s+//; # Trim leading and trailing spaces
+ s/\s+$//;
+ $Profile{$component} = $_;
+ }
+ }
+ close PROFILE;
+ return unless $options;
+ require 'shellwords.pl';
+ local(@opts);
+ eval '@opts = &shellwords($options)'; # Protect against mismatched quotes
+ unshift(@ARGV, @opts);
+ return $me; # Return our invocation name
+}
+
--- /dev/null
+#!/bin/sh
+# $Id: manicheck.SH 1 2006-08-24 12:32:52Z rmanfredi $
+#
+# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
+#
+# You may redistribute only under the terms of the Artistic Licence,
+# as specified in the README file that comes with the distribution.
+# You may reuse parts of this distribution only within the terms of
+# that same Artistic Licence; a copy of which may be found at the root
+# of the source tree for dist 4.0.
+#
+# Original Author: Harlan Stenn <harlan@mumps.pfcs.com>
+#
+# $Log: manicheck.SH,v $
+# Revision 3.0.1.1 1993/08/19 06:41:51 ram
+# patch1: leading config.sh searching was not aborting properly
+#
+# Revision 3.0 1993/08/18 12:04:02 ram
+# Baseline for dist 3.0 netwide release.
+#
+
+find . ! -type d -print | sed -e '
+s|^./||
+/RCS\//d
+/UU\//d
+/core$/d
+/\.bak$/d
+/\.orig$/d
+' | sort > check.present
+
+manifest=''
+if test -r MANIFEST.new; then
+ manifest='MANIFEST.new'
+else
+ if test -r MANIFEST; then
+ manifest='MANIFEST'
+ else
+ echo "No MANIFEST.new or MANIFEST file--don't know what to look for."
+ fi
+fi
+
+awk '{print $1}' $manifest | sort > check.expected
+
+comm -23 check.expected check.present > check.want
+comm -13 check.expected check.present > check.extra
+
+rm -f check.expected check.present
+
+if test -s check.want; then
+ echo "Some files listed in $manifest are missing; see check.want."
+else
+ rm check.want
+fi
+
+if test -s check.extra; then
+ echo "Some files not listed in $manifest are present; see check.extra."
+else
+ rm check.extra
+fi
--- /dev/null
+#!/usr/bin/perl
+ eval "exec perl -i~ -S $0 $*"
+ if $running_under_some_shell;
+
+# $Id: manifake.SH 1 2006-08-24 12:32:52Z rmanfredi $
+#
+# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
+#
+# You may redistribute only under the terms of the Artistic Licence,
+# as specified in the README file that comes with the distribution.
+# You may reuse parts of this distribution only within the terms of
+# that same Artistic Licence; a copy of which may be found at the root
+# of the source tree for dist 4.0.
+#
+# $Log: manifake.SH,v $
+# Revision 3.0.1.1 1993/08/19 06:42:18 ram
+# patch1: leading config.sh searching was not aborting properly
+#
+# Revision 3.0 1993/08/18 12:04:32 ram
+# Baseline for dist 3.0 netwide release.
+#
+
+$NEWMANI = 'MANIFEST.new';
+$MANI = 'MANIFEST';
+
+&manifake;
+
+sub manifake {
+ # make MANIFEST and MANIFEST.new say the same thing
+ if (! -f $NEWMANI) {
+ if (-f $MANI) {
+ open(IN,$MANI) || die "Can't open $MANI";
+ open(OUT,">$NEWMANI") || die "Can't create $NEWMANI";
+ while (<IN>) {
+ if (/---/) {
+ # Everything until now was a header...
+ close OUT;
+ open(OUT,">$NEWMANI") ||
+ die "Can't recreate $NEWMANI";
+ next;
+ }
+ s/^\s*(\S+\s+)[0-9]*\s*(.*)/$1$2/;
+ print OUT;
+ print OUT "\n" unless /\n$/; # If no description
+ }
+ close IN;
+ close OUT;
+ }
+ else {
+die "You need to make a $NEWMANI file, with names and descriptions.\n";
+ }
+ }
+}
+
--- /dev/null
+#!/usr/bin/perl
+ eval 'exec perl -S $0 "$@"'
+ if $running_under_some_shell;
+
+# $Id: manilist.SH 20 2008-01-04 23:14:00Z rmanfredi $
+#
+# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
+#
+# You may redistribute only under the terms of the Artistic Licence,
+# as specified in the README file that comes with the distribution.
+# You may reuse parts of this distribution only within the terms of
+# that same Artistic Licence; a copy of which may be found at the root
+# of the source tree for dist 4.0.
+#
+# $Log: manilist.SH,v $
+# Revision 3.0.1.3 1994/10/29 15:42:42 ram
+# patch36: fixed open precedence problem for perl5
+#
+# Revision 3.0.1.2 1994/01/24 13:52:33 ram
+# patch16: added ~/.dist_profile awareness
+#
+# Revision 3.0.1.1 1993/08/19 06:41:52 ram
+# patch1: leading config.sh searching was not aborting properly
+#
+# Revision 3.0 1993/08/18 12:04:03 ram
+# Baseline for dist 3.0 netwide release.
+#
+
+$version = '3.5';
+$pl = '0';
+
+# This script scans the MANIFEST.new file and builds some reports.
+
+# The output can be somewhat changed to produce other kind of reports.
+# The format is specified with a leading set of activation character, followed
+# by a ':', and then a set of formatting macros. The leading characters tell
+# when a report line shall be issued:
+# a: all files (shortcut for 'ix')
+# A: all files but the excluded ones
+# f: report for files only
+# d: report for directories only
+# m: report for files/directories found in the MANIFEST.new
+# n: report for files/directories not found in the MANIFEST.new
+# i: included files are listed
+# x: excluded files are listed
+# Then a set of macros introduced by %:
+# %c: the leading one character code defined as follows:
+# . if the file is up to date (i.e. not newer than patchlevel.h)
+# - if the file is present in the manifest but is missing
+# > if the file has changed since last patch.
+# + if the file is not present in the manifest but exists
+# o if the file is not listed but exists and is older than patchlevel.h
+# x if the file in manifest and exists but was excluded
+# ? if the file in manifest but was excluded and does not exist
+# %n: the name of the file (its path from the top directory)
+# %t: time stamp of last modification
+# %d: description from MANIFEST.new file, if any
+# %s: size of the file, in bytes
+
+$format = 'A:%c %n';
+
+# By default, only the source files whith the following extensions are reported
+# (but a -a option will report ALL the files, and a -i option can specify some
+# other extensions as well).
+# .sh .SH .c .h .l .y .man
+
+@include = ('.sh', '.SH', '.c', '.h', '.l', '.y', '.man');
+
+# By default, the following extensions are excluded from the list. More
+# exclusions can be added with the -x option:
+# ^core .o .bak .rej .new .old .orig ,v
+
+@exclude = ('^core', '.o', '.bak', '.rej', '.new', '.old', '.orig', ',v');
+
+# The column separator character (or string) is used to separate each formatted
+# column on the output. Formatting is requested by adding a '|' character in
+# the format string. A new separator can be specified via the -C option.
+# The maximum column size is fixed by the -L.
+
+$col_separator = ' ';
+$col_size = '';
+
+&profile; # Read ~/.dist_profile
+require 'getopts.pl';
+require 'stat.pl';
+&usage unless &Getopts('abcdhntVi:f:p:s:w:x:C:L:I:X:');
+
+&usage if $opt_h;
+if ($opt_V) {
+ print "manilist $version PL$pl\n";
+ exit 0;
+}
+
+# Go to the top of the package, and update any file name given as argument
+# by prepending the needed path. The process then performs a chdir to the
+# top.
+unless ($opt_b) {
+ chop($pwd = `pwd`) unless -f '.package';
+ until (-f '.package') {
+ die "No .package file! Run packinit.\n" unless $pwd;
+ chdir '..' || die "Can't cd ..\n";
+ $pwd =~ s|(.*)/(.*)|$1|;
+ $prefix = $2 . '/' . $prefix;
+ }
+ if ($prefix) {
+ for (@ARGV) {
+ s/^\.$/$prefix/ && next;
+ s/^/$prefix/ unless m|^[-/]|;
+ }
+ }
+}
+
+# We now are at the top level
+
+# Build up the file hierarchy filter in @filter
+foreach $entry (@ARGV) {
+ $entry =~ s|/$||; # Remove final / in directory names
+ if (-d $entry) {
+ push(@filter, "d:$entry");
+ } elsif (-f $entry) {
+ push(@filter, "f:$entry");
+ } else {
+ die "$entry: No such file or directory.\n";
+ }
+}
+
+$prefix = '.' unless $prefix;
+($top = $prefix) =~ s|/$||;
+$top = '.' if $opt_t; # Start from top, not from original dir
+@ARGV = ($top) unless @ARGV;
+
+if ($opt_n) { # "manifest" files are found by scanning the directory
+ open(MANIFEST, "find @ARGV -print|") || die "Can't run find: $!\n";
+ while (<MANIFEST>) {
+ chop;
+ s|^./||;
+ push(@manifest, $_);
+ }
+ close MANIFEST;
+} else {
+ $MANIFEST = $opt_f;
+ $MANIFEST = 'MANIFEST.new' unless $opt_f;
+ open(MANIFEST, $MANIFEST) || die "Can't open $MANIFEST: $!\n";
+ while (<MANIFEST>) {
+ chop;
+ s|^./||;
+ s|^(\S+)||;
+ local($name) = $1;
+ push(@manifest, $name);
+ m|^\s+(\d+)*\s*(.*)| && ($comment{$name} = $2);
+ }
+ close MANIFEST;
+}
+
+# If we have to compare the files in the MANIFEST with the actual files on
+# the file system, then grab them...
+if ($opt_c && !$opt_n) {
+ open(FILES, "find @ARGV -print|") || die "Can't run find: $!\n";
+ while (<FILES>) {
+ chop;
+ s|^./||;
+ push(@files, $_);
+ }
+ close FILES;
+}
+
+# If there is a patchlevel.h file, get its time stamp.
+$pl_mtime = 0;
+$pl_mtime = (stat('patchlevel.h'))[$ST_MTIME] if -f 'patchlevel.h';
+
+# Dealing with command-line options
+$format = $opt_p if $opt_p;
+$col_separator = $opt_C if $opt_C;
+$col_size = $opt_L if $opt_L;
+unless ($opt_p) { # -p may be used as a shortcut for -w and -s
+ local($which) = ($format =~ /^(\w+):/);
+ local($string) = ($format =~ /^\w+:(.*)/);
+ $which = $opt_w if $opt_w;
+ $string = $opt_s if $opt_s;
+ $format = "$which:$string";
+}
+@include = split(' ', $opt_I) if $opt_I; # First reset included with -I
+@exclude = split(' ', $opt_X) if $opt_X; # and excluded with -X
+push(@include, split(' ', $opt_i)) if $opt_i; # before applying additions
+push(@exclude, split(' ', $opt_x)) if $opt_x;
+&mode_opt; # Compute $mode_xxx variables
+&init_functions; # Compile &included and &excluded
+
+# Option -d requests dumping of inclusion and exclusion lists on stderr
+if ($opt_d) {
+ print STDERR "Included: ", join(' ', @include), "\n";
+ print STDERR "Excluded: ", join(' ', @exclude), "\n";
+}
+
+@manifest = sort @manifest;
+@files = sort @files if defined(@files);
+
+# Build up the %manifest array so that we quickly know whether a file is in the
+# manifest or not.
+foreach (@manifest) {
+ ++$manifest{$_};
+}
+
+# Now loop other the files held in @manifest and perform your job...
+foreach $mani (@manifest) {
+ if ($opt_c && !$opt_n) { # Check MANIFEST with actual files on disk
+ for (;;) {
+ $disk = $files[0]; # Next file coming up
+ last unless $disk;
+ last if $disk gt $mani; # Past the current point
+ shift(@files); # Remove the file from list
+ last if $disk eq $mani; # Reached the manifest point
+ # This means the file is before the current MANIFEST point
+ &report($disk); # File exists and not in MANIFEST
+ }
+ }
+ &report($mani);
+}
+
+&flush_report; # Flush the @Report array if formatting is needed
+
+# Print usage and exit with a non-zero status
+sub usage {
+ print STDERR <<EOH;
+Usage: manilist [-abcdhnptV] [-i ext] [-f manifest] [-p format] [-s string]
+ [-w which] [-x ext] [-C separator] [-I included] [-L colsize]
+ [-X excluded] [files]
+ -a : report for all the files, regardless of (dis)allowed extensions.
+ -b : take current directory as base top (do not look for .package).
+ -c : check files against those in manifest and report differences.
+ -d : dump include and exclude lists on stderr.
+ -f : specify an alternate MANIFEST.new file.
+ -h : print this help message.
+ -i : specify a new extension to be included in the list of scanned files.
+ -n : do not use any MANIFEST file, rather scan directories for files.
+ -p : set new printing format (default is '$format'), shortcut for -s and -w.
+ -s : set string to be printed (with escapes) for each file on report.
+ -t : start from top directory, regardless of current dir.
+ -w : give leading letter(s) for printing format (file selection on report).
+ -x : give a new extension to be excluded from the list of scanned files.
+ -C : specify column separator (replaces '|' in format string).
+ -I : override default include list (space separated).
+ -L : specify maximum column size before truncation (',' separated).
+ -V : print version number.
+ -X : override default exclude list (space separated).
+EOH
+ exit 1;
+}
+
+# Set up $mode_xxx variables, where xxx is one of the options which may be set
+# in the printing mode. For instance, $mode_i is true if and only if 'i' is
+# mentionnned in the printing mode.
+sub mode_opt {
+ local($fmt) = $format;
+ $fmt =~ s/^(\w+)://;
+ local($mode) = $1;
+ $mode .= 'ix' if $mode =~ /a/;
+ local($mode_eval) = '';
+ foreach (split(//, $mode)) {
+ $mode_eval .= "\$mode_$_ = 1;"
+ }
+ eval $mode_eval;
+ chop($@) && die "Can't set mode variables: $@.\n";
+}
+
+# Write a report about a file, either on stdout or into @Report if some
+# formatting post-processing is needed (aligned on '|' characters in the
+# report format string).
+sub report {
+ local($file) = @_;
+ return unless &report_wanted($file);
+
+ local($fmt) = $format;
+ local($postproc) = 0; # Do we need formatting post-processing ?
+ $fmt =~ s/^\w+://;
+ $fmt =~ s/\|/\02/g && ($postproc = 1); # Formatted colum separator
+
+ # If neither 'd' nor 'f' is specified, then all the files are candidate
+ # for report. Specifying 'df' is the same, but is less efficient.
+ if (($mode_d || $mode_f) && -e $file) { # File exists on disk
+ return if -f _ && !$mode_f;
+ return if -d _ && !$mode_d;
+ }
+
+ # Mode 'm' and 'n', if present, respectively ask for a report when a file
+ # is in the manifest and when a file is not in the manifest. Not specifying
+ # any of those modes is the same as specifying both of them.
+ local($in_mani) = defined $manifest{$file};
+ if ($mode_m || $mode_n) {
+ return if $in_mani && !$mode_m;
+ return if !$in_mani && !$mode_n;
+ }
+
+ # Mode 'i' and 'x' are used to control included and excluded files. By
+ # default all the files not excluded are reported. Specifying 'x' also asks
+ # for excluded files. The 'i' restricts the report to included files.
+ local($included) = $mode_i ? &included($file) : 1;
+ local($excluded) = &excluded($file);
+ if (!$included || $excluded) {
+ return if !$mode_x && $excluded;
+ return if ($mode_i && !$included) && !$excluded;
+ }
+
+ local($c_macro);
+ local($mtime) = (stat($file))[$ST_MTIME];
+ if ($in_mani) { # File in MANIFEST
+ if (-e $file) { # And file exists
+ $c_macro = '.' if $mtime <= $pl_mtime;
+ $c_macro = '>' if $mtime > $pl_mtime;
+ $c_macro = 'x' if &excluded($file);
+ } else {
+ $c_macro = '-';
+ $c_macro = '?' if &excluded($file);
+ }
+ } else { # File not in MANIFEST
+ if (-e $file) { # And file exists
+ $c_macro = $mtime < $pl_mtime ? 'o' : '+';
+ } else {
+ return if -l $file;
+ warn "$file seems to have been removed...\n";
+ }
+ }
+
+ # Perform the macro substitution
+ $fmt =~ s/%%/\0/g; # Escape %%
+ $fmt =~ s/%/\01/g; # Transform %, in case substitution add some
+ $fmt =~ s/\01c/$c_macro/g; # %c is the code
+ $fmt =~ s/\01n/$file/g; # %n is the file name
+ $fmt =~ s/\01t/&fstamp/ge; # %t is the time stamp
+ $fmt =~ s/\01s/&fsize/ge; # %s is the file size, in bytes
+ $fmt =~ s/\01d/&mdesc/ge; # %d is the manifest description
+ $fmt =~ s/\01/%/g; # All other %'s are left undisturbed
+
+ print "$fmt\n" unless $postproc;
+ push(@Report, $fmt) if $postproc;
+}
+
+# Format and flush report on stdout. Columns are aligned on what was originally
+# a '|' character in the format string, translated into a ^B by the reporting
+# routine.
+sub flush_report {
+ return unless @Report; # Early return if nothing to be done
+ local(@length); # Stores maximum length for each field
+ local(@max); # Maximum allowed column sizes
+ local($i);
+ local($report);
+ local($len);
+ local(@fields);
+ @max = split(',', $col_size);
+ foreach $report (@Report) { # First pass: compute fields lengths
+ $i = 0;
+ foreach (split(/\02/, $report)) {
+ $len = length($_);
+ $length[$i] = $length[$i] < $len ? $len : $length[$i];
+ $i++;
+ }
+ }
+ for ($i = 0; $i < @length; $i++) { # Adapt to maximum specified length
+ $length[$i] = $max[$i] if $max[$i] > 0 && $length[$i] > $max[$i];
+ }
+ foreach $report (@Report) { # Second pass: formats each line
+ @fields = split(/\02/, $report);
+ $i = 0;
+ foreach (@fields) {
+ $len = length($_);
+ if ($max[$i] > 0 && $len > $max[$i]) {
+ $_ = substr($_, 0, $max[$i]); # Truncate field
+ } else {
+ $_ .= ' ' x ($length[$i] - $len); # Pad with blanks
+ }
+ $i++;
+ }
+ print join($col_separator, @fields), "\n";
+ }
+}
+
+# The following macro subsitution functions are called with $file set
+
+# Return the modification time on file
+sub fstamp {
+ (stat($file))[$ST_MTIME];
+}
+
+# Return the file size, in bytes
+sub fsize {
+ (stat($file))[$ST_SIZE];
+}
+
+# Return the description from the MANIFEST file, if any
+sub mdesc {
+ return '' unless defined $comment{$file};
+ $comment{$file};
+}
+
+# Do we have to report informations on the specified file?
+sub report_wanted {
+ return 1 unless @filter;
+ local($file) = @_;
+ local($filter);
+ foreach (@filter) {
+ $filter = $_; # Work on a copy
+ if ($filter =~ s/^d://) {
+ return 1 if $file =~ m|^$filter(/[^/]*)*|;
+ } else {
+ $filter =~ s/^f://;
+ return 1 if $filter eq $file;
+ }
+ }
+ return 0;
+}
+
+# Build up the 'included' and 'excluded' functions which return true if a file
+# is in the include or exclude set.
+sub init_functions {
+ &build_function('included', *include, 1);
+ &build_function('excluded', *exclude, 0);
+}
+
+# Build a function which returns true if a given name is found in the array
+# list of regular expression. Each regular expression is applied on the file
+# name, anchored at the end. False is returned only if none of the expressions
+# match. The purpose of building such a function dynamically is to avoid the
+# costly pattern recompilation every time.
+sub build_function {
+ local($name) = shift(@_); # The name of the function to be built
+ local(*array) = shift(@_); # The extension array we have to check with
+ local($dflt) = shift(@_); # Default value when -a is used
+ local($fn) = &q(<<EOF); # Function being built.
+:sub $name {
+: return $dflt if \$opt_a; # All files are included, none excluded.
+: local(\$_) = \@_;
+: study;
+EOF
+ foreach (@array) {
+ $ext = $_; # Work on a copy
+ # Convert shell-style globbing into perl's RE meta-characters
+ $ext =~ s/\./\\./g; # Escape .
+ $ext =~ s/\?/./g; # ? turns into .
+ $ext =~ s/\*/.*/g; # And * turns into .*
+ $fn .= &q(<<EOL);
+: return 1 if /$ext\$/;
+EOL
+ }
+ $fn .= &q(<<EOF);
+: 0; # None of the extensions can be applied to the file
+:}
+EOF
+ eval $fn;
+ chop($@) && die "Can't compile '$name':\n$fn\n$@.\n";
+}
+
+# Remove ':' quotations in front of the lines
+sub q {
+ local($_) = @_;
+ s/^://gm;
+ $_;
+}
+
+# Perform ~name expansion ala ksh...
+# (banish csh from your vocabulary ;-)
+sub tilda_expand {
+ local($path) = @_;
+ return $path unless $path =~ /^~/;
+ $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e; # ~name
+ $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e; # ~
+ $path;
+}
+
+# Set up profile components into %Profile, add any profile-supplied options
+# into @ARGV and return the command invocation name.
+sub profile {
+ local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
+ local($me) = $0; # Command name
+ $me =~ s|.*/(.*)|$1|; # Keep only base name
+ return $me unless -s $profile;
+ local(*PROFILE); # Local file descriptor
+ local($options) = ''; # Options we get back from profile
+ unless (open(PROFILE, $profile)) {
+ warn "$me: cannot open $profile: $!\n";
+ return;
+ }
+ local($_);
+ local($component);
+ while (<PROFILE>) {
+ next if /^\s*#/; # Skip comments
+ next unless /^$me/o;
+ if (s/^$me://o) { # progname: options
+ chop;
+ $options .= $_; # Merge options if more than one line
+ }
+ elsif (s/^$me-([^:]+)://o) { # progname-component: value
+ $component = $1;
+ chop;
+ s/^\s+//; # Trim leading and trailing spaces
+ s/\s+$//;
+ $Profile{$component} = $_;
+ }
+ }
+ close PROFILE;
+ return unless $options;
+ require 'shellwords.pl';
+ local(@opts);
+ eval '@opts = &shellwords($options)'; # Protect against mismatched quotes
+ unshift(@ARGV, @opts);
+ return $me; # Return our invocation name
+}
+
--- /dev/null
+#!/pro/bin/perl
+
+use sort "stable";
+BEGIN { $ENV{LC_ALL} = "C"; }
+chdir "/pro/3gl/CPAN/perl";
+{ my @Cc = qw( Configure config_h.SH );
+ system "chown merijn @Cc";
+ chmod 0775, @Cc;
+ #-d "merijn" or mkdir "merijn";
+ #system "cp -f Configure config_h.SH Porting/Glossary Porting/config.sh merijn/";
+ system "ls", "-l", @Cc;
+ }
+
+# $Id: mconfig.SH 22 2008-05-28 08:01:59Z rmanfredi $
+#
+# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
+#
+# You may redistribute only under the terms of the Artistic Licence,
+# as specified in the README file that comes with the distribution.
+# You may reuse parts of this distribution only within the terms of
+# that same Artistic Licence; a copy of which may be found at the root
+# of the source tree for dist 4.0.
+#
+# Original Author: Larry Wall <lwall@netlabs.com>
+# Key Contributor: Harlan Stenn <harlan@mumps.pfcs.com>
+#
+# $Log: mconfig.SH,v $
+# Revision 3.0.1.5 1995/07/25 14:19:05 ram
+# patch56: new -G option
+#
+# Revision 3.0.1.4 1994/06/20 07:11:04 ram
+# patch30: new -L option to override public library path for testing
+#
+# Revision 3.0.1.3 1994/01/24 14:20:53 ram
+# patch16: added ~/.dist_profile awareness
+#
+# Revision 3.0.1.2 1993/10/16 13:53:10 ram
+# patch12: new -M option for magic symbols and confmagic.h production
+#
+# Revision 3.0.1.1 1993/08/19 06:42:26 ram
+# patch1: leading config.sh searching was not aborting properly
+#
+# Revision 3.0 1993/08/18 12:10:17 ram
+# Baseline for dist 3.0 netwide release.
+#
+
+# Perload ON
+
+$MC = '/pro/3gl/CPAN/lib/dist';
+$version = '3.5';
+$patchlevel = '0';
+$grep = '/usr/bin/grep';
+chop($date = `date`);
+&profile; # Read ~/.dist_profile
+require 'getopts.pl';
+&usage unless &Getopts("dhkmoOstvwGMVL:");
+
+$MC = $opt_L if $opt_L; # May override public library path
+$MC = &tilda_expand($MC); # ~name expansion
+chop($WD = `pwd`); # Working directory
+chdir $MC || die "Can't chdir to $MC: $!\n";
+chop($MC = `pwd`); # Real metaconfig lib path (no symbolic links)
+chdir $WD || die "Can't chdir back to $WD: $!\n";
+
+++$opt_k if $opt_d;
+++$opt_M if -f 'confmagic.h'; # Force -M if confmagic.h already there
+
+if ($opt_V) {
+ print STDERR "metaconfig $version PL$patchlevel\n";
+ exit 0;
+} elsif ($opt_h) {
+ &usage;
+}
+
+unlink 'Wanted' unless $opt_w; # Wanted rebuilt if no -w
+unlink 'Obsolete' unless $opt_w; # Obsolete file rebuilt if no -w
+&readpackage; # Merely get the package's name
+&init; # Various initializations
+`mkdir .MT 2>&1` unless -d '.MT'; # For private temporary files
+
+&locate_units; # Fill in @ARGV with a unit list
+&extract_dependencies; # Extract dependencies from units
+&extract_filenames; # Extract files to be scanned for
+&build_wanted; # Build a list of wanted symbols in file Wanted
+&build_makefile; # To do the transitive closure of dependencies
+&solve_dependencies; # Now run the makefile to close dependency graph
+&create_configure; # Create the Configure script and related files
+&cosmetic_update; # Update the manifests
+
+if ($opt_k) {
+ print "Leaving subdirectory .MT unremoved so you can peruse it.\n"
+ unless $opt_s;
+} else {
+ `rm -rf .MT 2>&1`;
+}
+system "/pro/bin/perl", "Porting/config_h.pl";
+print "Done.\n" unless $opt_s;
+
+# General initializations
+sub init {
+ &init_except; # Token which have upper-cased letters
+ &init_keep; # The keep status for built-in interpreter
+ &init_priority; # Priorities for diadic operators
+ &init_constants; # Define global constants
+ &init_depend; # The %Depend array records control line handling
+}
+
+sub init_constants {
+ $NEWMANI = 'MANIFEST.new'; # List of files to be scanned
+ $MANI = 'MANIFEST'; # For manifake
+
+ # The distinction between MANIFEST.new and MANIFEST can make sense
+ # when the "pat" tools are used, but if only metaconfig is used, then
+ # we can very well leave without a MANIFEST.new. --RAM, 2006-08-25
+ $NEWMANI = $MANI if -f $MANI && ! -f $NEWMANI;
+}
+
+# Record the exceptions -- almost all symbols but these are lower case
+# We also use three symbols from Unix.U for default file suffixes.
+sub init_except {
+ $Except{'Author'}++;
+ $Except{'Date'}++;
+ $Except{'Header'}++;
+ $Except{'Id'}++;
+ $Except{'Locker'}++;
+ $Except{'Log'}++;
+ $Except{'RCSfile'}++;
+ $Except{'Revision'}++;
+ $Except{'Source'}++;
+ $Except{'State'}++;
+ $Except{'_a'}++;
+ $Except{'_o'}++;
+ $Except{'_exe'}++;
+}
+
+# Print out metaconfig's usage and exits
+sub usage {
+ print STDERR <<'EOH';
+Usage: metaconfig [-dhkmostvwGMV] [-L dir]
+ -d : debug mode.
+ -h : print this help message and exits.
+ -k : keep temporary directory.
+ -m : assume lots of memory and swap space.
+ -o : maps obsolete symbols on new ones.
+ -s : silent mode.
+ -t : trace symbols as they are found.
+ -v : verbose mode.
+ -w : trust Wanted file as being up-to-date.
+ -G : also provide a GNU configure-like front end.
+ -L : specify main units repository.
+ -M : activate production of confmagic.h.
+ -V : print version number and exits.
+EOH
+ exit 1;
+}
+
+package locate;
+
+# Locate the units and push their path in @ARGV (sorted alphabetically)
+sub main'locate_units {
+ print "Locating units...\n" unless $main'opt_s;
+ local(*WD) = *main'WD; # Current working directory
+ local(*MC) = *main'MC; # Public metaconfig library
+ undef %myUlist; # Records private units paths
+ undef %myUseen; # Records private/public conflicts
+ &private_units; # Locate private units in @myUlist
+ &public_units; # Locate public units in @ARGV
+ @ARGV = sort @ARGV; # Sort it alphabetically
+ push(@ARGV, sort @myUlist); # Append user's units sorted
+ &dump_list if $main'opt_v; # Dump the list of units
+}
+
+# Dump the list of units on stdout
+sub dump_list {
+ print "\t";
+ $, = "\n\t";
+ print @ARGV;
+ $, = '';
+ print "\n";
+}
+
+# Scan private units
+sub private_units {
+ return unless -d 'U'; # Nothing to be done if no 'U' entry
+ local(*ARGV) = *myUlist; # Really fill in @myUlist
+ local($MC) = $WD; # We are really in the working directory
+ &units_path("U"); # Locate units in the U directory
+ local($unit_name); # Unit's name (without .U)
+ local(@kept); # Array of kept units
+ # Loop over the units and remove duplicates (the first one seen is the one
+ # we keep). Also set the %myUseen H table to record private units seen.
+ foreach (@ARGV) {
+ ($unit_name) = m|^.*/(.*)\.U$|; # Get unit's name from path
+ next if $myUseen{$unit_name}; # Already recorded
+ $myUseen{$unit_name} = 1; # Record pirvate unit
+ push(@kept, $_); # Keep this unit
+ }
+ @ARGV = @kept;
+}
+
+# Scan public units
+sub public_units {
+ chdir($MC) || die "Can't find directory $MC.\n";
+ &units_path("U"); # Locate units in public U directory
+ chdir($WD) || die "Can't go back to directory $WD.\n";
+ local($path); # Relative path from $WD
+ local($unit_name); # Unit's name (without .U)
+ local(*Unit) = *main'Unit; # Unit is a global from main package
+ local(@kept); # Units kept
+ local(%warned); # Units which have already issued a message
+ # Loop over all the units and keep only the ones that were not found in
+ # the user's U directory. As it is possible two or more units with the same
+ # name be found in
+ foreach (@ARGV) {
+ ($unit_name) = m|^.*/(.*)\.U$|; # Get unit's name from path
+ next if $warned{$unit_name}; # We have already seen this unit
+ $warned{$unit_name} = 1; # Remember we have warned the user
+ if ($myUseen{$unit_name}) { # User already has a private unit
+ $path = $Unit{$unit_name}; # Extract user's unit path
+ next if $path eq $_; # Same path, we must be in mcon/
+ $path =~ s|^$WD/||o; # Weed out leading working dir path
+ $::opt_O and next;
+ print " Your private $path overrides the public one.\n"
+ unless $main'opt_s;
+ } else {
+ push(@kept, $_); # We may keep this one
+ }
+ }
+ @ARGV = @kept;
+}
+
+# Recursively locate units in the directory. Each file ending with .U has to be
+# a unit. Others are stat()'ed, and if they are a directory, they are also
+# scanned through. The $MC and @ARGV variable are dynamically set by the caller.
+sub units_path {
+ local($dir) = @_; # Directory where units are to be found
+ local(@contents); # Contents of the directory
+ local($unit_name); # Unit's name, without final .U
+ local($path); # Full path of a unit
+ local(*Unit) = *main'Unit; # Unit is a global from main package
+ unless (opendir(DIR, $dir)) {
+ warn("Cannot open directory $dir.\n");
+ return;
+ }
+ print "Locating in $MC/$dir...\n" if $main'opt_v;
+ @contents = readdir DIR; # Slurp the whole thing
+ closedir DIR; # And close dir, ready for recursion
+ foreach (@contents) {
+ next if $_ eq '.' || $_ eq '..';
+ if (/\.U$/) { # A unit, definitely
+ ($unit_name) = /^(.*)\.U$/;
+ $path = "$MC/$dir/$_"; # Full path of unit
+ push(@ARGV, $path); # Record its path
+ if (defined $Unit{$unit_name}) { # Already seen this unit
+ if ($main'opt_v) {
+ ($path) = $Unit{$unit_name} =~ m|^(.*)/.*|;
+ print " We've already seen $unit_name.U in $path.\n";
+ }
+ } else {
+ $Unit{$unit_name} = $path; # Map name to path
+ }
+ next;
+ }
+ # We have found a file which does not look like a unit. If it is a
+ # directory, then scan it. Otherwise skip the file.
+ unless (-d "$dir/$_") {
+ print " Skipping file $_ in $dir.\n" if $main'opt_v;
+ next;
+ }
+ &units_path("$dir/$_");
+ print "Back to $MC/$dir...\n" if $main'opt_v;
+ }
+}
+
+package main;
+
+# Initialize the extraction process by setting some variables.
+# We return a string to be eval to do more customized initializations.
+sub init_extraction {
+ open(INIT, ">$WD/.MT/Init.U") ||
+ die "Can't create .MT/Init.U\n";
+ open(CONF_H, ">$WD/.MT/Config_h.U") ||
+ die "Can't create .MT/Config_h.U\n";
+ open(EXTERN, ">$WD/.MT/Extern.U") ||
+ die "Can't create .MT/Extern.U\n";
+ open(MAGIC_H, ">$WD/.MT/Magic_h.U") ||
+ die "Can't create .MT/Magic_h.U\n";
+
+ $c_symbol = ''; # Current symbol seen in ?C: lines
+ $s_symbol = ''; # Current symbol seen in ?S: lines
+ $m_symbol = ''; # Current symbol seen in ?M: lines
+ $heredoc = ''; # Last "here" document symbol seen
+ $heredoc_nosubst = 0; # True for <<'EOM' here docs
+ $condlist = ''; # List of conditional symbols
+ $defined = ''; # List of defined symbols in the unit
+ $body = ''; # No procedure to handle body
+ $ending = ''; # No procedure to clean-up
+}
+
+# End the extraction process
+sub end_extraction {
+ close EXTERN; # External dependencies (libraries, includes...)
+ close CONF_H; # C symbol definition template
+ close INIT; # Required initializations
+ close MAGIC; # Magic C symbol redefinition templates
+
+ print $dependencies if $opt_v; # Print extracted dependencies
+}
+
+# Process the ?MAKE: line
+sub p_make {
+ local($_) = @_;
+ local(@ary); # Locally defined symbols
+ local(@dep); # Dependencies
+ if (/^[\w+ ]*:/) { # Main dependency rule
+ s|^\s*||; # Remove leading spaces
+ chop;
+ s/:(.*)//;
+ @dep = split(' ', $1); # Dependencies
+ @ary = split(' '); # Locally defined symbols
+ foreach $sym (@ary) {
+ # Symbols starting with a '+' are meant for internal use only.
+ next if $sym =~ s/^\+//;
+ # Only sumbols starting with a lowercase letter are to
+ # appear in config.sh, excepted the ones listed in Except.
+ if ($sym =~ /^[_a-z]/ || $Except{$sym}) {
+ $shmaster{"\$$sym"} = undef;
+ push(@Master,"?$unit:$sym=''\n"); # Initializations
+ }
+ }
+ $condlist = ''; # List of conditional symbols
+ local($sym); # Symbol copy, avoid @dep alteration
+ foreach $dep (@dep) {
+ if ($dep =~ /^\+[A-Za-z]/) {
+ ($sym = $dep) =~ s|^\+||;
+ $condlist .= "$sym ";
+ push(@Cond, $sym) unless $condseen{$sym};
+ $condseen{$sym}++; # Conditionally wanted
+ }
+ }
+ # Append to already existing dependencies. The 'defined' variable
+ # is set for &write_out, used to implement ?L: and ?I: canvas. It is
+ # reset each time a new unit is parsed.
+ # NB: leading '+' for defined symbols (internal use only) have been
+ # removed at this point, but conditional dependencies still bear it.
+ $defined = join(' ', @ary); # Symbols defined by this unit
+ $dependencies .= $defined . ':' . join(' ', @dep) . "\n";
+ $dependencies .= " -cond $condlist\n" if $condlist;
+ } else {
+ $dependencies .= $_; # Building rules
+ }
+}
+
+# Process the ?O: line
+sub p_obsolete {
+ local($_) = @_;
+ $Obsolete{"$unit.U"} .= $_; # Message(s) to print if unit is used
+}
+
+# Process the ?S: lines
+sub p_shell {
+ local($_) = @_;
+ unless ($s_symbol) {
+ if (/^(\w+).*:/) {
+ $s_symbol = $1;
+ print " ?S: $s_symbol\n" if $opt_d;
+ } else {
+ warn "\"$file\", line $.: syntax error in ?S: construct.\n";
+ $s_symbol = $unit;
+ return;
+ }
+ # Deal with obsolete symbol list (enclosed between parenthesis)
+ &record_obsolete("\$$_") if /\(/;
+ }
+ m|^\.\s*$| && ($s_symbol = ''); # End of comment
+}
+
+# Process the ?C: lines
+sub p_c {
+ local($_) = @_;
+ unless ($c_symbol) {
+ if (s/^(\w+)\s*~\s*(\S+)\s*(.*):/$1 $3:/) {
+ # The ~ operator aliases the main C symbol to another symbol which
+ # is to be used instead for definition in config.h. That is to say,
+ # the line '?C:SYM ~ other:' would look for symbol 'other' instead,
+ # and the documentation for symbol SYM would only be included in
+ # config.h if 'other' were actually wanted.
+ $c_symbol = $2; # Alias for definition in config.h
+ print " ?C: $1 ~ $c_symbol\n" if $opt_d;
+ } elsif (/^(\w+).*:/) {
+ # Default behaviour. Include in config.h if symbol is needed.
+ $c_symbol = $1;
+ print " ?C: $c_symbol\n" if $opt_d;
+ } else {
+ warn "\"$file\", line $.: syntax error in ?C: construct.\n";
+ $c_symbol = $unit;
+ return;
+ }
+ # Deal with obsolete symbol list (enclosed between parenthesis) and
+ # make sure that list do not appear in config.h.SH by removing it.
+ &record_obsolete("$_") if /\(/;
+ s/\s*\(.*\)//; # Get rid of obsolete symbol list
+ }
+ s|^(\w+)\s*|?$c_symbol:/* $1| || # Start of comment
+ (s|^\.\s*$|?$c_symbol: */\n| && ($c_symbol = '', 1)) || # End of comment
+ s|^(.*)|?$c_symbol: *$1|; # Middle of comment
+ &p_config("$_"); # Add comments to config.h.SH
+}
+
+# Process the ?H: lines
+sub p_config {
+ local($_) = @_;
+ local($constraint); # Constraint to be used for inclusion
+ ++$old_version if s/^\?%1://; # Old version
+ if (s/^\?(\w+)://) { # Remove leading '?var:'
+ $constraint = $1; # Constraint is leading '?var'
+ } else {
+ $constraint = ''; # No constraint
+ }
+ if (/^#.*\$/) { # Look only for cpp lines
+ if (m|^#\$(\w+)\s+(\w+).*\$(\w+)|) {
+ # Case: #$d_var VAR "$var"
+ $constraint = $2 unless $constraint;
+ print " ?H: ($constraint) #\$$1 $2 \"\$$3\"\n" if $opt_d;
+ $cmaster{$2} = undef;
+ $cwanted{$2} = "$1\n$3";
+ } elsif (m|^#define\s+(\w+)\((.*)\)\s+\$(\w+)|) {
+ # Case: #define VAR(x) $var
+ $constraint = $1 unless $constraint;
+ print " ?H: ($constraint) #define $1($2) \$$3\n" if $opt_d;
+ $cmaster{$1} = undef;
+ $cwanted{$1} = $3;
+ } elsif (m|^#\$define\s+(\w+)|) {
+ # Case: #$define VAR
+ $constraint = $1 unless $constraint;
+ print " ?H: ($constraint) #define $1\n" if $opt_d;
+ $cmaster{$1} = undef;
+ $cwanted{$1} = "define\n$unit";
+ } elsif (m|^#\$(\w+)\s+(\w+)|) {
+ # Case: #$d_var VAR
+ $constraint = $2 unless $constraint;
+ print " ?H: ($constraint) #\$$1 $2\n" if $opt_d;
+ $cmaster{$2} = undef;
+ $cwanted{$2} = $1;
+ } elsif (m|^#define\s+(\w+).*\$(\w+)|) {
+ # Case: #define VAR "$var"
+ $constraint = $1 unless $constraint;
+ print " ?H: ($constraint) #define $1 \"\$$2\"\n" if $opt_d;
+ $cmaster{$1} = undef;
+ $cwanted{$1} = $2;
+ } else {
+ $constraint = $unit unless $constraint;
+ print " ?H: ($constraint) $_" if $opt_d;
+ }
+ } else {
+ print " ?H: ($constraint) $_" if $opt_d;
+ }
+ # If not a single ?H:. line, add the leading constraint
+ s/^\.// || s/^/?$constraint:/;
+ print CONF_H;
+}
+
+# Process the ?M: lines
+sub p_magic {
+ local($_) = @_;
+ unless ($m_symbol) {
+ if (/^(\w+):\s*([\w\s]*)\n$/) {
+ # A '?M:sym:' line implies a '?W:%<:sym' since we'll need to know
+ # about the wantedness of sym later on when building confmagic.h.
+ # Buf is sym is wanted, then the C symbol dependencies have to
+ # be triggered. That is done by introducing sym in the mwanted
+ # array, known by the Wanted file construction process...
+ $m_symbol = $1;
+ print " ?M: $m_symbol\n" if $opt_d;
+ $mwanted{$m_symbol} = $2; # Record C dependencies
+ &p_wanted("$unit:$m_symbol"); # Build fake ?W: line
+ } else {
+ warn "\"$file\", line $.: syntax error in ?M: construct.\n";
+ }
+ return;
+ }
+ (s/^\.\s*$/?$m_symbol:\n/ && ($m_symbol = '', 1)) || # End of block
+ s/^/?$m_symbol:/;
+ print MAGIC_H; # Definition goes to confmagic.h
+ print " ?M: $_" if $opt_d;
+}
+
+sub p_ignore {} # Ignore comment line
+sub p_lint {} # Ignore lint directives
+sub p_visible {} # No visible checking in metaconfig
+sub p_temp {} # No temporary variable control
+sub p_file {} # Ignore produced file directives (for now)
+
+# Process the ?W: lines
+sub p_wanted {
+ # Syntax is ?W:<shell symbols>:<C symbols>
+ local($active) = $_[0] =~ /^([^:]*):/; # Symbols to activate
+ local($look_symbols) = $_[0] =~ /:(.*)/; # When those are used
+ local(@syms) = split(/ /, $look_symbols); # Keep original spacing info
+ $active =~ s/\s+/\n/g; # One symbol per line
+
+ # Concatenate quoted strings, so saying something like 'two words' will
+ # be introduced as one single symbol "two words".
+ local(@symbols); # Concatenated symbols to look for
+ local($concat) = ''; # Concatenation buffer
+ foreach (@syms) {
+ if (s/^\'//) {
+ $concat = $_;
+ } elsif (s/\'$//) {
+ push(@symbols, $concat . ' ' . $_);
+ $concat = '';
+ } else {
+ push(@symbols, $_) unless $concat;
+ $concat .= ' ' . $_ if $concat;
+ }
+ }
+
+ # Now record symbols in master and wanted tables
+ foreach (@symbols) {
+ $cmaster{$_} = undef; # Asks for look-up in C files
+ $cwanted{$_} = "$active" if $active; # Shell symbols to activate
+ }
+}
+
+# Process the ?INIT: lines
+sub p_init {
+ local($_) = @_;
+ print INIT "?$unit:", $_; # Wanted only if unit is loaded
+}
+
+# Process the ?D: lines
+sub p_default {
+ local($_) = @_;
+ s/^([A-Za-z_]+)=(.*)/\@if !$1\n%$1:$1=$2\n\@define $1\n\@end/
+ && ($hasdefault{$1}++, print INIT $_);
+}
+
+# Process the ?P: lines
+sub p_public {
+ local($_) = @_;
+ local($csym); # C symbol(s) we're trying to look at
+ local($nosym); # List of symbol(s) which mustn't be wanted
+ local($cfile); # Name of file implementing csym (no .ext)
+ ($csym, $nosym, $cfile) = /([^()]+)\s*(\(.*\))\s*:\s*(\S+)/;
+ unless ($csym eq '' || $cfile eq '') {
+ # Add dependencies for each C symbol, of the form:
+ # -pick public <sym> <file> <notdef symbols list>
+ # and the file will be added to config.c whenever sym is wanted and
+ # none of the notdef symbols is wanted.
+ foreach $sym (split(' ', $csym)) {
+ $dependencies .= "\t-pick public $sym $cfile $nosym\n";
+ }
+ }
+}
+
+# Process the ?Y: lines
+# Valid layouts are for now are: top, bottom, default.
+#
+# NOTA BENE:
+# This routine relies on the $defined variable, a global variable set
+# during the ?MAKE: processing, which lists all the defined symbols in
+# the unit (the optional leading '+' for internal symbols has been removed
+# if present).
+#
+# The routine fills up a %Layout table, indexed by symbol, yielding the
+# layout imposed to this unit. That table will then be used later on when
+# we sort wanted symbols for the Makefile.
+sub p_layout {
+ local($_) = @_;
+ local($layout) = /^\s*(\w+)/;
+ $layout =~ tr/A-Z/a-z/; # Case is not significant for layouts
+ unless (defined $Lcmp{$layout}) {
+ warn "\"$file\", line $.: unknown layout directive '$layout'.\n";
+ return;
+ }
+ foreach $sym (split(' ', $defined)) {
+ $Layout{$sym} = $Lcmp{$layout};
+ }
+}
+
+# Process the ?L: lines
+# There should not be any '-l' in front of the library name
+sub p_library {
+ &write_out("L:$_");
+}
+
+# Process the ?I: lines
+sub p_include {
+ &write_out("I:$_");
+}
+
+# Write out line in file Extern.U. The information recorded there has the
+# following prototypical format:
+# ?symbol:L:inet bsd
+# If 'symbol' is wanted, then 'inet bsd' will be added to $libswanted.
+sub write_out {
+ local($_) = @_;
+ local($target) = $defined; # By default, applies to defined symbols
+ $target = $1 if s/^(.*)://; # List is qualified "?L:target:symbols"
+ local(@target) = split(' ', $target);
+ chop;
+ foreach $key (@target) {
+ print EXTERN "?$key:$_\n"; # EXTERN file defined in xref.pl
+ }
+}
+
+# The %Depend array records the functions we use to process the configuration
+# lines in the unit, with a special meaning. It is important that all the
+# known control symbols be listed below, so that metalint does not complain.
+# The %Lcmp array contains valid layouts and their comparaison value.
+sub init_depend {
+ %Depend = (
+ 'MAKE', 'p_make', # The ?MAKE: line records dependencies
+ 'INIT', 'p_init', # Initializations printed verbatim
+ 'LINT', 'p_lint', # Hints for metalint
+ 'RCS', 'p_ignore', # RCS comments are ignored
+ 'C', 'p_c', # C symbols
+ 'D', 'p_default', # Default value for conditional symbols
+ 'E', 'p_example', # Example of usage
+ 'F', 'p_file', # Produced files
+ 'H', 'p_config', # Process the config.h lines
+ 'I', 'p_include', # Added includes
+ 'L', 'p_library', # Added libraries
+ 'M', 'p_magic', # Process the confmagic.h lines
+ 'O', 'p_obsolete', # Unit obsolescence
+ 'P', 'p_public', # Location of PD implementation file
+ 'S', 'p_shell', # Shell variables
+ 'T', 'p_temp', # Shell temporaries used
+ 'V', 'p_visible', # Visible symbols like 'rp', 'dflt'
+ 'W', 'p_wanted', # Wanted value for interpreter
+ 'X', 'p_ignore', # User comment is ignored
+ 'Y', 'p_layout', # User-defined layout preference
+ );
+ %Lcmp = (
+ 'top', -1,
+ 'default', 0,
+ 'bottom', 1,
+ );
+}
+
+# Extract dependencies from units held in @ARGV
+sub extract_dependencies {
+ local($proc); # Procedure used to handle a ctrl line
+ local($file); # Current file scanned
+ local($dir, $unit); # Directory and unit's name
+ local($old_version) = 0; # True when old-version unit detected
+ local($mc) = "$MC/U"; # Public metaconfig directory
+ local($line); # Last processed line for metalint
+
+ printf "Extracting dependency lists from %d units...\n", $#ARGV+1
+ unless $opt_s;
+
+ chdir $WD; # Back to working directory
+ &init_extraction; # Initialize extraction files
+ $dependencies = ' ' x (50 * @ARGV); # Pre-extend
+ $dependencies = '';
+
+ # We do not want to use the <> construct here, because we need the
+ # name of the opened files (to get the unit's name) and we want to
+ # reset the line number for each files, and do some pre-processing.
+
+ file: while ($file = shift(@ARGV)) {
+ close FILE; # Reset line number
+ $old_version = 0; # True if unit is an old version
+ if (open(FILE, $file)) {
+ ($dir, $unit) = ('', $file)
+ unless ($dir, $unit) = ($file =~ m|(.*)/(.*)|);
+ $unit =~ s|\.U$||; # Remove extension
+ } else {
+ warn("Can't open $file.\n");
+ }
+ # If unit is in the standard public directory, keep only the unit name
+ $file = "$unit.U" if $dir eq $mc;
+ print "$dir/$unit.U:\n" if $opt_d;
+ line: while (<FILE>) {
+ $line = $_; # Save last processed unit line
+ if (s/^\?([\w\-]+)://) { # We may have found a control line
+ $proc = $Depend{$1}; # Look for a procedure to handle it
+ unless ($proc) { # Unknown control line
+ $proc = $1; # p_unknown expects symbol in '$proc'
+ eval '&p_unknown'; # Signal error (metalint only)
+ next line; # And go on next line
+ }
+ # Long lines may be escaped with a final backslash
+ $_ .= &complete_line(FILE) if s/\\\s*$//;
+ # Run macros substitutions
+ s/%</$unit/g; # %< expands into the unit's name
+ if (s/%\*/$unit/) {
+ # %* expanded into the entire set of defined symbols
+ # in the old version. Now it is only the unit's name.
+ ++$old_version;
+ }
+ eval { &$proc($_) }; # Process the line
+ } else {
+ next file unless $body; # No procedure to handle body
+ do {
+ $line = $_; # Save last processed unit line
+ eval { &$body($_) } ; # From now on, it's the unit body
+ } while (defined ($_ = <FILE>));
+ next file;
+ }
+ }
+ } continue {
+ warn(" Warning: $file is a pre-3.0 version.\n") if $old_version;
+ &$ending($line) if $ending; # Post-processing for metalint
+ }
+
+ &end_extraction; # End the extraction process
+}
+
+# The first line was escaped with a final \ character. Every following line
+# is to be appended to it (until we found a real \n not escaped). Note that
+# the leading spaces of the continuation line are removed, so any space should
+# be added before the former \ if needed.
+sub complete_line {
+ local($file) = @_; # File where lines come from
+ local($_);
+ local($read) = ''; # Concatenation of all the continuation lines found
+ while (<$file>) {
+ s/^\s+//; # Remove leading spaces
+ if (s/\\\s*$//) { # Still followed by a continuation line
+ $read .= $_;
+ } else { # We've reached the end of the continuation
+ return $read . $_;
+ }
+ }
+}
+
+# Extract filenames from manifest
+sub extract_filenames {
+ &build_filext; # Construct &is_cfile and &is_shfile
+ print "Extracting filenames (C and SH files) from $NEWMANI...\n"
+ unless $opt_s;
+ open(NEWMANI,$NEWMANI) || die "Can't open $NEWMANI.\n";
+ local($file);
+ while (<NEWMANI>) {
+ ($file) = split(' ');
+ next if $file eq 'config_h.SH'; # skip config_h.SH
+ next if $file eq 'Configure'; # also skip Configure
+ next if $file eq 'confmagic.h' && $opt_M;
+ push(@SHlist, $file) if &is_shfile($file);
+ push(@clist, $file) if &is_cfile($file);
+ }
+}
+
+# Construct two file identifiers based on the file suffix: one for C files,
+# and one for SH files (using the $cext and $shext variables) defined in
+# the .package file.
+# The &is_cfile and &is_shfile routine may then be called to known whether
+# a given file is a candidate for holding C or SH symbols.
+sub build_filext {
+ &build_extfun('is_cfile', $cext, '.c .h .y .l');
+ &build_extfun('is_shfile', $shext, '.SH');
+}
+
+# Build routine $name to identify extensions listed in $exts, ensuring
+# that $minimum is at least matched (both to be backward compatible with
+# older .package and because it is really the minimum requirred).
+sub build_extfun {
+ local($name, $exts, $minimum) = @_;
+ local(@single); # Single letter dot extensions (may be grouped)
+ local(@others); # Other extensions
+ local(%seen); # Avoid duplicate extensions
+ foreach $ext (split(' ', "$exts $minimum")) {
+ next if $seen{$ext}++;
+ if ($ext =~ s/^\.(\w)$/$1/) {
+ push(@single, $ext);
+ } else {
+ # Convert into perl's regexp
+ $ext =~ s/\./\\./g; # Escape .
+ $ext =~ s/\?/./g; # ? turns into .
+ $ext =~ s/\*/.*/g; # * turns into .*
+ push(@others, $ext);
+ }
+ }
+ local($fn) = &q(<<EOF); # Function being built
+:sub $name {
+: local(\$_) = \@_;
+EOF
+ local($single); # Single regexp: .c .h grouped into .[ch]
+ $single = '\.[' . join('', @single) . ']' if @single;
+ $fn .= &q(<<EOL) if @single;
+: return 1 if /$single\$/;
+EOL
+ foreach $ext (@others) {
+ $fn .= &q(<<EOL);
+: return 1 if /$ext\$/;
+EOL
+ }
+ $fn .= &q(<<EOF);
+: 0; # None of the extensions may be applied to file name
+:}
+EOF
+ print $fn if $opt_d;
+ eval $fn;
+ chop($@) && die "Can't compile '$name':\n$fn\n$@.\n";
+}
+
+# Remove ':' quotations in front of the lines
+sub q {
+ local($_) = @_;
+ s/^://gm;
+ $_;
+}
+
+# Build a wanted file from the files held in @SHlist and @clist arrays
+sub build_wanted {
+ # If wanted file is already there, parse it to map obsolete if -o option
+ # was used. Otherwise, build a new one.
+ if (-f 'Wanted') {
+ &map_obsolete if $opt_o; # Build Obsol*.U files
+ &dump_obsolete; # Dump obsolete symbols if any
+ return;
+ }
+ &parse_files;
+}
+
+sub parse_files {
+ print "Building a Wanted file...\n" unless $opt_s;
+ open(WANTED,"| sort | uniq >Wanted") || die "Can't create Wanted.\n";
+ unless (-f $NEWMANI) {
+ &manifake;
+ die "No $NEWMANI--can't build a Wanted file.\n" unless -f $NEWMANI;
+ }
+
+ local($search); # Where to-be-evaled script is held
+ local($_) = ' ' x 50000 if $opt_m; # Pre-extend pattern search space
+ local(%visited); # Records visited files
+ local(%lastfound); # Where last occurence of key was
+
+ # Now we are a little clever, and build a loop to eval so that we don't
+ # have to recompile our patterns on every file. We also use "study" since
+ # we are searching the same string for many different things. Hauls!
+
+ if (@clist) {
+ local($others) = $cext ? " $cext" : '';
+ print " Scanning .[chyl]$others files for symbols...\n"
+ unless $opt_s;
+ $search = ' ' x (40 * (@cmaster + @ocmaster)); # Pre-extend
+ $search = "while (<>) {study;\n"; # Init loop over ARGV
+ foreach $key (keys(%cmaster)) {
+ $search .= "&cmaster('$key') if /\\b$key\\b/;\n";
+ }
+ foreach $key (grep(!/^\$/, keys %Obsolete)) {
+ $search .= "&ofound('$key') if /\\b$key\\b/;\n";
+ }
+ $search .= "}\n"; # terminate loop
+ print $search if $opt_d;
+ @ARGV = @clist;
+ # Swallow each file as a whole, if memory is available
+ undef $/ if $opt_m;
+ eval $search;
+ eval '';
+ $/ = "\n";
+ while (($key,$value) = each(%cmaster)) {
+ print WANTED $cwanted{$key}, "\n", ">$key", "\n" if $value;
+ }
+ }
+
+ # If they don't use magic but use magically guarded symbols without
+ # their corresponding C symbol dependency, warn them, since they might
+ # not know about that portability issue.
+
+ if (@clist && !$opt_M) {
+ local($nused); # list of non-used symbols
+ local($warning) = 0; # true when one warning issued
+ foreach $cmag (keys %mwanted) { # loop over all used magic symbols
+ next unless $cmaster{$cmag};
+ $nused = '';
+ foreach $cdep (split(' ', $mwanted{$cmag})) {
+ $nused .= " $cdep" unless $cmaster{$cdep};
+ }
+ $nused =~ s/^ //;
+ $nused = "one of " . $nused if $nused =~ s/ /, /g;
+ if ($nused ne '') {
+ print " Warning: $cmag is used without $nused.\n";
+ $warning++;
+ }
+ }
+ if ($warning) {
+ local($those) = $warning == 1 ? 'that' : 'those';
+ local($s) = $warning == 1 ? '' : 's';
+ print "Note: $those previous warning$s may be suppressed by -M.\n";
+ }
+ }
+
+ # Cannot remove $cmaster as it is used later on when building Configure
+ undef @clist;
+ undef %cwanted;
+ undef %mwanted;
+ %visited = ();
+ %lastfound = ();
+
+ if (@SHlist) {
+ local($others) = $shext ? " $shext" : '';
+ print " Scanning .SH$others files for symbols...\n" unless $opt_s;
+ $search = ' ' x (40 * (@shmaster + @oshmaster)); # Pre-extend
+ $search = "while (<>) {study;\n";
+ # All the keys already have a leading '$'
+ foreach $key (keys(%shmaster)) {
+ $search .= "&shmaster('$key') if /\\$key\\b/;\n";
+ }
+ foreach $key (grep (/^\$/, keys %Obsolete)) {
+ $search .= "&ofound('$key') if /\\$key\\b/;\n";
+ }
+ $search .= "}\n";
+ print $search if $opt_d;
+ @ARGV = @SHlist;
+ # Swallow each file as a whole, if memory is available
+ undef $/ if $opt_m;
+ eval $search;
+ eval '';
+ $/ = "\n";
+ while (($key,$value) = each(%shmaster)) {
+ if ($value) {
+ $key =~ s/^\$//;
+ print WANTED $key, "\n";
+ }
+ }
+ }
+
+ # Obsolete symbols, if any, are written in the Wanted file preceded by a
+ # '!' character. In case -w is used, we'll thus be able to correctly build
+ # the Obsol_h.U and Obsol_sh.U files.
+
+ &add_obsolete; # Add obsolete symbols in Wanted file
+
+ close WANTED;
+
+ # If obsolete symbols where found, write an Obsolete file which lists where
+ # each of them appear and the new symbol to be used. Also write Obsol_h.U
+ # and Obsol_sh.U in .MT for later perusal.
+
+ &dump_obsolete; # Dump obsolete symbols if any
+
+ die "No desirable symbols found--aborting.\n" unless -s 'Wanted';
+
+ # Clean-up memory by freeing useless data structures
+ undef @SHlist;
+ undef %shmaster;
+}
+
+# This routine records matches of C master keys
+sub cmaster {
+ local($key) = @_;
+ $cmaster{$key}++; # This symbol is wanted
+ return unless $opt_t || $opt_M; # Return if neither -t nor -M
+ if ($opt_t &&
+ $lastfound{$key} ne $ARGV # Never mentionned for this file ?
+ ) {
+ $visited{$ARGV}++ || print $ARGV,":\n";
+ print "\t$key\n";
+ $lastfound{$key} = $ARGV;
+ }
+ if ($opt_M &&
+ defined($mwanted{$key}) # Found a ?M: symbol
+ ) {
+ foreach $csym (split(' ', $mwanted{$key})) {
+ $cmaster{$csym}++; # Activate C symbol dependencies
+ }
+ }
+}
+
+# This routine records matches of obsolete keys (C or shell)
+sub ofound {
+ local($key) = @_;
+ local($_) = $Obsolete{$key}; # Value of new symbol
+ $ofound{"$ARGV $key $_"}++; # Record obsolete match
+ $cmaster{$_}++ unless /^\$/; # A C hit
+ $shmaster{$_}++ if /^\$/; # Or a shell one
+ return unless $opt_t; # Continue if trace option on
+ if ($lastfound{$key} ne $ARGV) { # Never mentionned for this file ?
+ $visited{$ARGV}++ || print $ARGV,":\n";
+ print "\t$key (obsolete, use $_)\n";
+ $lastfound{$key} = $ARGV;
+ }
+}
+
+# This routine records matches of shell master keys
+sub shmaster {
+ local($key) = @_;
+ $shmaster{$key}++; # This symbol is wanted
+ return unless $opt_t; # Continue if trace option on
+ if ($lastfound{$key} ne $ARGV) { # Never mentionned for this file ?
+ $visited{$ARGV}++ || print $ARGV,":\n";
+ print "\t$key\n";
+ $lastfound{$key} = $ARGV;
+ }
+}
+
+# Write obsolete symbols into the Wanted file for later perusal by -w.
+sub add_obsolete {
+ local($file); # File where obsolete symbol was found
+ local($old); # Name of this old symbol
+ local($new); # Value of the new symbol to be used
+ foreach $key (sort keys %ofound) {
+ ($file, $old, $new) = ($key =~ /^(\S+)\s+(\S+)\s+(\S+)/);
+ if ($new =~ s/^\$//) { # We found an obsolete shell symbol
+ print WANTED "!$old\n";
+ } else { # We found an obsolete C symbol
+ print WANTED "!>$old\n";
+ }
+ }
+}
+
+# Map obsolete symbols from Wanted file into %Obsolete and call dump_obsolete
+# to actually build the Obsol_sh.U and Obsol_h.U files. Those will be needed
+# during the Configure building phase to actually do the remaping.
+# The obsolete symbols found are entered in the %ofound array, tagged as from
+# file 'XXX', which is specially recognized by dump_obsolete.
+sub map_obsolete {
+ open(WANTED, 'Wanted') || die "Can't open Wanted file.\n";
+ local($new); # New symbol to be used instead of obsolete one
+ while (<WANTED>) {
+ chop;
+ next unless s/^!//; # Skip non-obsolete symbols
+ if (s/^>//) { # C symbol
+ $new = $Obsolete{$_}; # Fetch new symbol
+ $ofound{"XXX $_ $new"}++; # Record obsolete match (XXX = no file)
+ } else { # Shell symbol
+ $new = $Obsolete{"\$$_"}; # Fetch new symbol
+ $ofound{"XXX \$$_ $new"}++; # Record obsolete match (XXX = no file)
+ }
+ }
+ close WANTED;
+}
+
+# Record obsolete symbols association (new versus old), that is to say for a
+# given old symbol, $Obsolete{'old'} = new symbol to be used. A '$' is prepended
+# for all shell variables
+sub record_obsolete {
+ local($_) = @_;
+ local(@obsoleted); # List of obsolete symbols
+ local($symbol); # New symbol which must be used
+ local($dollar) = s/^\$// ? '$':''; # The '$' or a null string
+ # Syntax for obsolete symbols specification is
+ # list of symbols (obsolete ones):
+ if (/^(\w+)\s*\((.*)\)\s*:$/) {
+ $symbol = "$dollar$1";
+ @obsoleted = split(' ', $2); # List of obsolete symbols
+ } else {
+ if (/^(\w+)\s*\((.*):$/) {
+ warn "\"$file\", line $.: final ')' before ':' missing.\n";
+ $symbol = "$dollar$1";
+ @obsoleted = split(' ', $2);
+ } else {
+ warn "\"$file\", line $.: syntax error.\n";
+ return;
+ }
+ }
+ foreach $val (@obsoleted) {
+ $_ = $dollar . $val;
+ if (defined $Obsolete{$_}) {
+ warn "\"$file\", line $.: '$_' already obsoleted by '$Obsolete{$_}'.\n";
+ } else {
+ $Obsolete{$_} = $symbol; # Record (old, new) tuple
+ }
+ }
+}
+
+# Dump obsolete symbols used in file 'Obsolete'. Also write Obsol_h.U and
+# Obsol_sh.U to record old versus new mappings if the -o option was used.
+sub dump_obsolete {
+ unless (-f 'Obsolete') {
+ open(OBSOLETE, ">Obsolete") || die "Can't create Obsolete.\n";
+ }
+ open(OBSOL_H, ">.MT/Obsol_h.U") || die "Can't create .MT/Obsol_h.U.\n";
+ open(OBSOL_SH, ">.MT/Obsol_sh.U") || die "Can't create .MT/Obsol_sh.U.\n";
+ local($file); # File where obsolete symbol was found
+ local($old); # Name of this old symbol
+ local($new); # Value of the new symbol to be used
+ # Leave a blank line at the top so that anny added ^L will stand on a line
+ # by itself (the formatting process adds a ^L when a new page is needed).
+ format OBSOLETE_TOP =
+
+ File | Old symbol | New symbol
+-----------------------------------+----------------------+---------------------
+.
+ format OBSOLETE =
+@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | @<<<<<<<<<<<<<<<<<<< | @<<<<<<<<<<<<<<<<<<<
+$file, $old, $new
+.
+ local(%seen);
+ foreach $key (sort keys %ofound) {
+ ($file, $old, $new) = ($key =~ /^(\S+)\s+(\S+)\s+(\S+)/);
+ write(OBSOLETE) unless $file eq 'XXX';
+ next unless $opt_o; # Obsolete mapping done only with -o
+ next if $seen{$old}++; # Already remapped, thank you
+ if ($new =~ s/^\$//) { # We found an obsolete shell symbol
+ $old =~ s/^\$//;
+ print OBSOL_SH "$old=\"\$$new\"\n";
+ } else { # We found an obsolete C symbol
+ print OBSOL_H "#ifdef $new\n";
+ print OBSOL_H "#define $old $new\n";
+ print OBSOL_H "#endif\n\n";
+ }
+ }
+ close OBSOLETE;
+ close OBSOL_H;
+ close OBSOL_SH;
+ if (-s 'Obsolete') {
+ print "*** Obsolete symbols found -- see file 'Obsolete' for a list.\n";
+ } else {
+ unlink 'Obsolete';
+ }
+ undef %ofound; # Not needed any more
+}
+
+# Build the private makefile we use to compute the transitive closure of the
+# previously determined dependencies.
+sub build_makefile {
+ print "Computing optimal dependency graph...\n" unless $opt_s;
+ chdir('.MT') || die "Can't chdir to .MT\n";
+ local($wanted); # Wanted shell symbols
+ &build_private; # Build a first makefile from dependencies
+ &compute_loadable; # Compute loadable units
+ &update_makefile; # Update makefile using feedback from first pass
+ chdir($WD) || die "Can't chdir back to $WD\n";
+ # Free memory by removing useless data structures
+ undef $dependencies;
+ undef $saved_dependencies;
+}
+
+# First pass: build a private makefile from the extracted dependency, changing
+# conditional units to truly wanted ones if the symbol is used, removing the
+# dependency otherwise. The original dependencies are saved.
+sub build_private {
+ print " Building private make file...\n" unless $opt_s;
+ open(WANTED,"../Wanted") || die "Can't reopen Wanted.\n";
+ $wanted = ' ' x 2000; # Pre-extend string
+ $wanted = '';
+ while (<WANTED>) {
+ chop;
+ next if /^!/; # Skip obsolete symbols
+ if (s/^>//) {
+ $cmaster{$_}++;
+ } else {
+ $wanted .= "$_ ";
+ }
+ }
+ close WANTED;
+
+ # The wanted symbols are sorted so that d_* (checking for C library symbol)
+ # come first and i_* (checking for includes) comes at the end. Grouping the
+ # d_* symbols together has good chances of improving the locality of the
+ # other questions and i_* symbols must come last since some depend on h_*
+ # values which prevent incompatible headers inclusions.
+ $wanted = join(' ', sort symbols split(' ', $wanted));
+
+ # Now generate the first makefile, which will be used to determine which
+ # symbols we really need, so that conditional dependencies may be solved.
+ open(MAKEFILE,">Makefile") || die "Can't create .MT/Makefile.\n";
+ print MAKEFILE "SHELL = /bin/sh\n";
+ print MAKEFILE "W = $wanted\n";
+ $saved_dependencies = $dependencies;
+ foreach $sym (@Cond) {
+ if ($symwanted{$sym}) {
+ $dependencies =~ s/\+($sym\s)/$1/gm;
+ } else {
+ $dependencies =~ s/\+$sym(\s)/$1/gm;
+ }
+ }
+ print MAKEFILE $dependencies;
+ close MAKEFILE;
+}
+
+# Ordering for symbols. Give higher priority to d_* ones and lower to i_* ones.
+# If any layout priority is defined in %Layout, it is used to order the
+# symbols.
+sub symbols {
+ local($r) = $Layout{$a} <=> $Layout{$b};
+ return $r if $r;
+ # If we come here, both symbols have the same layout priority.
+ if ($a =~ /^d_/) {
+ return -1 unless $b =~ /^d_/;
+ } elsif ($b =~ /^d_/) {
+ return 1;
+ } elsif ($a =~ /^i_/) {
+ return 1 unless $b =~ /^i_/;
+ } elsif ($b =~ /^i_/) {
+ return -1;
+ }
+ $a cmp $b;
+}
+
+# Run the makefile produced in the first pass to find the whole set of units we
+# have to load, filling in the %symwanted and %condwanted structures.
+sub compute_loadable {
+ print " Determining loadable units...\n" unless $opt_s;
+ open(MAKE, "make -n |") || die "Can't run make";
+ while (<MAKE>) {
+ s|^\s+||; # Some make print tabs before command
+ if (/^pick/) {
+ print "\t$_" if $opt_v;
+ ($pick,$cmd,$symbol,$unit) = split(' ');
+ $symwanted{$symbol}++;
+ $symwanted{$unit}++;
+ } elsif (/^cond/) {
+ print "\t$_" if $opt_v;
+ ($pick,@symbol) = split(' ');
+ for (@symbol) {
+ $condwanted{$_}++; # Default value is requested
+ }
+ }
+ }
+ close MAKE;
+}
+
+# Now that we know all the desirable symbols, we have to rebuild
+# another makefile, in order to have the units in a more optimal
+# way.
+# Actually, if we have both ?MAKE:a:+b and ?MAKE:d:b and 'd' is
+# wanted; then 'b' will be loaded. However, 'b' is a conditional
+# dependency for 'a', and it would be better if 'b' were loaded
+# before 'a' is, though this is not necessary.
+# It is hard to know that 'b' will be loaded *before* the first make.
+
+# Back to the original dependencies, make loadable units truly wanted ones and
+# remove optional ones.
+sub update_makefile {
+ print " Updating make file...\n" unless $opt_s;
+ open(MAKEFILE,">Makefile") || die "Can't create .MT/Makefile.\n";
+ print MAKEFILE "SHELL = /bin/sh\n";
+ print MAKEFILE "W = $wanted\n";
+ foreach $sym (@Cond) {
+ if ($symwanted{$sym}) {
+ $saved_dependencies =~ s/\+($sym\s)/$1/gm;
+ } else {
+ $saved_dependencies =~ s/\+$sym(\s)/$1/gm;
+ }
+ }
+ print MAKEFILE $saved_dependencies;
+ close MAKEFILE;
+}
+
+# Solve dependencies by saving the 'pick' command in @cmdwanted
+sub solve_dependencies {
+ local(%unitseen); # Record already picked units (avoid duplicates)
+ print "Determining the correct order for the units...\n" unless $opt_s;
+ chdir('.MT') || die "Can't chdir to .MT: $!.\n";
+ open(MAKE, "make -n |") || die "Can't run make";
+ while (<MAKE>) {
+ s|^\s+||; # Some make print tabs before command
+ print "\t$_" if $opt_v;
+ if (/^pick/) {
+ ($pick,$cmd,$symbol,$unit) = split(' ');
+ push(@cmdwanted,"$cmd $symbol $unit")
+ unless $unitseen{"$cmd:$unit"}++;
+ } elsif (/^cond/) {
+ # Ignore conditional symbol request
+ } else {
+ chop;
+ system;
+ }
+ }
+ chdir($WD) || die "Can't chdir to $WD: $!.\n";
+ close MAKE;
+}
+
+# Create the Configure script
+sub create_configure {
+ print "Creating Configure...\n" unless $opt_s;
+ open(CONFIGURE,">Configure") || die "Can't create Configure: $!\n";
+ open(CONF_H,">config_h.SH") || die "Can't create config_h.SH: $!\n";
+ if ($opt_M) {
+ open(MAGIC_H,">confmagic.h") || die "Can't create confmagic.h: $!\n";
+ }
+
+ chdir('.MT') || die "Can't cd to .MT: $!\n";
+ for (@cmdwanted) {
+ &process_command($_); # Run the makefile command
+ }
+ chdir($WD) || die "Can't cd back to $WD\n";
+ close CONFIGURE;
+ print CONF_H "#endif\n"; # Close the opened #ifdef (see Config_h.U)
+ print CONF_H "!GROK!THIS!\n";
+ close CONF_H;
+ if ($opt_M) {
+ print MAGIC_H "#endif\n"; # Close the opened #ifdef (see Magic_h.U)
+ close MAGIC_H;
+ }
+ `chmod +x Configure`;
+}
+
+# Process a Makefile 'pick' command
+sub process_command {
+ local($cmd, $target, $unit_name) = split(' ', $_[0]);
+ local($name) = $unit_name . '.U'; # Restore missing .U
+ local($file) = $name; # Where unit is located
+ unless ($file =~ m|^\./|) { # Unit produced earlier by metaconfig
+ $file = $Unit{$unit_name}; # Fetch unit from U directory
+ }
+ if (defined $Obsolete{$name}) { # Signal use of an obsolete unit
+ warn "\tObsolete unit $name is used:\n";
+ local(@msg) = split(/\n/, $Obsolete{$name});
+ foreach $msg (@msg) {
+ warn "\t $msg\n";
+ }
+ }
+ die "Can't open $file.\n" unless open(UNIT, $file);
+ print "\t$cmd $file\n" if $opt_v;
+ &init_interp; # Initializes the interpreter
+
+ # The 'add' command adds the unit to Configure.
+ if ($cmd eq 'add') {
+ while (<UNIT>) {
+ print CONFIGURE unless &skipped || !&interpret($_);
+ }
+ }
+
+ # The 'weed' command adds the unit to Configure, but
+ # makes some tests for the lines starting with '?' or '%'.
+ # These lines are kept only if the symbol is wanted.
+ elsif ($cmd eq 'weed') {
+ while (<UNIT>) {
+ if (/^\?(\w+):/) {
+ s/^\?\w+:// if $symwanted{$1};
+ }
+ if (/^%(\w+):/) {
+ s/^%\w+:// if $condwanted{$1};
+ }
+ print CONFIGURE unless &skipped || !&interpret($_);
+ }
+ }
+
+ # The 'wipe' command adds the unit to Configure, but
+ # also substitues some hardwired macros.
+ elsif ($cmd eq 'wipe') {
+ while (<UNIT>) {
+ s/<PACKAGENAME>/$package/g;
+ s/<MAINTLOC>/$maintloc/g;
+ s/<VERSION>/$version/g; # This is metaconfig's version
+ s/<PATCHLEVEL>/$patchlevel/g; # And patchlevel information
+ s/<DATE>/$date/g;
+ s/<BASEREV>/$baserev/g;
+ s/<\$(\w+)>/eval("\$$1")/ge; # <$var> -> $var substitution
+ print CONFIGURE unless &skipped || !&interpret($_);
+ }
+ }
+
+ # The 'add.Null' command adds empty initializations
+ # to Configure for all the shell variable used.
+ elsif ($cmd eq 'add.Null') {
+ for (sort @Master) {
+ if (/^\?(\w+):/) {
+ s/^\?\w+:// if $symwanted{$1};
+ }
+ print CONFIGURE unless &skipped;
+ }
+ for (sort @Cond) {
+ print CONFIGURE "$_=''\n"
+ unless $symwanted{$_} || $hasdefault{$_};
+ }
+ while (<UNIT>) {
+ print CONFIGURE unless &skipped || !&interpret($_);
+ }
+ print CONFIGURE "CONFIG=''\n\n";
+ }
+
+ # The 'add.Config_sh' command fills in the production of
+ # the config.sh script within Configure. Only the used
+ # variable are added, the conditional ones are skipped.
+ elsif ($cmd eq 'add.Config_sh') {
+ while (<UNIT>) {
+ print CONFIGURE unless &skipped || !&interpret($_);
+ }
+ for (sort @Master) {
+ if (/^\?(\w+):/) {
+ # Can't use $shmaster, because config.sh must
+ # also contain some internal defaults used by
+ # Configure (e.g. nm_opt, libc, etc...).
+ s/^\?\w+:// if $symwanted{$1};
+ }
+ s/^(\w+)=''/$1='\$$1'/;
+ print CONFIGURE unless &skipped;
+ }
+ }
+
+ # The 'close.Config_sh' command adds the final EOT line at
+ # the end of the here-document construct which produces the
+ # config.sh file within Configure.
+ elsif ($cmd eq 'close.Config_sh') {
+ print CONFIGURE "EOT\n\n"; # Ends up file
+ }
+
+ # The 'c_h_weed' command produces the config_h.SH file.
+ # Only the necessary lines are kept. If no conditional line is
+ # ever printed, then the file is useless and will be removed.
+ elsif ($cmd eq 'c_h_weed') {
+ $printed = 0;
+ while (<UNIT>) {
+ if (/^\?(\w+):/) {
+ s/^\?\w+:// if $cmaster{$1} || $symwanted{$1};
+ }
+ unless (&skipped || !&interpret($_)) {
+ if (/^$/) {
+ print CONF_H "\n" if $printed;
+ $printed = 0;
+ } else {
+ print CONF_H;
+ ++$printed;
+ }
+ }
+ }
+ }
+
+ # The 'cm_h_weed' command produces the confmagic.h file.
+ # Only the necessary lines are kept. If no conditional line is
+ # ever printed, then the file is useless and will be removed.
+ elsif ($cmd eq 'cm_h_weed') {
+ if ($opt_M) {
+ $printed = 0;
+ while (<UNIT>) {
+ if (/^\?(\w+):/) {
+ s/^\?\w+:// if $cmaster{$1} || $symwanted{$1};
+ }
+ unless (&skipped || !&interpret($_)) {
+ if (/^$/) {
+ print MAGIC_H "\n" if $printed;
+ $printed = 0;
+ } else {
+ print MAGIC_H;
+ ++$printed;
+ }
+ }
+ }
+ }
+ }
+
+ # The 'prepend' command will add the content of the target to
+ # the current file (held in $file, the one which UNIT refers to),
+ # if the file is not empty.
+ elsif ($cmd eq 'prepend') {
+ if (-s $file) {
+ open(PREPEND, ">.prepend") ||
+ die "Can't create .MT/.prepend.\n";
+ open(TARGET, $Unit{$target}) ||
+ die "Can't open $Unit{$target}.\n";
+ while (<TARGET>) {
+ print PREPEND unless &skipped;
+ }
+ print PREPEND <UNIT>; # Now add original file contents
+ close PREPEND;
+ close TARGET;
+ rename('.prepend', $file) ||
+ die "Can't rename .prepend into $file.\n";
+ }
+ }
+
+ # Command not found
+ else {
+ die "Unrecognized command from Makefile: $cmd\n";
+ }
+ &check_state; # Make sure there are no pending statements
+ close UNIT;
+}
+
+# Skip lines starting with ? or %, including all the following continuation
+# lines, if any. Return 0 if the line was not to be skipped, 1 otherwise.
+sub skipped {
+ return 0 unless /^\?|^%/;
+ &complete_line(UNIT) if /\\\s*$/; # Swallow continuation lines
+ 1;
+}
+
+# Update the MANIFEST.new file if necessary
+sub cosmetic_update {
+ # Check for an "empty" config_h.SH (2 blank lines only). This test relies
+ # on the actual text held in Config_h.U. If the unit is modified, then the
+ # following might need adjustments.
+ local($blank_lines) = 0;
+ local($spaces) = 0;
+ open(CONF_H, 'config_h.SH') || die "Can't open config_h.SH\n";
+ while(<CONF_H>) {
+ ++$blank_lines if /^$/;
+ }
+ unlink 'config_h.SH' unless $blank_lines > 3;
+
+ open(NEWMANI,$NEWMANI);
+ $_ = <NEWMANI>;
+ /(\S+\s+)\S+/ && ($spaces = length($1)); # Spaces wanted
+ close NEWMANI;
+ $spaces = 29 if ($spaces < 12); # Default value
+ open(NEWMANI,$NEWMANI);
+ $/ = "\001"; # Swallow the whole file
+ $_ = <NEWMANI>;
+ $/ = "\n";
+ close NEWMANI;
+
+ &mani_add('Configure', 'Portability tool', $spaces) unless /^Configure\b/m;
+ &mani_add('config_h.SH', 'Produces config.h', $spaces)
+ unless /^config_h\.SH\b/m || !-f 'config_h.SH';
+ &mani_add('confmagic.h', 'Magic symbol remapping', $spaces)
+ if $opt_M && !/^confmagic\.h\b/m;
+
+ &mani_remove('config_h.SH') if /^config_h\.SH\b/m && !-f 'config_h.SH';
+ &mani_remove('confmagic.h') if /^confmagic.h\b/m && !$opt_M;
+
+ if ($opt_G) { # Want a GNU-like configure wrapper
+ &add_configure;
+ &mani_add('configure', 'GNU configure-like wrapper', $spaces)
+ if !/^configure\s/m && -f 'configure';
+ } else {
+ &mani_remove('configure') if /^configure\s/m && !-f 'configure';
+ }
+}
+
+# Add file to MANIFEST.new, with properly indented comment
+sub mani_add {
+ local($file, $comment, $spaces) = @_;
+ print "Adding $file to your $NEWMANI file...\n" unless $opt_s;
+ open(NEWMANI, ">>$NEWMANI") || warn "Can't add $file to $NEWMANI: $!\n";
+ local($blank) = ' ' x ($spaces - length($file));
+ print NEWMANI "${file}${blank}${comment}\n";
+ close NEWMANI;
+}
+
+# Remove file from MANIFEST.new
+sub mani_remove {
+ local($file) = @_;
+ print "Removing $file from $NEWMANI...\n" unless $opt_s;
+ unless (open(NEWMANI, ">$NEWMANI.x")) {
+ warn "Can't create backup $NEWMANI copy: $!\n";
+ return;
+ }
+ unless (open(OLDMANI, $NEWMANI)) {
+ warn "Can't open $NEWMANI: $!\n";
+ return;
+ }
+ local($_);
+ while (<OLDMANI>) {
+ print NEWMANI unless /^$file\b/
+ }
+ close OLDMANI;
+ close NEWMANI;
+ rename("$NEWMANI.x", $NEWMANI) ||
+ warn "Couldn't restore $NEWMANI from $NEWMANI.x\n";
+}
+
+# Copy GNU-like configure wrapper to the package root directory
+sub add_configure {
+ if (-f "$MC/configure") {
+ print "Copying GNU configure-like front end...\n" unless $opt_s;
+ system "cp $MC/configure ./configure";
+ `chmod +x configure`;
+ } else {
+ warn "Can't locate $MC/configure: $!\n";
+ }
+}
+
+package interpreter;
+
+# States used by our interpeter -- in sync with @Keep
+sub main'init_keep {
+ # Status in which we keep lines -- $Keep[$status]
+ @Keep = (0, 1, 1, 0, 1);
+
+ # Available status ($status)
+ $SKIP = 0;
+ $IF = 1;
+ $ELSE = 2;
+ $NOT = 3;
+ $OUT = 4;
+}
+
+# Priorities for operators -- magic numbers :-)
+sub main'init_priority {
+ $Priority{'&&'} = 4;
+ $Priority{'||'} = 3;
+}
+
+# Initializes the state stack of the interpreter
+sub main'init_interp {
+ @state = ();
+ push(@state, $OUT);
+}
+
+# Print error messages -- asssumes $unit and $. correctly set.
+sub error {
+ warn "\"$main'file\", line $.: @_.\n";
+}
+
+# If some states are still in the stack, warn the user
+sub main'check_state {
+ &error("one statement pending") if $#state == 1;
+ &error("$#state statements pending") if $#state > 1;
+}
+
+# Add a value on the stack, modified by all the monadic operators.
+# We use the locals @val and @mono from eval_expr.
+sub push_val {
+ local($val) = shift(@_);
+ while ($#mono >= 0) {
+ # Cheat... the only monadic operator is '!'.
+ pop(@mono);
+ $val = !$val;
+ }
+ push(@val, $val);
+}
+
+# Execute a stacked operation, leave result in stack.
+# We use the locals @val and @op from eval_expr.
+# If the value stack holds only one operand, do nothing.
+sub execute {
+ return unless $#val > 0;
+ local($op) = pop(@op);
+ local($val1) = pop(@val);
+ local($val2) = pop(@val);
+ push(@val, eval("$val1 $op $val2") ? 1: 0);
+}
+
+# Given an operator, either we add it in the stack @op, because its
+# priority is lower than the one on top of the stack, or we first execute
+# the stacked operations until we reach the end of stack or an operand
+# whose priority is lower than ours.
+# We use the locals @val and @op from eval_expr.
+sub update_stack {
+ local($op) = shift(@_); # Operator
+ if (!$Priority{$op}) {
+ &error("illegal operator $op");
+ return;
+ } else {
+ if ($#val < 0) {
+ &error("missing first operand for '$op' (diadic operator)");
+ return;
+ }
+ # Because of the special behaviour of do-SUBR with the while modifier,
+ # I'm using a while-BLOCK construct. I consider this to be a bug of perl
+ # 4.0 PL19, although it is clearly documented in the man page.
+ while (
+ $Priority{$op[$#op]} > $Priority{$op} # Higher priority op
+ && $#val > 0 # At least 2 values
+ ) {
+ &execute; # Execute an higher priority stacked operation
+ }
+ push(@op, $op); # Everything at higher priority has been executed
+ }
+}
+
+# This is the heart of our little interpreter. Here, we evaluate
+# a logical expression and return its value.
+sub eval_expr {
+ local(*expr) = shift(@_); # Expression to parse
+ local(@val) = (); # Stack of values
+ local(@op) = (); # Stack of diadic operators
+ local(@mono) =(); # Stack of monadic operators
+ local($tmp);
+ $_ = $expr;
+ while (1) {
+ s/^\s+//; # Remove spaces between words
+ # The '(' construct
+ if (s/^\(//) {
+ &push_val(&eval_expr(*_));
+ # A final '\' indicates an end of line
+ &error("missing final parenthesis") if !s/^\\//;
+ }
+ # Found a ')' or end of line
+ elsif (/^\)/ || /^$/) {
+ s/^\)/\\/; # Signals: left parenthesis found
+ $expr = $_; # Remove interpreted stuff
+ &execute() while $#val > 0; # Executed stacked operations
+ while ($#op >= 0) {
+ $_ = pop(@op);
+ &error("missing second operand for '$_' (diadic operator)");
+ }
+ return $val[0];
+ }
+ # A perl statement '{{'
+ elsif (s/^\{\{//) {
+ if (s/^(.*)\}\}//) {
+ &push_val((system
+ ('perl','-e', "if ($1) {exit 0;} else {exit 1;}"
+ ))? 0 : 1);
+ } else {
+ &error("incomplete perl statement");
+ }
+ }
+ # A shell statement '{'
+ elsif (s/^\{//) {
+ if (s/^(.*)\}//) {
+ &push_val((system
+ ("if $1 >/dev/null 2>&1; then exit 0; else exit 1; fi"
+ ))? 0 : 1);
+ } else {
+ &error("incomplete shell statement");
+ }
+ }
+ # Operator '||' and '&&'
+ elsif (s/^(\|\||&&)//) {
+ $tmp = $1; # Save for perl5 (Dataloaded update_stack)
+ &update_stack($tmp);
+ }
+ # Unary operator '!'
+ elsif (s/^!//) {
+ push(@mono,'!');
+ }
+ # Everything else is a test for a defined value
+ elsif (s/^([\?%]?\w+)//) {
+ $tmp = $1;
+ # Test for wanted
+ if ($tmp =~ s/^\?//) {
+ &push_val(($main'symwanted{$tmp})? 1 : 0);
+ }
+ # Test for conditionally wanted
+ elsif ($tmp =~ s/^%//) {
+ &push_val(($main'condwanted{$tmp})? 1 : 0);
+ }
+ # Default: test for definition (see op @define)
+ else {
+ &push_val((
+ $main'symwanted{$tmp} ||
+ $main'cmaster{$tmp} ||
+ $main'userdef{$tmp}) ? 1 : 0);
+ }
+ }
+ # An error occured -- we did not recognize the expression
+ else {
+ s/^([^\s\(\)\{\|&!]+)//; # Skip until next meaningful char
+ }
+ }
+}
+
+# Given an expression in a '@' command, returns a boolean which is
+# the result of the evaluation. Evaluate is collecting all the lines
+# in the expression into a single string, and then calls eval_expr to
+# really evaluate it.
+sub evaluate {
+ local($val); # Value returned
+ local($expr) = ""; # Expression to be parsed
+ chop;
+ while (s/\\$//) { # While end of line escaped
+ $expr .= $_;
+ $_ = <UNIT>; # Fetch next line
+ unless ($_) {
+ &error("EOF in expression");
+ last;
+ }
+ chop;
+ }
+ $expr .= $_;
+ while ($expr ne '') {
+ $val = &eval_expr(*expr); # Expression will be modified
+ # We return from eval_expr either when a closing parenthisis
+ # is found, or when the expression has been fully analysed.
+ &error("extra closing parenthesis ignored") if $expr ne '';
+ }
+ $val;
+}
+
+# Given a line, we search for commands (lines starting with '@').
+# If there is no command in the line, then we return the boolean state.
+# Otherwise, the command is analysed and a new state is computed.
+# The returned value of interpret is 1 if the line is to be printed.
+sub main'interpret {
+ local($value);
+ local($status) = $state[$#state]; # Current status
+ if (s|^\s*@\s*(\w+)\s*(.*)|$2|) {
+ local($cmd) = $1;
+ $cmd =~ y/A-Z/a-z/; # Canonicalize to lower case
+ # The 'define' command
+ if ($cmd eq 'define') {
+ chop;
+ $userdef{$_}++ if $Keep[$status];
+ return 0;
+ }
+ # The 'if' command
+ elsif ($cmd eq 'if') {
+ # We always evaluate, in order to find possible errors
+ $value = &evaluate($_);
+ if (!$Keep[$status]) {
+ # We have to skip until next 'end'
+ push(@state, $SKIP); # Record structure
+ return 0;
+ }
+ if ($value) { # True
+ push(@state, $IF);
+ return 0;
+ } else { # False
+ push(@state, $NOT);
+ return 0;
+ }
+ }
+ # The 'else' command
+ elsif ($cmd eq 'else') {
+ &error("expression after 'else' ignored") if /\S/;
+ $state[$#state] = $SKIP if $state[$#state] == $IF;
+ return 0 if $state[$#state] == $SKIP;
+ if ($state[$#state] == $OUT) {
+ &error("unexpected 'else'");
+ return 0;
+ }
+ $state[$#state] = $ELSE;
+ return 0;
+ }
+ # The 'elsif' command
+ elsif ($cmd eq 'elsif') {
+ # We always evaluate, in order to find possible errors
+ $value = &evaluate($_);
+ $state[$#state] = $SKIP if $state[$#state] == $IF;
+ return 0 if $state[$#state] == $SKIP;
+ if ($state[$#state] == $OUT) {
+ &error("unexpected 'elsif'");
+ return 0;
+ }
+ if ($value) { # True
+ $state[$#state] = $IF;
+ return 0;
+ } else { # False
+ $state[$#state] = $NOT;
+ return 0;
+ }
+ }
+ # The 'end' command
+ elsif ($cmd eq 'end') {
+ &error("expression after 'end' ignored") if /\S/;
+ pop(@state);
+ &error("unexpected 'end'") if $#state < 0;
+ return 0;
+ }
+ # Unknown command
+ else {
+ &error("unknown command '$cmd'");
+ return 0;
+ }
+ }
+ $Keep[$status];
+}
+
+package main;
+
+sub readpackage {
+ if (! -f '.package') {
+ if (
+ -f '../.package' ||
+ -f '../../.package' ||
+ -f '../../../.package' ||
+ -f '../../../../.package'
+ ) {
+ die "Run in top level directory only.\n";
+ } else {
+ die "No .package file! Run packinit.\n";
+ }
+ }
+ open(PACKAGE,'.package');
+ while (<PACKAGE>) {
+ next if /^:/;
+ next if /^#/;
+ if (($var,$val) = /^\s*(\w+)=(.*)/) {
+ $val = "\"$val\"" unless $val =~ /^['"]/;
+ eval "\$$var = $val;";
+ }
+ }
+ close PACKAGE;
+}
+
+sub manifake {
+ # make MANIFEST and MANIFEST.new say the same thing
+ if (! -f $NEWMANI) {
+ if (-f $MANI) {
+ open(IN,$MANI) || die "Can't open $MANI";
+ open(OUT,">$NEWMANI") || die "Can't create $NEWMANI";
+ while (<IN>) {
+ if (/---/) {
+ # Everything until now was a header...
+ close OUT;
+ open(OUT,">$NEWMANI") ||
+ die "Can't recreate $NEWMANI";
+ next;
+ }
+ s/^\s*(\S+\s+)[0-9]*\s*(.*)/$1$2/;
+ print OUT;
+ print OUT "\n" unless /\n$/; # If no description
+ }
+ close IN;
+ close OUT;
+ }
+ else {
+die "You need to make a $NEWMANI file, with names and descriptions.\n";
+ }
+ }
+}
+
+# Perform ~name expansion ala ksh...
+# (banish csh from your vocabulary ;-)
+sub tilda_expand {
+ local($path) = @_;
+ return $path unless $path =~ /^~/;
+ $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e; # ~name
+ $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e; # ~
+ $path;
+}
+
+# Set up profile components into %Profile, add any profile-supplied options
+# into @ARGV and return the command invocation name.
+sub profile {
+ local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
+ local($me) = $0; # Command name
+ $me =~ s|.*/(.*)|$1|; # Keep only base name
+ return $me unless -s $profile;
+ local(*PROFILE); # Local file descriptor
+ local($options) = ''; # Options we get back from profile
+ unless (open(PROFILE, $profile)) {
+ warn "$me: cannot open $profile: $!\n";
+ return;
+ }
+ local($_);
+ local($component);
+ while (<PROFILE>) {
+ next if /^\s*#/; # Skip comments
+ next unless /^$me/o;
+ if (s/^$me://o) { # progname: options
+ chop;
+ $options .= $_; # Merge options if more than one line
+ }
+ elsif (s/^$me-([^:]+)://o) { # progname-component: value
+ $component = $1;
+ chop;
+ s/^\s+//; # Trim leading and trailing spaces
+ s/\s+$//;
+ $Profile{$component} = $_;
+ }
+ }
+ close PROFILE;
+ return unless $options;
+ require 'shellwords.pl';
+ local(@opts);
+ eval '@opts = &shellwords($options)'; # Protect against mismatched quotes
+ unshift(@ARGV, @opts);
+ return $me; # Return our invocation name
+}
+
--- /dev/null
+#!/pro/bin/perl
+
+chdir "/pro/3gl/CPAN/perl";
+system "chown merijn Configure config_h.SH";
+chmod 0775, "Configure", "config_h.SH";
+#-d "merijn" or mkdir "merijn";
+#system "cp -f Configure config_h.SH Porting/Glossary Porting/config.sh merijn/";
+system "ls -l Configure config_h.SH";
+
+#
+# This perl program uses dynamic loading [generated by perload]
+#
+
+$ENV{LC_ALL} = 'C';
+
+# $Id: mconfig.SH 4 2006-08-25 21:54:31Z rmanfredi $
+#
+# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
+#
+# You may redistribute only under the terms of the Artistic Licence,
+# as specified in the README file that comes with the distribution.
+# You may reuse parts of this distribution only within the terms of
+# that same Artistic Licence; a copy of which may be found at the root
+# of the source tree for dist 4.0.
+#
+# Original Author: Larry Wall <lwall@netlabs.com>
+# Key Contributor: Harlan Stenn <harlan@mumps.pfcs.com>
+#
+# $Log: mconfig.SH,v $
+# Revision 3.0.1.5 1995/07/25 14:19:05 ram
+# patch56: new -G option
+#
+# Revision 3.0.1.4 1994/06/20 07:11:04 ram
+# patch30: new -L option to override public library path for testing
+#
+# Revision 3.0.1.3 1994/01/24 14:20:53 ram
+# patch16: added ~/.dist_profile awareness
+#
+# Revision 3.0.1.2 1993/10/16 13:53:10 ram
+# patch12: new -M option for magic symbols and confmagic.h production
+#
+# Revision 3.0.1.1 1993/08/19 06:42:26 ram
+# patch1: leading config.sh searching was not aborting properly
+#
+# Revision 3.0 1993/08/18 12:10:17 ram
+# Baseline for dist 3.0 netwide release.
+#
+
+# Perload ON
+
+$MC = '/pro/3gl/CPAN/lib/dist';
+$version = '3.5';
+$patchlevel = '0';
+$grep = '/usr/bin/grep';
+chop($date = `date`);
+&profile; # Read ~/.dist_profile
+require 'getopts.pl';
+&usage unless &Getopts("dhkmostvwGMVL:");
+
+$MC = $opt_L if $opt_L; # May override public library path
+$MC = &tilda_expand($MC); # ~name expansion
+chop($WD = `pwd`); # Working directory
+chdir $MC || die "Can't chdir to $MC: $!\n";
+chop($MC = `pwd`); # Real metaconfig lib path (no symbolic links)
+chdir $WD || die "Can't chdir back to $WD: $!\n";
+
+++$opt_k if $opt_d;
+++$opt_M if -f 'confmagic.h'; # Force -M if confmagic.h already there
+
+if ($opt_V) {
+ print STDERR "metaconfig $version PL$patchlevel\n";
+ exit 0;
+} elsif ($opt_h) {
+ &usage;
+}
+
+unlink 'Wanted' unless $opt_w; # Wanted rebuilt if no -w
+unlink 'Obsolete' unless $opt_w; # Obsolete file rebuilt if no -w
+&readpackage; # Merely get the package's name
+&init; # Various initializations
+`mkdir .MT 2>&1` unless -d '.MT'; # For private temporary files
+
+&locate_units; # Fill in @ARGV with a unit list
+&extract_dependencies; # Extract dependencies from units
+&extract_filenames; # Extract files to be scanned for
+&build_wanted; # Build a list of wanted symbols in file Wanted
+&build_makefile; # To do the transitive closure of dependencies
+&solve_dependencies; # Now run the makefile to close dependency graph
+&create_configure; # Create the Configure script and related files
+&cosmetic_update; # Update the manifests
+
+if ($opt_k) {
+ print "Leaving subdirectory .MT unremoved so you can peruse it.\n"
+ unless $opt_s;
+} else {
+ `rm -rf .MT 2>&1`;
+}
+system "Porting/config_h.pl";
+print "Done.\n" unless $opt_s;
+
+sub main'init { &auto_main'init; }
+sub auto_main'init { &main'dataload; }
+
+sub main'init_constants { &auto_main'init_constants; }
+sub auto_main'init_constants { &main'dataload; }
+
+sub main'init_except { &auto_main'init_except; }
+sub auto_main'init_except { &main'dataload; }
+
+sub main'usage { &auto_main'usage; }
+sub auto_main'usage { &main'dataload; }
+
+package locate;
+
+sub main'locate_units { &auto_main'locate_units; }
+sub auto_main'locate_units { &main'dataload; }
+
+sub locate'dump_list { &auto_locate'dump_list; }
+sub auto_locate'dump_list { &main'dataload; }
+
+sub locate'private_units { &auto_locate'private_units; }
+sub auto_locate'private_units { &main'dataload; }
+
+sub locate'public_units { &auto_locate'public_units; }
+sub auto_locate'public_units { &main'dataload; }
+
+sub locate'units_path { &auto_locate'units_path; }
+sub auto_locate'units_path { &main'dataload; }
+
+package main;
+
+sub main'init_extraction { &auto_main'init_extraction; }
+sub auto_main'init_extraction { &main'dataload; }
+
+sub main'end_extraction { &auto_main'end_extraction; }
+sub auto_main'end_extraction { &main'dataload; }
+
+sub main'p_make { &auto_main'p_make; }
+sub auto_main'p_make { &main'dataload; }
+
+sub main'p_obsolete { &auto_main'p_obsolete; }
+sub auto_main'p_obsolete { &main'dataload; }
+
+sub main'p_shell { &auto_main'p_shell; }
+sub auto_main'p_shell { &main'dataload; }
+
+sub main'p_c { &auto_main'p_c; }
+sub auto_main'p_c { &main'dataload; }
+
+sub main'p_config { &auto_main'p_config; }
+sub auto_main'p_config { &main'dataload; }
+
+sub main'p_magic { &auto_main'p_magic; }
+sub auto_main'p_magic { &main'dataload; }
+
+sub p_ignore {} # Ignore comment line
+sub p_lint {} # Ignore lint directives
+sub p_visible {} # No visible checking in metaconfig
+sub p_temp {} # No temporary variable control
+sub p_file {} # Ignore produced file directives (for now)
+
+sub main'p_wanted { &auto_main'p_wanted; }
+sub auto_main'p_wanted { &main'dataload; }
+
+sub main'p_init { &auto_main'p_init; }
+sub auto_main'p_init { &main'dataload; }
+
+sub main'p_default { &auto_main'p_default; }
+sub auto_main'p_default { &main'dataload; }
+
+sub main'p_public { &auto_main'p_public; }
+sub auto_main'p_public { &main'dataload; }
+
+sub main'p_layout { &auto_main'p_layout; }
+sub auto_main'p_layout { &main'dataload; }
+
+sub main'p_library { &auto_main'p_library; }
+sub auto_main'p_library { &main'dataload; }
+
+sub main'p_include { &auto_main'p_include; }
+sub auto_main'p_include { &main'dataload; }
+
+sub main'write_out { &auto_main'write_out; }
+sub auto_main'write_out { &main'dataload; }
+
+sub main'init_depend { &auto_main'init_depend; }
+sub auto_main'init_depend { &main'dataload; }
+
+sub main'extract_dependencies { &auto_main'extract_dependencies; }
+sub auto_main'extract_dependencies { &main'dataload; }
+
+sub main'complete_line { &auto_main'complete_line; }
+sub auto_main'complete_line { &main'dataload; }
+
+sub main'extract_filenames { &auto_main'extract_filenames; }
+sub auto_main'extract_filenames { &main'dataload; }
+
+sub main'build_filext { &auto_main'build_filext; }
+sub auto_main'build_filext { &main'dataload; }
+
+sub main'build_extfun { &auto_main'build_extfun; }
+sub auto_main'build_extfun { &main'dataload; }
+
+sub main'q { &auto_main'q; }
+sub auto_main'q { &main'dataload; }
+
+sub main'build_wanted { &auto_main'build_wanted; }
+sub auto_main'build_wanted { &main'dataload; }
+
+sub main'parse_files { &auto_main'parse_files; }
+sub auto_main'parse_files { &main'dataload; }
+
+sub main'cmaster { &auto_main'cmaster; }
+sub auto_main'cmaster { &main'dataload; }
+
+sub main'ofound { &auto_main'ofound; }
+sub auto_main'ofound { &main'dataload; }
+
+sub main'shmaster { &auto_main'shmaster; }
+sub auto_main'shmaster { &main'dataload; }
+
+sub main'add_obsolete { &auto_main'add_obsolete; }
+sub auto_main'add_obsolete { &main'dataload; }
+
+sub main'map_obsolete { &auto_main'map_obsolete; }
+sub auto_main'map_obsolete { &main'dataload; }
+
+sub main'record_obsolete { &auto_main'record_obsolete; }
+sub auto_main'record_obsolete { &main'dataload; }
+
+sub main'dump_obsolete { &auto_main'dump_obsolete; }
+sub auto_main'dump_obsolete { &main'dataload; }
+
+sub main'build_makefile { &auto_main'build_makefile; }
+sub auto_main'build_makefile { &main'dataload; }
+
+sub main'build_private { &auto_main'build_private; }
+sub auto_main'build_private { &main'dataload; }
+
+sub main'symbols { &auto_main'symbols; }
+sub auto_main'symbols { &main'dataload; }
+
+sub main'compute_loadable { &auto_main'compute_loadable; }
+sub auto_main'compute_loadable { &main'dataload; }
+
+# Now that we know all the desirable symbols, we have to rebuild
+# another makefile, in order to have the units in a more optimal
+# way.
+# Actually, if we have both ?MAKE:a:+b and ?MAKE:d:b and 'd' is
+# wanted; then 'b' will be loaded. However, 'b' is a conditional
+# dependency for 'a', and it would be better if 'b' were loaded
+# before 'a' is, though this is not necessary.
+# It is hard to know that 'b' will be loaded *before* the first make.
+
+sub main'update_makefile { &auto_main'update_makefile; }
+sub auto_main'update_makefile { &main'dataload; }
+
+sub main'solve_dependencies { &auto_main'solve_dependencies; }
+sub auto_main'solve_dependencies { &main'dataload; }
+
+sub main'create_configure { &auto_main'create_configure; }
+sub auto_main'create_configure { &main'dataload; }
+
+sub main'process_command { &auto_main'process_command; }
+sub auto_main'process_command { &main'dataload; }
+
+sub main'skipped { &auto_main'skipped; }
+sub auto_main'skipped { &main'dataload; }
+
+sub main'cosmetic_update { &auto_main'cosmetic_update; }
+sub auto_main'cosmetic_update { &main'dataload; }
+
+sub main'mani_add { &auto_main'mani_add; }
+sub auto_main'mani_add { &main'dataload; }
+
+sub main'mani_remove { &auto_main'mani_remove; }
+sub auto_main'mani_remove { &main'dataload; }
+
+sub main'add_configure { &auto_main'add_configure; }
+sub auto_main'add_configure { &main'dataload; }
+
+package interpreter;
+
+sub main'init_keep { &auto_main'init_keep; }
+sub auto_main'init_keep { &main'dataload; }
+
+sub main'init_priority { &auto_main'init_priority; }
+sub auto_main'init_priority { &main'dataload; }
+
+sub main'init_interp { &auto_main'init_interp; }
+sub auto_main'init_interp { &main'dataload; }
+
+sub interpreter'error { &auto_interpreter'error; }
+sub auto_interpreter'error { &main'dataload; }
+
+sub main'check_state { &auto_main'check_state; }
+sub auto_main'check_state { &main'dataload; }
+
+sub interpreter'push_val { &auto_interpreter'push_val; }
+sub auto_interpreter'push_val { &main'dataload; }
+
+sub interpreter'execute { &auto_interpreter'execute; }
+sub auto_interpreter'execute { &main'dataload; }
+
+sub interpreter'update_stack { &auto_interpreter'update_stack; }
+sub auto_interpreter'update_stack { &main'dataload; }
+
+sub interpreter'eval_expr { &auto_interpreter'eval_expr; }
+sub auto_interpreter'eval_expr { &main'dataload; }
+
+sub interpreter'evaluate { &auto_interpreter'evaluate; }
+sub auto_interpreter'evaluate { &main'dataload; }
+
+sub main'interpret { &auto_main'interpret; }
+sub auto_main'interpret { &main'dataload; }
+
+package main;
+
+sub main'readpackage { &auto_main'readpackage; }
+sub auto_main'readpackage { &main'dataload; }
+
+sub main'manifake { &auto_main'manifake; }
+sub auto_main'manifake { &main'dataload; }
+
+sub main'tilda_expand { &auto_main'tilda_expand; }
+sub auto_main'tilda_expand { &main'dataload; }
+
+sub main'profile { &auto_main'profile; }
+sub auto_main'profile { &main'dataload; }
+
+# Load the calling function from DATA segment and call it. This function is
+# called only once per routine to be loaded.
+sub main'dataload {
+ local($__packname__) = (caller(1))[3];
+ $__packname__ =~ s/::/'/;
+ local($__rpackname__) = $__packname__;
+ local($__at__) = $@;
+ $__rpackname__ =~ s/^auto_//;
+ &perload'load_from_data($__rpackname__);
+ local($__fun__) = "$__rpackname__";
+ $__fun__ =~ s/'/'load_/;
+ eval "*$__packname__ = *$__fun__;"; # Change symbol table entry
+ die $@ if $@; # Should not happen
+ $@ = $__at__; # Restore value $@ had on entrance
+ &$__fun__; # Call newly loaded function
+}
+
+# Load function name given as argument, fatal error if not existent
+sub perload'load_from_data {
+ package perload;
+ local($pos) = $Datapos{$_[0]}; # Offset within DATA
+ # Avoid side effects by protecting special variables which will be changed
+ # by the dataloading operation.
+ local($., $_, $@);
+ $pos = &fetch_function_code unless $pos;
+ die "Function $_[0] not found in data section.\n" unless $pos;
+ die "Cannot seek to $pos into data section.\n"
+ unless seek(main'DATA, $pos, 0);
+ local($/) = "\n}";
+ local($body) = scalar(<main'DATA>);
+ die "End of file found while loading $_[0].\n" unless $body =~ /^\}$/m;
+ eval $body; # Load function into perl space
+ chop($@) && die "$@, while parsing code of $_[0].\n";
+}
+
+# This function is called only once, and fills in the %Datapos array with
+# the offset of each of the dataloaded routines held in the data section.
+sub perload'fetch_function_code {
+ package perload;
+ local($start) = 0;
+ local($., $_);
+ while (<main'DATA>) { # First move to start of offset table
+ next if /^#/;
+ last if /^$/ && ++$start > 2; # Skip two blank line after end token
+ }
+ $start = tell(main'DATA); # Offsets in table are relative to here
+ local($key, $value);
+ while (<main'DATA>) { # Load the offset table
+ last if /^$/; # Ends with a single blank line
+ ($key, $value) = split(' ');
+ $Datapos{$key} = $value + $start;
+ }
+ $Datapos{$_[0]}; # All that pain to get this offset...
+}
+
+#
+# The perl compiler stops here.
+#
+
+__END__
+
+#
+# Beyond this point lie functions we may never compile.
+#
+
+#
+# DO NOT CHANGE A IOTA BEYOND THIS COMMENT!
+# The following table lists offsets of functions within the data section.
+# Should modifications be needed, change original code and rerun perload
+# with the -o option to regenerate a proper offset table.
+#
+
+ interpreter'error 51675
+ interpreter'eval_expr 53822
+ interpreter'evaluate 56190
+ interpreter'execute 52464
+ interpreter'push_val 52099
+ interpreter'update_stack 52968
+ locate'dump_list 5219
+ locate'private_units 5352
+ locate'public_units 6139
+ locate'units_path 7632
+ main'add_configure 50796
+ main'add_obsolete 33314
+ main'build_extfun 26133
+ main'build_filext 25782
+ main'build_makefile 37799
+ main'build_private 38542
+ main'build_wanted 27394
+ main'check_state 51824
+ main'cmaster 31781
+ main'complete_line 24485
+ main'compute_loadable 40540
+ main'cosmetic_update 48406
+ main'create_configure 42431
+ main'dump_obsolete 35957
+ main'end_extraction 9995
+ main'extract_dependencies 21627
+ main'extract_filenames 24925
+ main'init 2714
+ main'init_constants 3033
+ main'init_depend 20477
+ main'init_except 3575
+ main'init_extraction 9143
+ main'init_interp 51524
+ main'init_keep 51113
+ main'init_priority 51376
+ main'interpret 57070
+ main'locate_units 4602
+ main'mani_add 49864
+ main'mani_remove 50228
+ main'manifake 59389
+ main'map_obsolete 34152
+ main'ofound 32371
+ main'p_c 12564
+ main'p_config 13870
+ main'p_default 17683
+ main'p_include 19574
+ main'p_init 17541
+ main'p_layout 19054
+ main'p_library 19485
+ main'p_magic 15626
+ main'p_make 10347
+ main'p_obsolete 11957
+ main'p_public 17872
+ main'p_shell 12111
+ main'p_wanted 16526
+ main'parse_files 27710
+ main'process_command 43224
+ main'profile 60570
+ main'q 27239
+ main'readpackage 58877
+ main'record_obsolete 34904
+ main'shmaster 32915
+ main'skipped 48225
+ main'solve_dependencies 41708
+ main'symbols 40026
+ main'tilda_expand 60215
+ main'update_makefile 41191
+ main'usage 3931
+ main'write_out 19840
+
+#
+# End of offset table and beginning of dataloading section.
+#
+
+# General initializations
+sub main'load_init {
+ package main;
+ &init_except; # Token which have upper-cased letters
+ &init_keep; # The keep status for built-in interpreter
+ &init_priority; # Priorities for diadic operators
+ &init_constants; # Define global constants
+ &init_depend; # The %Depend array records control line handling
+}
+
+sub main'load_init_constants {
+ package main;
+ $NEWMANI = 'MANIFEST.new'; # List of files to be scanned
+ $MANI = 'MANIFEST'; # For manifake
+
+ # The distinction between MANIFEST.new and MANIFEST can make sense
+ # when the "pat" tools are used, but if only metaconfig is used, then
+ # we can very well leave without a MANIFEST.new. --RAM, 2006-08-25
+ $NEWMANI = $MANI if -f $MANI && ! -f $NEWMANI;
+}
+
+# Record the exceptions -- almost all symbols but these are lower case
+# We also use three symbols from Unix.U for default file suffixes.
+sub main'load_init_except {
+ package main;
+ $Except{'Author'}++;
+ $Except{'Date'}++;
+ $Except{'Header'}++;
+ $Except{'Id'}++;
+ $Except{'Locker'}++;
+ $Except{'Log'}++;
+ $Except{'RCSfile'}++;
+ $Except{'Revision'}++;
+ $Except{'Source'}++;
+ $Except{'State'}++;
+ $Except{'_a'}++;
+ $Except{'_o'}++;
+ $Except{'_exe'}++;
+}
+
+# Print out metaconfig's usage and exits
+sub main'load_usage {
+ package main;
+ print STDERR <<'EOH';
+Usage: metaconfig [-dhkmostvwGMV] [-L dir]
+ -d : debug mode.
+ -h : print this help message and exits.
+ -k : keep temporary directory.
+ -m : assume lots of memory and swap space.
+ -o : maps obsolete symbols on new ones.
+ -s : silent mode.
+ -t : trace symbols as they are found.
+ -v : verbose mode.
+ -w : trust Wanted file as being up-to-date.
+ -G : also provide a GNU configure-like front end.
+ -L : specify main units repository.
+ -M : activate production of confmagic.h.
+ -V : print version number and exits.
+EOH
+ exit 1;
+}
+
+# Locate the units and push their path in @ARGV (sorted alphabetically)
+sub main'load_locate_units {
+ package locate;
+ print "Locating units...\n" unless $main'opt_s;
+ local(*WD) = *main'WD; # Current working directory
+ local(*MC) = *main'MC; # Public metaconfig library
+ undef %myUlist; # Records private units paths
+ undef %myUseen; # Records private/public conflicts
+ &private_units; # Locate private units in @myUlist
+ &public_units; # Locate public units in @ARGV
+ @ARGV = sort @ARGV; # Sort it alphabetically
+ push(@ARGV, sort @myUlist); # Append user's units sorted
+ &dump_list if $main'opt_v; # Dump the list of units
+}
+
+# Dump the list of units on stdout
+sub locate'load_dump_list {
+ package locate;
+ print "\t";
+ $, = "\n\t";
+ print @ARGV;
+ $, = '';
+ print "\n";
+}
+
+# Scan private units
+sub locate'load_private_units {
+ package locate;
+ return unless -d 'U'; # Nothing to be done if no 'U' entry
+ local(*ARGV) = *myUlist; # Really fill in @myUlist
+ local($MC) = $WD; # We are really in the working directory
+ &units_path("U"); # Locate units in the U directory
+ local($unit_name); # Unit's name (without .U)
+ local(@kept); # Array of kept units
+ # Loop over the units and remove duplicates (the first one seen is the one
+ # we keep). Also set the %myUseen H table to record private units seen.
+ foreach (@ARGV) {
+ ($unit_name) = m|^.*/(.*)\.U$|; # Get unit's name from path
+ next if $myUseen{$unit_name}; # Already recorded
+ $myUseen{$unit_name} = 1; # Record pirvate unit
+ push(@kept, $_); # Keep this unit
+ }
+ @ARGV = @kept;
+}
+
+# Scan public units
+sub locate'load_public_units {
+ package locate;
+ chdir($MC) || die "Can't find directory $MC.\n";
+ &units_path("U"); # Locate units in public U directory
+ chdir($WD) || die "Can't go back to directory $WD.\n";
+ local($path); # Relative path from $WD
+ local($unit_name); # Unit's name (without .U)
+ local(*Unit) = *main'Unit; # Unit is a global from main package
+ local(@kept); # Units kept
+ local(%warned); # Units which have already issued a message
+ # Loop over all the units and keep only the ones that were not found in
+ # the user's U directory. As it is possible two or more units with the same
+ # name be found in
+ foreach (@ARGV) {
+ ($unit_name) = m|^.*/(.*)\.U$|; # Get unit's name from path
+ next if $warned{$unit_name}; # We have already seen this unit
+ $warned{$unit_name} = 1; # Remember we have warned the user
+ if ($myUseen{$unit_name}) { # User already has a private unit
+ $path = $Unit{$unit_name}; # Extract user's unit path
+ next if $path eq $_; # Same path, we must be in mcon/
+ $path =~ s|^$WD/||o; # Weed out leading working dir path
+ print " Your private $path overrides the public one.\n"
+ unless $main'opt_s;
+ } else {
+ push(@kept, $_); # We may keep this one
+ }
+ }
+ @ARGV = @kept;
+}
+
+# Recursively locate units in the directory. Each file ending with .U has to be
+# a unit. Others are stat()'ed, and if they are a directory, they are also
+# scanned through. The $MC and @ARGV variable are dynamically set by the caller.
+sub locate'load_units_path {
+ package locate;
+ local($dir) = @_; # Directory where units are to be found
+ local(@contents); # Contents of the directory
+ local($unit_name); # Unit's name, without final .U
+ local($path); # Full path of a unit
+ local(*Unit) = *main'Unit; # Unit is a global from main package
+ unless (opendir(DIR, $dir)) {
+ warn("Cannot open directory $dir.\n");
+ return;
+ }
+ print "Locating in $MC/$dir...\n" if $main'opt_v;
+ @contents = readdir DIR; # Slurp the whole thing
+ closedir DIR; # And close dir, ready for recursion
+ foreach (@contents) {
+ next if $_ eq '.' || $_ eq '..';
+ if (/\.U$/) { # A unit, definitely
+ ($unit_name) = /^(.*)\.U$/;
+ $path = "$MC/$dir/$_"; # Full path of unit
+ push(@ARGV, $path); # Record its path
+ if (defined $Unit{$unit_name}) { # Already seen this unit
+ if ($main'opt_v) {
+ ($path) = $Unit{$unit_name} =~ m|^(.*)/.*|;
+ print " We've already seen $unit_name.U in $path.\n";
+ }
+ } else {
+ $Unit{$unit_name} = $path; # Map name to path
+ }
+ next;
+ }
+ # We have found a file which does not look like a unit. If it is a
+ # directory, then scan it. Otherwise skip the file.
+ unless (-d "$dir/$_") {
+ print " Skipping file $_ in $dir.\n" if $main'opt_v;
+ next;
+ }
+ &units_path("$dir/$_");
+ print "Back to $MC/$dir...\n" if $main'opt_v;
+ }
+}
+
+# Initialize the extraction process by setting some variables.
+# We return a string to be eval to do more customized initializations.
+sub main'load_init_extraction {
+ package main;
+ open(INIT, ">$WD/.MT/Init.U") ||
+ die "Can't create .MT/Init.U\n";
+ open(CONF_H, ">$WD/.MT/Config_h.U") ||
+ die "Can't create .MT/Config_h.U\n";
+ open(EXTERN, ">$WD/.MT/Extern.U") ||
+ die "Can't create .MT/Extern.U\n";
+ open(MAGIC_H, ">$WD/.MT/Magic_h.U") ||
+ die "Can't create .MT/Magic_h.U\n";
+
+ $c_symbol = ''; # Current symbol seen in ?C: lines
+ $s_symbol = ''; # Current symbol seen in ?S: lines
+ $m_symbol = ''; # Current symbol seen in ?M: lines
+ $heredoc = ''; # Last "here" document symbol seen
+ $heredoc_nosubst = 0; # True for <<'EOM' here docs
+ $condlist = ''; # List of conditional symbols
+ $defined = ''; # List of defined symbols in the unit
+ $body = ''; # No procedure to handle body
+ $ending = ''; # No procedure to clean-up
+}
+
+# End the extraction process
+sub main'load_end_extraction {
+ package main;
+ close EXTERN; # External dependencies (libraries, includes...)
+ close CONF_H; # C symbol definition template
+ close INIT; # Required initializations
+ close MAGIC; # Magic C symbol redefinition templates
+
+ print $dependencies if $opt_v; # Print extracted dependencies
+}
+
+# Process the ?MAKE: line
+sub main'load_p_make {
+ package main;
+ local($_) = @_;
+ local(@ary); # Locally defined symbols
+ local(@dep); # Dependencies
+ if (/^[\w+ ]*:/) { # Main dependency rule
+ s|^\s*||; # Remove leading spaces
+ chop;
+ s/:(.*)//;
+ @dep = split(' ', $1); # Dependencies
+ @ary = split(' '); # Locally defined symbols
+ foreach $sym (@ary) {
+ # Symbols starting with a '+' are meant for internal use only.
+ next if $sym =~ s/^\+//;
+ # Only sumbols starting with a lowercase letter are to
+ # appear in config.sh, excepted the ones listed in Except.
+ if ($sym =~ /^[_a-z]/ || $Except{$sym}) {
+ $shmaster{"\$$sym"} = undef;
+ push(@Master,"?$unit:$sym=''\n"); # Initializations
+ }
+ }
+ $condlist = ''; # List of conditional symbols
+ local($sym); # Symbol copy, avoid @dep alteration
+ foreach $dep (@dep) {
+ if ($dep =~ /^\+[A-Za-z]/) {
+ ($sym = $dep) =~ s|^\+||;
+ $condlist .= "$sym ";
+ push(@Cond, $sym) unless $condseen{$sym};
+ $condseen{$sym}++; # Conditionally wanted
+ }
+ }
+ # Append to already existing dependencies. The 'defined' variable
+ # is set for &write_out, used to implement ?L: and ?I: canvas. It is
+ # reset each time a new unit is parsed.
+ # NB: leading '+' for defined symbols (internal use only) have been
+ # removed at this point, but conditional dependencies still bear it.
+ $defined = join(' ', @ary); # Symbols defined by this unit
+ $dependencies .= $defined . ':' . join(' ', @dep) . "\n";
+ $dependencies .= " -cond $condlist\n" if $condlist;
+ } else {
+ $dependencies .= $_; # Building rules
+ }
+}
+
+# Process the ?O: line
+sub main'load_p_obsolete {
+ package main;
+ local($_) = @_;
+ $Obsolete{"$unit.U"} .= $_; # Message(s) to print if unit is used
+}
+
+# Process the ?S: lines
+sub main'load_p_shell {
+ package main;
+ local($_) = @_;
+ unless ($s_symbol) {
+ if (/^(\w+).*:/) {
+ $s_symbol = $1;
+ print " ?S: $s_symbol\n" if $opt_d;
+ } else {
+ warn "\"$file\", line $.: syntax error in ?S: construct.\n";
+ $s_symbol = $unit;
+ return;
+ }
+ # Deal with obsolete symbol list (enclosed between parenthesis)
+ &record_obsolete("\$$_") if /\(/;
+ }
+ m|^\.\s*$| && ($s_symbol = ''); # End of comment
+}
+
+# Process the ?C: lines
+sub main'load_p_c {
+ package main;
+ local($_) = @_;
+ unless ($c_symbol) {
+ if (s/^(\w+)\s*~\s*(\S+)\s*(.*):/$1 $3:/) {
+ # The ~ operator aliases the main C symbol to another symbol which
+ # is to be used instead for definition in config.h. That is to say,
+ # the line '?C:SYM ~ other:' would look for symbol 'other' instead,
+ # and the documentation for symbol SYM would only be included in
+ # config.h if 'other' were actually wanted.
+ $c_symbol = $2; # Alias for definition in config.h
+ print " ?C: $1 ~ $c_symbol\n" if $opt_d;
+ } elsif (/^(\w+).*:/) {
+ # Default behaviour. Include in config.h if symbol is needed.
+ $c_symbol = $1;
+ print " ?C: $c_symbol\n" if $opt_d;
+ } else {
+ warn "\"$file\", line $.: syntax error in ?C: construct.\n";
+ $c_symbol = $unit;
+ return;
+ }
+ # Deal with obsolete symbol list (enclosed between parenthesis) and
+ # make sure that list do not appear in config.h.SH by removing it.
+ &record_obsolete("$_") if /\(/;
+ s/\s*\(.*\)//; # Get rid of obsolete symbol list
+ }
+ s|^(\w+)\s*|?$c_symbol:/* $1| || # Start of comment
+ (s|^\.\s*$|?$c_symbol: */\n| && ($c_symbol = '', 1)) || # End of comment
+ s|^(.*)|?$c_symbol: *$1|; # Middle of comment
+ &p_config("$_"); # Add comments to config.h.SH
+}
+
+# Process the ?H: lines
+sub main'load_p_config {
+ package main;
+ local($_) = @_;
+ local($constraint); # Constraint to be used for inclusion
+ ++$old_version if s/^\?%1://; # Old version
+ if (s/^\?(\w+)://) { # Remove leading '?var:'
+ $constraint = $1; # Constraint is leading '?var'
+ } else {
+ $constraint = ''; # No constraint
+ }
+ if (/^#.*\$/) { # Look only for cpp lines
+ if (m|^#\$(\w+)\s+(\w+).*\$(\w+)|) {
+ # Case: #$d_var VAR "$var"
+ $constraint = $2 unless $constraint;
+ print " ?H: ($constraint) #\$$1 $2 \"\$$3\"\n" if $opt_d;
+ $cmaster{$2} = undef;
+ $cwanted{$2} = "$1\n$3";
+ } elsif (m|^#define\s+(\w+)\((.*)\)\s+\$(\w+)|) {
+ # Case: #define VAR(x) $var
+ $constraint = $1 unless $constraint;
+ print " ?H: ($constraint) #define $1($2) \$$3\n" if $opt_d;
+ $cmaster{$1} = undef;
+ $cwanted{$1} = $3;
+ } elsif (m|^#\$define\s+(\w+)|) {
+ # Case: #$define VAR
+ $constraint = $1 unless $constraint;
+ print " ?H: ($constraint) #define $1\n" if $opt_d;
+ $cmaster{$1} = undef;
+ $cwanted{$1} = "define\n$unit";
+ } elsif (m|^#\$(\w+)\s+(\w+)|) {
+ # Case: #$d_var VAR
+ $constraint = $2 unless $constraint;
+ print " ?H: ($constraint) #\$$1 $2\n" if $opt_d;
+ $cmaster{$2} = undef;
+ $cwanted{$2} = $1;
+ } elsif (m|^#define\s+(\w+).*\$(\w+)|) {
+ # Case: #define VAR "$var"
+ $constraint = $1 unless $constraint;
+ print " ?H: ($constraint) #define $1 \"\$$2\"\n" if $opt_d;
+ $cmaster{$1} = undef;
+ $cwanted{$1} = $2;
+ } else {
+ $constraint = $unit unless $constraint;
+ print " ?H: ($constraint) $_" if $opt_d;
+ }
+ } else {
+ print " ?H: ($constraint) $_" if $opt_d;
+ }
+ # If not a single ?H:. line, add the leading constraint
+ s/^\.// || s/^/?$constraint:/;
+ print CONF_H;
+}
+
+# Process the ?M: lines
+sub main'load_p_magic {
+ package main;
+ local($_) = @_;
+ unless ($m_symbol) {
+ if (/^(\w+):\s*([\w\s]*)\n$/) {
+ # A '?M:sym:' line implies a '?W:%<:sym' since we'll need to know
+ # about the wantedness of sym later on when building confmagic.h.
+ # Buf is sym is wanted, then the C symbol dependencies have to
+ # be triggered. That is done by introducing sym in the mwanted
+ # array, known by the Wanted file construction process...
+ $m_symbol = $1;
+ print " ?M: $m_symbol\n" if $opt_d;
+ $mwanted{$m_symbol} = $2; # Record C dependencies
+ &p_wanted("$unit:$m_symbol"); # Build fake ?W: line
+ } else {
+ warn "\"$file\", line $.: syntax error in ?M: construct.\n";
+ }
+ return;
+ }
+ (s/^\.\s*$/?$m_symbol:\n/ && ($m_symbol = '', 1)) || # End of block
+ s/^/?$m_symbol:/;
+ print MAGIC_H; # Definition goes to confmagic.h
+ print " ?M: $_" if $opt_d;
+}
+
+# Process the ?W: lines
+sub main'load_p_wanted {
+ package main;
+ # Syntax is ?W:<shell symbols>:<C symbols>
+ local($active) = $_[0] =~ /^([^:]*):/; # Symbols to activate
+ local($look_symbols) = $_[0] =~ /:(.*)/; # When those are used
+ local(@syms) = split(/ /, $look_symbols); # Keep original spacing info
+ $active =~ s/\s+/\n/g; # One symbol per line
+
+ # Concatenate quoted strings, so saying something like 'two words' will
+ # be introduced as one single symbol "two words".
+ local(@symbols); # Concatenated symbols to look for
+ local($concat) = ''; # Concatenation buffer
+ foreach (@syms) {
+ if (s/^\'//) {
+ $concat = $_;
+ } elsif (s/\'$//) {
+ push(@symbols, $concat . ' ' . $_);
+ $concat = '';
+ } else {
+ push(@symbols, $_) unless $concat;
+ $concat .= ' ' . $_ if $concat;
+ }
+ }
+
+ # Now record symbols in master and wanted tables
+ foreach (@symbols) {
+ $cmaster{$_} = undef; # Asks for look-up in C files
+ $cwanted{$_} = "$active" if $active; # Shell symbols to activate
+ }
+}
+
+# Process the ?INIT: lines
+sub main'load_p_init {
+ package main;
+ local($_) = @_;
+ print INIT "?$unit:", $_; # Wanted only if unit is loaded
+}
+
+# Process the ?D: lines
+sub main'load_p_default {
+ package main;
+ local($_) = @_;
+ s/^([A-Za-z_]+)=(.*)/\@if !$1\n%$1:$1=$2\n\@define $1\n\@end/
+ && ($hasdefault{$1}++, print INIT $_);
+}
+
+# Process the ?P: lines
+sub main'load_p_public {
+ package main;
+ local($_) = @_;
+ local($csym); # C symbol(s) we're trying to look at
+ local($nosym); # List of symbol(s) which mustn't be wanted
+ local($cfile); # Name of file implementing csym (no .ext)
+ ($csym, $nosym, $cfile) = /([^()]+)\s*(\(.*\))\s*:\s*(\S+)/;
+ unless ($csym eq '' || $cfile eq '') {
+ # Add dependencies for each C symbol, of the form:
+ # -pick public <sym> <file> <notdef symbols list>
+ # and the file will be added to config.c whenever sym is wanted and
+ # none of the notdef symbols is wanted.
+ foreach $sym (split(' ', $csym)) {
+ $dependencies .= "\t-pick public $sym $cfile $nosym\n";
+ }
+ }
+}
+
+# Process the ?Y: lines
+# Valid layouts are for now are: top, bottom, default.
+#
+# NOTA BENE:
+# This routine relies on the $defined variable, a global variable set
+# during the ?MAKE: processing, which lists all the defined symbols in
+# the unit (the optional leading '+' for internal symbols has been removed
+# if present).
+#
+# The routine fills up a %Layout table, indexed by symbol, yielding the
+# layout imposed to this unit. That table will then be used later on when
+# we sort wanted symbols for the Makefile.
+sub main'load_p_layout {
+ package main;
+ local($_) = @_;
+ local($layout) = /^\s*(\w+)/;
+ $layout =~ tr/A-Z/a-z/; # Case is not significant for layouts
+ unless (defined $Lcmp{$layout}) {
+ warn "\"$file\", line $.: unknown layout directive '$layout'.\n";
+ return;
+ }
+ foreach $sym (split(' ', $defined)) {
+ $Layout{$sym} = $Lcmp{$layout};
+ }
+}
+
+# Process the ?L: lines
+# There should not be any '-l' in front of the library name
+sub main'load_p_library {
+ package main;
+ &write_out("L:$_");
+}
+
+# Process the ?I: lines
+sub main'load_p_include {
+ package main;
+ &write_out("I:$_");
+}
+
+# Write out line in file Extern.U. The information recorded there has the
+# following prototypical format:
+# ?symbol:L:inet bsd
+# If 'symbol' is wanted, then 'inet bsd' will be added to $libswanted.
+sub main'load_write_out {
+ package main;
+ local($_) = @_;
+ local($target) = $defined; # By default, applies to defined symbols
+ $target = $1 if s/^(.*)://; # List is qualified "?L:target:symbols"
+ local(@target) = split(' ', $target);
+ chop;
+ foreach $key (@target) {
+ print EXTERN "?$key:$_\n"; # EXTERN file defined in xref.pl
+ }
+}
+
+# The %Depend array records the functions we use to process the configuration
+# lines in the unit, with a special meaning. It is important that all the
+# known control symbols be listed below, so that metalint does not complain.
+# The %Lcmp array contains valid layouts and their comparaison value.
+sub main'load_init_depend {
+ package main;
+ %Depend = (
+ 'MAKE', 'p_make', # The ?MAKE: line records dependencies
+ 'INIT', 'p_init', # Initializations printed verbatim
+ 'LINT', 'p_lint', # Hints for metalint
+ 'RCS', 'p_ignore', # RCS comments are ignored
+ 'C', 'p_c', # C symbols
+ 'D', 'p_default', # Default value for conditional symbols
+ 'E', 'p_example', # Example of usage
+ 'F', 'p_file', # Produced files
+ 'H', 'p_config', # Process the config.h lines
+ 'I', 'p_include', # Added includes
+ 'L', 'p_library', # Added libraries
+ 'M', 'p_magic', # Process the confmagic.h lines
+ 'O', 'p_obsolete', # Unit obsolescence
+ 'P', 'p_public', # Location of PD implementation file
+ 'S', 'p_shell', # Shell variables
+ 'T', 'p_temp', # Shell temporaries used
+ 'V', 'p_visible', # Visible symbols like 'rp', 'dflt'
+ 'W', 'p_wanted', # Wanted value for interpreter
+ 'X', 'p_ignore', # User comment is ignored
+ 'Y', 'p_layout', # User-defined layout preference
+ );
+ %Lcmp = (
+ 'top', -1,
+ 'default', 0,
+ 'bottom', 1,
+ );
+}
+
+# Extract dependencies from units held in @ARGV
+sub main'load_extract_dependencies {
+ package main;
+ local($proc); # Procedure used to handle a ctrl line
+ local($file); # Current file scanned
+ local($dir, $unit); # Directory and unit's name
+ local($old_version) = 0; # True when old-version unit detected
+ local($mc) = "$MC/U"; # Public metaconfig directory
+ local($line); # Last processed line for metalint
+
+ printf "Extracting dependency lists from %d units...\n", $#ARGV+1
+ unless $opt_s;
+
+ chdir $WD; # Back to working directory
+ &init_extraction; # Initialize extraction files
+ $dependencies = ' ' x (50 * @ARGV); # Pre-extend
+ $dependencies = '';
+
+ # We do not want to use the <> construct here, because we need the
+ # name of the opened files (to get the unit's name) and we want to
+ # reset the line number for each files, and do some pre-processing.
+
+ file: while ($file = shift(@ARGV)) {
+ close FILE; # Reset line number
+ $old_version = 0; # True if unit is an old version
+ if (open(FILE, $file)) {
+ ($dir, $unit) = ('', $file)
+ unless ($dir, $unit) = ($file =~ m|(.*)/(.*)|);
+ $unit =~ s|\.U$||; # Remove extension
+ } else {
+ warn("Can't open $file.\n");
+ }
+ # If unit is in the standard public directory, keep only the unit name
+ $file = "$unit.U" if $dir eq $mc;
+ print "$dir/$unit.U:\n" if $opt_d;
+ line: while (<FILE>) {
+ $line = $_; # Save last processed unit line
+ if (s/^\?([\w\-]+)://) { # We may have found a control line
+ $proc = $Depend{$1}; # Look for a procedure to handle it
+ unless ($proc) { # Unknown control line
+ $proc = $1; # p_unknown expects symbol in '$proc'
+ eval '&p_unknown'; # Signal error (metalint only)
+ next line; # And go on next line
+ }
+ # Long lines may be escaped with a final backslash
+ $_ .= &complete_line(FILE) if s/\\\s*$//;
+ # Run macros substitutions
+ s/%</$unit/g; # %< expands into the unit's name
+ if (s/%\*/$unit/) {
+ # %* expanded into the entire set of defined symbols
+ # in the old version. Now it is only the unit's name.
+ ++$old_version;
+ }
+ eval { &$proc($_) }; # Process the line
+ } else {
+ next file unless $body; # No procedure to handle body
+ do {
+ $line = $_; # Save last processed unit line
+ eval { &$body($_) } ; # From now on, it's the unit body
+ } while (defined ($_ = <FILE>));
+ next file;
+ }
+ }
+ } continue {
+ warn(" Warning: $file is a pre-3.0 version.\n") if $old_version;
+ &$ending($line) if $ending; # Post-processing for metalint
+ }
+
+ &end_extraction; # End the extraction process
+}
+
+# The first line was escaped with a final \ character. Every following line
+# is to be appended to it (until we found a real \n not escaped). Note that
+# the leading spaces of the continuation line are removed, so any space should
+# be added before the former \ if needed.
+sub main'load_complete_line {
+ package main;
+ local($file) = @_; # File where lines come from
+ local($_);
+ local($read) = ''; # Concatenation of all the continuation lines found
+ while (<$file>) {
+ s/^\s+//; # Remove leading spaces
+ if (s/\\\s*$//) { # Still followed by a continuation line
+ $read .= $_;
+ } else { # We've reached the end of the continuation
+ return $read . $_;
+ }
+ }
+}
+
+# Extract filenames from manifest
+sub main'load_extract_filenames {
+ package main;
+ &build_filext; # Construct &is_cfile and &is_shfile
+ print "Extracting filenames (C and SH files) from $NEWMANI...\n"
+ unless $opt_s;
+ open(NEWMANI,$NEWMANI) || die "Can't open $NEWMANI.\n";
+ local($file);
+ while (<NEWMANI>) {
+ ($file) = split(' ');
+ next if $file eq 'config_h.SH'; # skip config_h.SH
+ next if $file eq 'Configure'; # also skip Configure
+ next if $file eq 'confmagic.h' && $opt_M;
+ push(@SHlist, $file) if &is_shfile($file);
+ push(@clist, $file) if &is_cfile($file);
+ }
+}
+
+# Construct two file identifiers based on the file suffix: one for C files,
+# and one for SH files (using the $cext and $shext variables) defined in
+# the .package file.
+# The &is_cfile and &is_shfile routine may then be called to known whether
+# a given file is a candidate for holding C or SH symbols.
+sub main'load_build_filext {
+ package main;
+ &build_extfun('is_cfile', $cext, '.c .h .y .l');
+ &build_extfun('is_shfile', $shext, '.SH');
+}
+
+# Build routine $name to identify extensions listed in $exts, ensuring
+# that $minimum is at least matched (both to be backward compatible with
+# older .package and because it is really the minimum requirred).
+sub main'load_build_extfun {
+ package main;
+ local($name, $exts, $minimum) = @_;
+ local(@single); # Single letter dot extensions (may be grouped)
+ local(@others); # Other extensions
+ local(%seen); # Avoid duplicate extensions
+ foreach $ext (split(' ', "$exts $minimum")) {
+ next if $seen{$ext}++;
+ if ($ext =~ s/^\.(\w)$/$1/) {
+ push(@single, $ext);
+ } else {
+ # Convert into perl's regexp
+ $ext =~ s/\./\\./g; # Escape .
+ $ext =~ s/\?/./g; # ? turns into .
+ $ext =~ s/\*/.*/g; # * turns into .*
+ push(@others, $ext);
+ }
+ }
+ local($fn) = &q(<<EOF); # Function being built
+:sub $name {
+: local(\$_) = \@_;
+EOF
+ local($single); # Single regexp: .c .h grouped into .[ch]
+ $single = '\.[' . join('', @single) . ']' if @single;
+ $fn .= &q(<<EOL) if @single;
+: return 1 if /$single\$/;
+EOL
+ foreach $ext (@others) {
+ $fn .= &q(<<EOL);
+: return 1 if /$ext\$/;
+EOL
+ }
+ $fn .= &q(<<EOF);
+: 0; # None of the extensions may be applied to file name
+:}
+EOF
+ print $fn if $opt_d;
+ eval $fn;
+ chop($@) && die "Can't compile '$name':\n$fn\n$@.\n";
+}
+
+# Remove ':' quotations in front of the lines
+sub main'load_q {
+ package main;
+ local($_) = @_;
+ #ocal($*) =1;
+ s/^://gm;
+ $_;
+}
+
+# Build a wanted file from the files held in @SHlist and @clist arrays
+sub main'load_build_wanted {
+ package main;
+ # If wanted file is already there, parse it to map obsolete if -o option
+ # was used. Otherwise, build a new one.
+ if (-f 'Wanted') {
+ &map_obsolete if $opt_o; # Build Obsol*.U files
+ &dump_obsolete; # Dump obsolete symbols if any
+ return;
+ }
+ &parse_files;
+}
+
+sub main'load_parse_files {
+ package main;
+ print "Building a Wanted file...\n" unless $opt_s;
+ open(WANTED,"| sort | uniq >Wanted") || die "Can't create Wanted.\n";
+ unless (-f $NEWMANI) {
+ &manifake;
+ die "No $NEWMANI--can't build a Wanted file.\n" unless -f $NEWMANI;
+ }
+
+ local($search); # Where to-be-evaled script is held
+ local($_) = ' ' x 50000 if $opt_m; # Pre-extend pattern search space
+ local(%visited); # Records visited files
+ local(%lastfound); # Where last occurence of key was
+
+ # Now we are a little clever, and build a loop to eval so that we don't
+ # have to recompile our patterns on every file. We also use "study" since
+ # we are searching the same string for many different things. Hauls!
+
+ if (@clist) {
+ local($others) = $cext ? " $cext" : '';
+ print " Scanning .[chyl]$others files for symbols...\n"
+ unless $opt_s;
+ $search = ' ' x (40 * (@cmaster + @ocmaster)); # Pre-extend
+ $search = "while (<>) {study;\n"; # Init loop over ARGV
+ foreach $key (keys(%cmaster)) {
+ $search .= "&cmaster('$key') if /\\b$key\\b/;\n";
+ }
+ foreach $key (grep(!/^\$/, keys %Obsolete)) {
+ $search .= "&ofound('$key') if /\\b$key\\b/;\n";
+ }
+ $search .= "}\n"; # terminate loop
+ print $search if $opt_d;
+ @ARGV = @clist;
+ # Swallow each file as a whole, if memory is available
+ undef $/ if $opt_m;
+ eval $search;
+ eval '';
+ $/ = "\n";
+ while (($key,$value) = each(%cmaster)) {
+ print WANTED $cwanted{$key}, "\n", ">$key", "\n" if $value;
+ }
+ }
+
+ # If they don't use magic but use magically guarded symbols without
+ # their corresponding C symbol dependency, warn them, since they might
+ # not know about that portability issue.
+
+ if (@clist && !$opt_M) {
+ local($nused); # list of non-used symbols
+ local($warning) = 0; # true when one warning issued
+ foreach $cmag (keys %mwanted) { # loop over all used magic symbols
+ next unless $cmaster{$cmag};
+ $nused = '';
+ foreach $cdep (split(' ', $mwanted{$cmag})) {
+ $nused .= " $cdep" unless $cmaster{$cdep};
+ }
+ $nused =~ s/^ //;
+ $nused = "one of " . $nused if $nused =~ s/ /, /g;
+ if ($nused ne '') {
+ print " Warning: $cmag is used without $nused.\n";
+ $warning++;
+ }
+ }
+ if ($warning) {
+ local($those) = $warning == 1 ? 'that' : 'those';
+ local($s) = $warning == 1 ? '' : 's';
+ print "Note: $those previous warning$s may be suppressed by -M.\n";
+ }
+ }
+
+ # Cannot remove $cmaster as it is used later on when building Configure
+ undef @clist;
+ undef %cwanted;
+ undef %mwanted;
+ %visited = ();
+ %lastfound = ();
+
+ if (@SHlist) {
+ local($others) = $shext ? " $shext" : '';
+ print " Scanning .SH$others files for symbols...\n" unless $opt_s;
+ $search = ' ' x (40 * (@shmaster + @oshmaster)); # Pre-extend
+ $search = "while (<>) {study;\n";
+ # All the keys already have a leading '$'
+ foreach $key (keys(%shmaster)) {
+ $search .= "&shmaster('$key') if /\\$key\\b/;\n";
+ }
+ foreach $key (grep (/^\$/, keys %Obsolete)) {
+ $search .= "&ofound('$key') if /\\$key\\b/;\n";
+ }
+ $search .= "}\n";
+ print $search if $opt_d;
+ @ARGV = @SHlist;
+ # Swallow each file as a whole, if memory is available
+ undef $/ if $opt_m;
+ eval $search;
+ eval '';
+ $/ = "\n";
+ while (($key,$value) = each(%shmaster)) {
+ if ($value) {
+ $key =~ s/^\$//;
+ print WANTED $key, "\n";
+ }
+ }
+ }
+
+ # Obsolete symbols, if any, are written in the Wanted file preceded by a
+ # '!' character. In case -w is used, we'll thus be able to correctly build
+ # the Obsol_h.U and Obsol_sh.U files.
+
+ &add_obsolete; # Add obsolete symbols in Wanted file
+
+ close WANTED;
+
+ # If obsolete symbols where found, write an Obsolete file which lists where
+ # each of them appear and the new symbol to be used. Also write Obsol_h.U
+ # and Obsol_sh.U in .MT for later perusal.
+
+ &dump_obsolete; # Dump obsolete symbols if any
+
+ die "No desirable symbols found--aborting.\n" unless -s 'Wanted';
+
+ # Clean-up memory by freeing useless data structures
+ undef @SHlist;
+ undef %shmaster;
+}
+
+# This routine records matches of C master keys
+sub main'load_cmaster {
+ package main;
+ local($key) = @_;
+ $cmaster{$key}++; # This symbol is wanted
+ return unless $opt_t || $opt_M; # Return if neither -t nor -M
+ if ($opt_t &&
+ $lastfound{$key} ne $ARGV # Never mentionned for this file ?
+ ) {
+ $visited{$ARGV}++ || print $ARGV,":\n";
+ print "\t$key\n";
+ $lastfound{$key} = $ARGV;
+ }
+ if ($opt_M &&
+ defined($mwanted{$key}) # Found a ?M: symbol
+ ) {
+ foreach $csym (split(' ', $mwanted{$key})) {
+ $cmaster{$csym}++; # Activate C symbol dependencies
+ }
+ }
+}
+
+# This routine records matches of obsolete keys (C or shell)
+sub main'load_ofound {
+ package main;
+ local($key) = @_;
+ local($_) = $Obsolete{$key}; # Value of new symbol
+ $ofound{"$ARGV $key $_"}++; # Record obsolete match
+ $cmaster{$_}++ unless /^\$/; # A C hit
+ $shmaster{$_}++ if /^\$/; # Or a shell one
+ return unless $opt_t; # Continue if trace option on
+ if ($lastfound{$key} ne $ARGV) { # Never mentionned for this file ?
+ $visited{$ARGV}++ || print $ARGV,":\n";
+ print "\t$key (obsolete, use $_)\n";
+ $lastfound{$key} = $ARGV;
+ }
+}
+
+# This routine records matches of shell master keys
+sub main'load_shmaster {
+ package main;
+ local($key) = @_;
+ $shmaster{$key}++; # This symbol is wanted
+ return unless $opt_t; # Continue if trace option on
+ if ($lastfound{$key} ne $ARGV) { # Never mentionned for this file ?
+ $visited{$ARGV}++ || print $ARGV,":\n";
+ print "\t$key\n";
+ $lastfound{$key} = $ARGV;
+ }
+}
+
+# Write obsolete symbols into the Wanted file for later perusal by -w.
+sub main'load_add_obsolete {
+ package main;
+ local($file); # File where obsolete symbol was found
+ local($old); # Name of this old symbol
+ local($new); # Value of the new symbol to be used
+ foreach $key (sort keys %ofound) {
+ ($file, $old, $new) = ($key =~ /^(\S+)\s+(\S+)\s+(\S+)/);
+ if ($new =~ s/^\$//) { # We found an obsolete shell symbol
+ print WANTED "!$old\n";
+ } else { # We found an obsolete C symbol
+ print WANTED "!>$old\n";
+ }
+ }
+}
+
+# Map obsolete symbols from Wanted file into %Obsolete and call dump_obsolete
+# to actually build the Obsol_sh.U and Obsol_h.U files. Those will be needed
+# during the Configure building phase to actually do the remaping.
+# The obsolete symbols found are entered in the %ofound array, tagged as from
+# file 'XXX', which is specially recognized by dump_obsolete.
+sub main'load_map_obsolete {
+ package main;
+ open(WANTED, 'Wanted') || die "Can't open Wanted file.\n";
+ local($new); # New symbol to be used instead of obsolete one
+ while (<WANTED>) {
+ chop;
+ next unless s/^!//; # Skip non-obsolete symbols
+ if (s/^>//) { # C symbol
+ $new = $Obsolete{$_}; # Fetch new symbol
+ $ofound{"XXX $_ $new"}++; # Record obsolete match (XXX = no file)
+ } else { # Shell symbol
+ $new = $Obsolete{"\$$_"}; # Fetch new symbol
+ $ofound{"XXX \$$_ $new"}++; # Record obsolete match (XXX = no file)
+ }
+ }
+ close WANTED;
+}
+
+# Record obsolete symbols association (new versus old), that is to say for a
+# given old symbol, $Obsolete{'old'} = new symbol to be used. A '$' is prepended
+# for all shell variables
+sub main'load_record_obsolete {
+ package main;
+ local($_) = @_;
+ local(@obsoleted); # List of obsolete symbols
+ local($symbol); # New symbol which must be used
+ local($dollar) = s/^\$// ? '$':''; # The '$' or a null string
+ # Syntax for obsolete symbols specification is
+ # list of symbols (obsolete ones):
+ if (/^(\w+)\s*\((.*)\)\s*:$/) {
+ $symbol = "$dollar$1";
+ @obsoleted = split(' ', $2); # List of obsolete symbols
+ } else {
+ if (/^(\w+)\s*\((.*):$/) {
+ warn "\"$file\", line $.: final ')' before ':' missing.\n";
+ $symbol = "$dollar$1";
+ @obsoleted = split(' ', $2);
+ } else {
+ warn "\"$file\", line $.: syntax error.\n";
+ return;
+ }
+ }
+ foreach $val (@obsoleted) {
+ $_ = $dollar . $val;
+ if (defined $Obsolete{$_}) {
+ warn "\"$file\", line $.: '$_' already obsoleted by '$Obsolete{$_}'.\n";
+ } else {
+ $Obsolete{$_} = $symbol; # Record (old, new) tuple
+ }
+ }
+}
+
+# Dump obsolete symbols used in file 'Obsolete'. Also write Obsol_h.U and
+# Obsol_sh.U to record old versus new mappings if the -o option was used.
+sub main'load_dump_obsolete {
+ package main;
+ unless (-f 'Obsolete') {
+ open(OBSOLETE, ">Obsolete") || die "Can't create Obsolete.\n";
+ }
+ open(OBSOL_H, ">.MT/Obsol_h.U") || die "Can't create .MT/Obsol_h.U.\n";
+ open(OBSOL_SH, ">.MT/Obsol_sh.U") || die "Can't create .MT/Obsol_sh.U.\n";
+ local($file); # File where obsolete symbol was found
+ local($old); # Name of this old symbol
+ local($new); # Value of the new symbol to be used
+ # Leave a blank line at the top so that anny added ^L will stand on a line
+ # by itself (the formatting process adds a ^L when a new page is needed).
+ format OBSOLETE_TOP =
+
+ File | Old symbol | New symbol
+-----------------------------------+----------------------+---------------------
+.
+ format OBSOLETE =
+@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | @<<<<<<<<<<<<<<<<<<< | @<<<<<<<<<<<<<<<<<<<
+$file, $old, $new
+.
+ local(%seen);
+ foreach $key (sort keys %ofound) {
+ ($file, $old, $new) = ($key =~ /^(\S+)\s+(\S+)\s+(\S+)/);
+ write(OBSOLETE) unless $file eq 'XXX';
+ next unless $opt_o; # Obsolete mapping done only with -o
+ next if $seen{$old}++; # Already remapped, thank you
+ if ($new =~ s/^\$//) { # We found an obsolete shell symbol
+ $old =~ s/^\$//;
+ print OBSOL_SH "$old=\"\$$new\"\n";
+ } else { # We found an obsolete C symbol
+ print OBSOL_H "#ifdef $new\n";
+ print OBSOL_H "#define $old $new\n";
+ print OBSOL_H "#endif\n\n";
+ }
+ }
+ close OBSOLETE;
+ close OBSOL_H;
+ close OBSOL_SH;
+ if (-s 'Obsolete') {
+ print "*** Obsolete symbols found -- see file 'Obsolete' for a list.\n";
+ } else {
+ unlink 'Obsolete';
+ }
+ undef %ofound; # Not needed any more
+}
+
+# Build the private makefile we use to compute the transitive closure of the
+# previously determined dependencies.
+sub main'load_build_makefile {
+ package main;
+ print "Computing optimal dependency graph...\n" unless $opt_s;
+ chdir('.MT') || die "Can't chdir to .MT\n";
+ local($wanted); # Wanted shell symbols
+ &build_private; # Build a first makefile from dependencies
+ &compute_loadable; # Compute loadable units
+ &update_makefile; # Update makefile using feedback from first pass
+ chdir($WD) || die "Can't chdir back to $WD\n";
+ # Free memory by removing useless data structures
+ undef $dependencies;
+ undef $saved_dependencies;
+}
+
+# First pass: build a private makefile from the extracted dependency, changing
+# conditional units to truly wanted ones if the symbol is used, removing the
+# dependency otherwise. The original dependencies are saved.
+sub main'load_build_private {
+ package main;
+ print " Building private make file...\n" unless $opt_s;
+ open(WANTED,"../Wanted") || die "Can't reopen Wanted.\n";
+ $wanted = ' ' x 2000; # Pre-extend string
+ $wanted = '';
+ while (<WANTED>) {
+ chop;
+ next if /^!/; # Skip obsolete symbols
+ if (s/^>//) {
+ $cmaster{$_}++;
+ } else {
+ $wanted .= "$_ ";
+ }
+ }
+ close WANTED;
+
+ # The wanted symbols are sorted so that d_* (checking for C library symbol)
+ # come first and i_* (checking for includes) comes at the end. Grouping the
+ # d_* symbols together has good chances of improving the locality of the
+ # other questions and i_* symbols must come last since some depend on h_*
+ # values which prevent incompatible headers inclusions.
+ $wanted = join(' ', sort symbols split(' ', $wanted));
+
+ # Now generate the first makefile, which will be used to determine which
+ # symbols we really need, so that conditional dependencies may be solved.
+ open(MAKEFILE,">Makefile") || die "Can't create .MT/Makefile.\n";
+ print MAKEFILE "SHELL = /bin/sh\n";
+ print MAKEFILE "W = $wanted\n";
+ $saved_dependencies = $dependencies;
+ foreach $sym (@Cond) {
+ if ($symwanted{$sym}) {
+ $dependencies =~ s/\+($sym\s)/$1/gm;
+ } else {
+ $dependencies =~ s/\+$sym(\s)/$1/gm;
+ }
+ }
+ print MAKEFILE $dependencies;
+ close MAKEFILE;
+}
+
+# Ordering for symbols. Give higher priority to d_* ones and lower to i_* ones.
+# If any layout priority is defined in %Layout, it is used to order the
+# symbols.
+sub main'load_symbols {
+ package main;
+ local($r) = $Layout{$a} <=> $Layout{$b};
+ return $r if $r;
+ # If we come here, both symbols have the same layout priority.
+ if ($a =~ /^d_/) {
+ return -1 unless $b =~ /^d_/;
+ } elsif ($b =~ /^d_/) {
+ return 1;
+ } elsif ($a =~ /^i_/) {
+ return 1 unless $b =~ /^i_/;
+ } elsif ($b =~ /^i_/) {
+ return -1;
+ }
+ $a cmp $b;
+}
+
+# Run the makefile produced in the first pass to find the whole set of units we
+# have to load, filling in the %symwanted and %condwanted structures.
+sub main'load_compute_loadable {
+ package main;
+ print " Determining loadable units...\n" unless $opt_s;
+ open(MAKE, "make -n |") || die "Can't run make";
+ while (<MAKE>) {
+ s|^\s+||; # Some make print tabs before command
+ if (/^pick/) {
+ print "\t$_" if $opt_v;
+ ($pick,$cmd,$symbol,$unit) = split(' ');
+ $symwanted{$symbol}++;
+ $symwanted{$unit}++;
+ } elsif (/^cond/) {
+ print "\t$_" if $opt_v;
+ ($pick,@symbol) = split(' ');
+ for (@symbol) {
+ $condwanted{$_}++; # Default value is requested
+ }
+ }
+ }
+ close MAKE;
+}
+
+# Back to the original dependencies, make loadable units truly wanted ones and
+# remove optional ones.
+sub main'load_update_makefile {
+ package main;
+ print " Updating make file...\n" unless $opt_s;
+ open(MAKEFILE,">Makefile") || die "Can't create .MT/Makefile.\n";
+ print MAKEFILE "SHELL = /bin/sh\n";
+ print MAKEFILE "W = $wanted\n";
+ foreach $sym (@Cond) {
+ if ($symwanted{$sym}) {
+ $saved_dependencies =~ s/\+($sym\s)/$1/gm;
+ } else {
+ $saved_dependencies =~ s/\+$sym(\s)/$1/gm;
+ }
+ }
+ print MAKEFILE $saved_dependencies;
+ close MAKEFILE;
+}
+
+# Solve dependencies by saving the 'pick' command in @cmdwanted
+sub main'load_solve_dependencies {
+ package main;
+ local(%unitseen); # Record already picked units (avoid duplicates)
+ print "Determining the correct order for the units...\n" unless $opt_s;
+ chdir('.MT') || die "Can't chdir to .MT: $!.\n";
+ open(MAKE, "make -n |") || die "Can't run make";
+ while (<MAKE>) {
+ s|^\s+||; # Some make print tabs before command
+ print "\t$_" if $opt_v;
+ if (/^pick/) {
+ ($pick,$cmd,$symbol,$unit) = split(' ');
+ push(@cmdwanted,"$cmd $symbol $unit")
+ unless $unitseen{"$cmd:$unit"}++;
+ } elsif (/^cond/) {
+ # Ignore conditional symbol request
+ } else {
+ chop;
+ system;
+ }
+ }
+ chdir($WD) || die "Can't chdir to $WD: $!.\n";
+ close MAKE;
+}
+
+# Create the Configure script
+sub main'load_create_configure {
+ package main;
+ print "Creating Configure...\n" unless $opt_s;
+ open(CONFIGURE,">Configure") || die "Can't create Configure: $!\n";
+ open(CONF_H,">config_h.SH") || die "Can't create config_h.SH: $!\n";
+ if ($opt_M) {
+ open(MAGIC_H,">confmagic.h") || die "Can't create confmagic.h: $!\n";
+ }
+
+ chdir('.MT') || die "Can't cd to .MT: $!\n";
+ for (@cmdwanted) {
+ &process_command($_); # Run the makefile command
+ }
+ chdir($WD) || die "Can't cd back to $WD\n";
+ close CONFIGURE;
+ print CONF_H "#endif\n"; # Close the opened #ifdef (see Config_h.U)
+ print CONF_H "!GROK!THIS!\n";
+ close CONF_H;
+ if ($opt_M) {
+ print MAGIC_H "#endif\n"; # Close the opened #ifdef (see Magic_h.U)
+ close MAGIC_H;
+ }
+ `chmod +x Configure`;
+}
+
+# Process a Makefile 'pick' command
+sub main'load_process_command {
+ package main;
+ local($cmd, $target, $unit_name) = split(' ', $_[0]);
+ local($name) = $unit_name . '.U'; # Restore missing .U
+ local($file) = $name; # Where unit is located
+ unless ($file =~ m|^\./|) { # Unit produced earlier by metaconfig
+ $file = $Unit{$unit_name}; # Fetch unit from U directory
+ }
+ if (defined $Obsolete{$name}) { # Signal use of an obsolete unit
+ warn "\tObsolete unit $name is used:\n";
+ local(@msg) = split(/\n/, $Obsolete{$name});
+ foreach $msg (@msg) {
+ warn "\t $msg\n";
+ }
+ }
+ die "Can't open $file.\n" unless open(UNIT, $file);
+ print "\t$cmd $file\n" if $opt_v;
+ &init_interp; # Initializes the interpreter
+
+ # The 'add' command adds the unit to Configure.
+ if ($cmd eq 'add') {
+ while (<UNIT>) {
+ print CONFIGURE unless &skipped || !&interpret($_);
+ }
+ }
+
+ # The 'weed' command adds the unit to Configure, but
+ # makes some tests for the lines starting with '?' or '%'.
+ # These lines are kept only if the symbol is wanted.
+ elsif ($cmd eq 'weed') {
+ while (<UNIT>) {
+ if (/^\?(\w+):/) {
+ s/^\?\w+:// if $symwanted{$1};
+ }
+ if (/^%(\w+):/) {
+ s/^%\w+:// if $condwanted{$1};
+ }
+ print CONFIGURE unless &skipped || !&interpret($_);
+ }
+ }
+
+ # The 'wipe' command adds the unit to Configure, but
+ # also substitues some hardwired macros.
+ elsif ($cmd eq 'wipe') {
+ while (<UNIT>) {
+ s/<PACKAGENAME>/$package/g;
+ s/<MAINTLOC>/$maintloc/g;
+ s/<VERSION>/$version/g; # This is metaconfig's version
+ s/<PATCHLEVEL>/$patchlevel/g; # And patchlevel information
+ s/<DATE>/$date/g;
+ s/<BASEREV>/$baserev/g;
+ s/<\$(\w+)>/eval("\$$1")/ge; # <$var> -> $var substitution
+ print CONFIGURE unless &skipped || !&interpret($_);
+ }
+ }
+
+ # The 'add.Null' command adds empty initializations
+ # to Configure for all the shell variable used.
+ elsif ($cmd eq 'add.Null') {
+ for (sort @Master) {
+ if (/^\?(\w+):/) {
+ s/^\?\w+:// if $symwanted{$1};
+ }
+ print CONFIGURE unless &skipped;
+ }
+ for (sort @Cond) {
+ print CONFIGURE "$_=''\n"
+ unless $symwanted{$_} || $hasdefault{$_};
+ }
+ while (<UNIT>) {
+ print CONFIGURE unless &skipped || !&interpret($_);
+ }
+ print CONFIGURE "CONFIG=''\n\n";
+ }
+
+ # The 'add.Config_sh' command fills in the production of
+ # the config.sh script within Configure. Only the used
+ # variable are added, the conditional ones are skipped.
+ elsif ($cmd eq 'add.Config_sh') {
+ while (<UNIT>) {
+ print CONFIGURE unless &skipped || !&interpret($_);
+ }
+ for (sort @Master) {
+ if (/^\?(\w+):/) {
+ # Can't use $shmaster, because config.sh must
+ # also contain some internal defaults used by
+ # Configure (e.g. nm_opt, libc, etc...).
+ s/^\?\w+:// if $symwanted{$1};
+ }
+ s/^(\w+)=''/$1='\$$1'/;
+ print CONFIGURE unless &skipped;
+ }
+ }
+
+ # The 'close.Config_sh' command adds the final EOT line at
+ # the end of the here-document construct which produces the
+ # config.sh file within Configure.
+ elsif ($cmd eq 'close.Config_sh') {
+ print CONFIGURE "EOT\n\n"; # Ends up file
+ }
+
+ # The 'c_h_weed' command produces the config_h.SH file.
+ # Only the necessary lines are kept. If no conditional line is
+ # ever printed, then the file is useless and will be removed.
+ elsif ($cmd eq 'c_h_weed') {
+ $printed = 0;
+ while (<UNIT>) {
+ if (/^\?(\w+):/) {
+ s/^\?\w+:// if $cmaster{$1} || $symwanted{$1};
+ }
+ unless (&skipped || !&interpret($_)) {
+ if (/^$/) {
+ print CONF_H "\n" if $printed;
+ $printed = 0;
+ } else {
+ print CONF_H;
+ ++$printed;
+ }
+ }
+ }
+ }
+
+ # The 'cm_h_weed' command produces the confmagic.h file.
+ # Only the necessary lines are kept. If no conditional line is
+ # ever printed, then the file is useless and will be removed.
+ elsif ($cmd eq 'cm_h_weed') {
+ if ($opt_M) {
+ $printed = 0;
+ while (<UNIT>) {
+ if (/^\?(\w+):/) {
+ s/^\?\w+:// if $cmaster{$1} || $symwanted{$1};
+ }
+ unless (&skipped || !&interpret($_)) {
+ if (/^$/) {
+ print MAGIC_H "\n" if $printed;
+ $printed = 0;
+ } else {
+ print MAGIC_H;
+ ++$printed;
+ }
+ }
+ }
+ }
+ }
+
+ # The 'prepend' command will add the content of the target to
+ # the current file (held in $file, the one which UNIT refers to),
+ # if the file is not empty.
+ elsif ($cmd eq 'prepend') {
+ if (-s $file) {
+ open(PREPEND, ">.prepend") ||
+ die "Can't create .MT/.prepend.\n";
+ open(TARGET, $Unit{$target}) ||
+ die "Can't open $Unit{$target}.\n";
+ while (<TARGET>) {
+ print PREPEND unless &skipped;
+ }
+ print PREPEND <UNIT>; # Now add original file contents
+ close PREPEND;
+ close TARGET;
+ rename('.prepend', $file) ||
+ die "Can't rename .prepend into $file.\n";
+ }
+ }
+
+ # Command not found
+ else {
+ die "Unrecognized command from Makefile: $cmd\n";
+ }
+ &check_state; # Make sure there are no pending statements
+ close UNIT;
+}
+
+# Skip lines starting with ? or %, including all the following continuation
+# lines, if any. Return 0 if the line was not to be skipped, 1 otherwise.
+sub main'load_skipped {
+ package main;
+ return 0 unless /^\?|^%/;
+ &complete_line(UNIT) if /\\\s*$/; # Swallow continuation lines
+ 1;
+}
+
+# Update the MANIFEST.new file if necessary
+sub main'load_cosmetic_update {
+ package main;
+ # Check for an "empty" config_h.SH (2 blank lines only). This test relies
+ # on the actual text held in Config_h.U. If the unit is modified, then the
+ # following might need adjustments.
+ local($blank_lines) = 0;
+ local($spaces) = 0;
+ open(CONF_H, 'config_h.SH') || die "Can't open config_h.SH\n";
+ while(<CONF_H>) {
+ ++$blank_lines if /^$/;
+ }
+ unlink 'config_h.SH' unless $blank_lines > 3;
+
+ open(NEWMANI,$NEWMANI);
+ $_ = <NEWMANI>;
+ /(\S+\s+)\S+/ && ($spaces = length($1)); # Spaces wanted
+ close NEWMANI;
+ $spaces = 29 if ($spaces < 12); # Default value
+ open(NEWMANI,$NEWMANI);
+ $/ = "\001"; # Swallow the whole file
+ $_ = <NEWMANI>;
+ $/ = "\n";
+ close NEWMANI;
+
+ &mani_add('Configure', 'Portability tool', $spaces) unless /^Configure\b/m;
+ &mani_add('config_h.SH', 'Produces config.h', $spaces)
+ unless /^config_h\.SH\b/m || !-f 'config_h.SH';
+ &mani_add('confmagic.h', 'Magic symbol remapping', $spaces)
+ if $opt_M && !/^confmagic\.h\b/m;
+
+ &mani_remove('config_h.SH') if /^config_h\.SH\b/m && !-f 'config_h.SH';
+ &mani_remove('confmagic.h') if /^confmagic.h\b/m && !$opt_M;
+
+ if ($opt_G) { # Want a GNU-like configure wrapper
+ &add_configure;
+ &mani_add('configure', 'GNU configure-like wrapper', $spaces)
+ if !/^configure\s/m && -f 'configure';
+ } else {
+ &mani_remove('configure') if /^configure\s/m && !-f 'configure';
+ }
+}
+
+# Add file to MANIFEST.new, with properly indented comment
+sub main'load_mani_add {
+ package main;
+ local($file, $comment, $spaces) = @_;
+ print "Adding $file to your $NEWMANI file...\n" unless $opt_s;
+ open(NEWMANI, ">>$NEWMANI") || warn "Can't add $file to $NEWMANI: $!\n";
+ local($blank) = ' ' x ($spaces - length($file));
+ print NEWMANI "${file}${blank}${comment}\n";
+ close NEWMANI;
+}
+
+# Remove file from MANIFEST.new
+sub main'load_mani_remove {
+ package main;
+ local($file) = @_;
+ print "Removing $file from $NEWMANI...\n" unless $opt_s;
+ unless (open(NEWMANI, ">$NEWMANI.x")) {
+ warn "Can't create backup $NEWMANI copy: $!\n";
+ return;
+ }
+ unless (open(OLDMANI, $NEWMANI)) {
+ warn "Can't open $NEWMANI: $!\n";
+ return;
+ }
+ local($_);
+ while (<OLDMANI>) {
+ print NEWMANI unless /^$file\b/
+ }
+ close OLDMANI;
+ close NEWMANI;
+ rename("$NEWMANI.x", $NEWMANI) ||
+ warn "Couldn't restore $NEWMANI from $NEWMANI.x\n";
+}
+
+# Copy GNU-like configure wrapper to the package root directory
+sub main'load_add_configure {
+ package main;
+ if (-f "$MC/configure") {
+ print "Copying GNU configure-like front end...\n" unless $opt_s;
+ system "cp $MC/configure ./configure";
+ `chmod +x configure`;
+ } else {
+ warn "Can't locate $MC/configure: $!\n";
+ }
+}
+
+# States used by our interpeter -- in sync with @Keep
+sub main'load_init_keep {
+ package interpreter;
+ # Status in which we keep lines -- $Keep[$status]
+ @Keep = (0, 1, 1, 0, 1);
+
+ # Available status ($status)
+ $SKIP = 0;
+ $IF = 1;
+ $ELSE = 2;
+ $NOT = 3;
+ $OUT = 4;
+}
+
+# Priorities for operators -- magic numbers :-)
+sub main'load_init_priority {
+ package interpreter;
+ $Priority{'&&'} = 4;
+ $Priority{'||'} = 3;
+}
+
+# Initializes the state stack of the interpreter
+sub main'load_init_interp {
+ package interpreter;
+ @state = ();
+ push(@state, $OUT);
+}
+
+# Print error messages -- asssumes $unit and $. correctly set.
+sub interpreter'load_error {
+ package interpreter;
+ warn "\"$main'file\", line $.: @_.\n";
+}
+
+# If some states are still in the stack, warn the user
+sub main'load_check_state {
+ package interpreter;
+ &error("one statement pending") if $#state == 1;
+ &error("$#state statements pending") if $#state > 1;
+}
+
+# Add a value on the stack, modified by all the monadic operators.
+# We use the locals @val and @mono from eval_expr.
+sub interpreter'load_push_val {
+ package interpreter;
+ local($val) = shift(@_);
+ while ($#mono >= 0) {
+ # Cheat... the only monadic operator is '!'.
+ pop(@mono);
+ $val = !$val;
+ }
+ push(@val, $val);
+}
+
+# Execute a stacked operation, leave result in stack.
+# We use the locals @val and @op from eval_expr.
+# If the value stack holds only one operand, do nothing.
+sub interpreter'load_execute {
+ package interpreter;
+ return unless $#val > 0;
+ local($op) = pop(@op);
+ local($val1) = pop(@val);
+ local($val2) = pop(@val);
+ push(@val, eval("$val1 $op $val2") ? 1: 0);
+}
+
+# Given an operator, either we add it in the stack @op, because its
+# priority is lower than the one on top of the stack, or we first execute
+# the stacked operations until we reach the end of stack or an operand
+# whose priority is lower than ours.
+# We use the locals @val and @op from eval_expr.
+sub interpreter'load_update_stack {
+ package interpreter;
+ local($op) = shift(@_); # Operator
+ if (!$Priority{$op}) {
+ &error("illegal operator $op");
+ return;
+ } else {
+ if ($#val < 0) {
+ &error("missing first operand for '$op' (diadic operator)");
+ return;
+ }
+ # Because of the special behaviour of do-SUBR with the while modifier,
+ # I'm using a while-BLOCK construct. I consider this to be a bug of perl
+ # 4.0 PL19, although it is clearly documented in the man page.
+ while (
+ $Priority{$op[$#op]} > $Priority{$op} # Higher priority op
+ && $#val > 0 # At least 2 values
+ ) {
+ &execute; # Execute an higher priority stacked operation
+ }
+ push(@op, $op); # Everything at higher priority has been executed
+ }
+}
+
+# This is the heart of our little interpreter. Here, we evaluate
+# a logical expression and return its value.
+sub interpreter'load_eval_expr {
+ package interpreter;
+ local(*expr) = shift(@_); # Expression to parse
+ local(@val) = (); # Stack of values
+ local(@op) = (); # Stack of diadic operators
+ local(@mono) =(); # Stack of monadic operators
+ local($tmp);
+ $_ = $expr;
+ while (1) {
+ s/^\s+//; # Remove spaces between words
+ # The '(' construct
+ if (s/^\(//) {
+ &push_val(&eval_expr(*_));
+ # A final '\' indicates an end of line
+ &error("missing final parenthesis") if !s/^\\//;
+ }
+ # Found a ')' or end of line
+ elsif (/^\)/ || /^$/) {
+ s/^\)/\\/; # Signals: left parenthesis found
+ $expr = $_; # Remove interpreted stuff
+ &execute() while $#val > 0; # Executed stacked operations
+ while ($#op >= 0) {
+ $_ = pop(@op);
+ &error("missing second operand for '$_' (diadic operator)");
+ }
+ return $val[0];
+ }
+ # A perl statement '{{'
+ elsif (s/^\{\{//) {
+ if (s/^(.*)\}\}//) {
+ &push_val((system
+ ('perl','-e', "if ($1) {exit 0;} else {exit 1;}"
+ ))? 0 : 1);
+ } else {
+ &error("incomplete perl statement");
+ }
+ }
+ # A shell statement '{'
+ elsif (s/^\{//) {
+ if (s/^(.*)\}//) {
+ &push_val((system
+ ("if $1 >/dev/null 2>&1; then exit 0; else exit 1; fi"
+ ))? 0 : 1);
+ } else {
+ &error("incomplete shell statement");
+ }
+ }
+ # Operator '||' and '&&'
+ elsif (s/^(\|\||&&)//) {
+ $tmp = $1; # Save for perl5 (Dataloaded update_stack)
+ &update_stack($tmp);
+ }
+ # Unary operator '!'
+ elsif (s/^!//) {
+ push(@mono,'!');
+ }
+ # Everything else is a test for a defined value
+ elsif (s/^([\?%]?\w+)//) {
+ $tmp = $1;
+ # Test for wanted
+ if ($tmp =~ s/^\?//) {
+ &push_val(($main'symwanted{$tmp})? 1 : 0);
+ }
+ # Test for conditionally wanted
+ elsif ($tmp =~ s/^%//) {
+ &push_val(($main'condwanted{$tmp})? 1 : 0);
+ }
+ # Default: test for definition (see op @define)
+ else {
+ &push_val((
+ $main'symwanted{$tmp} ||
+ $main'cmaster{$tmp} ||
+ $main'userdef{$tmp}) ? 1 : 0);
+ }
+ }
+ # An error occured -- we did not recognize the expression
+ else {
+ s/^([^\s\(\)\{\|&!]+)//; # Skip until next meaningful char
+ }
+ }
+}
+
+# Given an expression in a '@' command, returns a boolean which is
+# the result of the evaluation. Evaluate is collecting all the lines
+# in the expression into a single string, and then calls eval_expr to
+# really evaluate it.
+sub interpreter'load_evaluate {
+ package interpreter;
+ local($val); # Value returned
+ local($expr) = ""; # Expression to be parsed
+ chop;
+ while (s/\\$//) { # While end of line escaped
+ $expr .= $_;
+ $_ = <UNIT>; # Fetch next line
+ unless ($_) {
+ &error("EOF in expression");
+ last;
+ }
+ chop;
+ }
+ $expr .= $_;
+ while ($expr ne '') {
+ $val = &eval_expr(*expr); # Expression will be modified
+ # We return from eval_expr either when a closing parenthisis
+ # is found, or when the expression has been fully analysed.
+ &error("extra closing parenthesis ignored") if $expr ne '';
+ }
+ $val;
+}
+
+# Given a line, we search for commands (lines starting with '@').
+# If there is no command in the line, then we return the boolean state.
+# Otherwise, the command is analysed and a new state is computed.
+# The returned value of interpret is 1 if the line is to be printed.
+sub main'load_interpret {
+ package interpreter;
+ local($value);
+ local($status) = $state[$#state]; # Current status
+ if (s|^\s*@\s*(\w+)\s*(.*)|$2|) {
+ local($cmd) = $1;
+ $cmd =~ y/A-Z/a-z/; # Canonicalize to lower case
+ # The 'define' command
+ if ($cmd eq 'define') {
+ chop;
+ $userdef{$_}++ if $Keep[$status];
+ return 0;
+ }
+ # The 'if' command
+ elsif ($cmd eq 'if') {
+ # We always evaluate, in order to find possible errors
+ $value = &evaluate($_);
+ if (!$Keep[$status]) {
+ # We have to skip until next 'end'
+ push(@state, $SKIP); # Record structure
+ return 0;
+ }
+ if ($value) { # True
+ push(@state, $IF);
+ return 0;
+ } else { # False
+ push(@state, $NOT);
+ return 0;
+ }
+ }
+ # The 'else' command
+ elsif ($cmd eq 'else') {
+ &error("expression after 'else' ignored") if /\S/;
+ $state[$#state] = $SKIP if $state[$#state] == $IF;
+ return 0 if $state[$#state] == $SKIP;
+ if ($state[$#state] == $OUT) {
+ &error("unexpected 'else'");
+ return 0;
+ }
+ $state[$#state] = $ELSE;
+ return 0;
+ }
+ # The 'elsif' command
+ elsif ($cmd eq 'elsif') {
+ # We always evaluate, in order to find possible errors
+ $value = &evaluate($_);
+ $state[$#state] = $SKIP if $state[$#state] == $IF;
+ return 0 if $state[$#state] == $SKIP;
+ if ($state[$#state] == $OUT) {
+ &error("unexpected 'elsif'");
+ return 0;
+ }
+ if ($value) { # True
+ $state[$#state] = $IF;
+ return 0;
+ } else { # False
+ $state[$#state] = $NOT;
+ return 0;
+ }
+ }
+ # The 'end' command
+ elsif ($cmd eq 'end') {
+ &error("expression after 'end' ignored") if /\S/;
+ pop(@state);
+ &error("unexpected 'end'") if $#state < 0;
+ return 0;
+ }
+ # Unknown command
+ else {
+ &error("unknown command '$cmd'");
+ return 0;
+ }
+ }
+ $Keep[$status];
+}
+
+sub main'load_readpackage {
+ package main;
+ if (! -f '.package') {
+ if (
+ -f '../.package' ||
+ -f '../../.package' ||
+ -f '../../../.package' ||
+ -f '../../../../.package'
+ ) {
+ die "Run in top level directory only.\n";
+ } else {
+ die "No .package file! Run packinit.\n";
+ }
+ }
+ open(PACKAGE,'.package');
+ while (<PACKAGE>) {
+ next if /^:/;
+ next if /^#/;
+ if (($var,$val) = /^\s*(\w+)=(.*)/) {
+ $val = "\"$val\"" unless $val =~ /^['"]/;
+ eval "\$$var = $val;";
+ }
+ }
+ close PACKAGE;
+}
+
+sub main'load_manifake {
+ package main;
+ # make MANIFEST and MANIFEST.new say the same thing
+ if (! -f $NEWMANI) {
+ if (-f $MANI) {
+ open(IN,$MANI) || die "Can't open $MANI";
+ open(OUT,">$NEWMANI") || die "Can't create $NEWMANI";
+ while (<IN>) {
+ if (/---/) {
+ # Everything until now was a header...
+ close OUT;
+ open(OUT,">$NEWMANI") ||
+ die "Can't recreate $NEWMANI";
+ next;
+ }
+ s/^\s*(\S+\s+)[0-9]*\s*(.*)/$1$2/;
+ print OUT;
+ print OUT "\n" unless /\n$/; # If no description
+ }
+ close IN;
+ close OUT;
+ }
+ else {
+die "You need to make a $NEWMANI file, with names and descriptions.\n";
+ }
+ }
+}
+
+# Perform ~name expansion ala ksh...
+# (banish csh from your vocabulary ;-)
+sub main'load_tilda_expand {
+ package main;
+ local($path) = @_;
+ return $path unless $path =~ /^~/;
+ $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e; # ~name
+ $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e; # ~
+ $path;
+}
+
+# Set up profile components into %Profile, add any profile-supplied options
+# into @ARGV and return the command invocation name.
+sub main'load_profile {
+ package main;
+ local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
+ local($me) = $0; # Command name
+ $me =~ s|.*/(.*)|$1|; # Keep only base name
+ return $me unless -s $profile;
+ local(*PROFILE); # Local file descriptor
+ local($options) = ''; # Options we get back from profile
+ unless (open(PROFILE, $profile)) {
+ warn "$me: cannot open $profile: $!\n";
+ return;
+ }
+ local($_);
+ local($component);
+ while (<PROFILE>) {
+ next if /^\s*#/; # Skip comments
+ next unless /^$me/o;
+ if (s/^$me://o) { # progname: options
+ chop;
+ $options .= $_; # Merge options if more than one line
+ }
+ elsif (s/^$me-([^:]+)://o) { # progname-component: value
+ $component = $1;
+ chop;
+ s/^\s+//; # Trim leading and trailing spaces
+ s/\s+$//;
+ $Profile{$component} = $_;
+ }
+ }
+ close PROFILE;
+ return unless $options;
+ require 'shellwords.pl';
+ local(@opts);
+ eval '@opts = &shellwords($options)'; # Protect against mismatched quotes
+ unshift(@ARGV, @opts);
+ return $me; # Return our invocation name
+}
+
+#
+# End of dataloading section.
+#
+
use warnings;
use Getopt::Long qw(:config bundling nopermute passthrough);
+my $opt_l = 0;
my $opt_w = 0;
GetOptions (
- "-w" => \$opt_w,
- ) or die "usage: metagrep [-w] pattern\n";
+ "w|word!" => \$opt_w,
+ "l|list!" => \$opt_l,
+ ) or die "usage: metagrep [-w] [-l] pattern\n";
use Cwd qw(getcwd abs_path);
use File::Find;
my $onmeta = $cwd =~ m{CPAN/meta[^/]+$} ? 1 : 0;
+my @dir = ($mcpath, "$mcpath/dist/U");
my %dir; # I don't want a file for which any path component symlinks
find (sub {
-l and return;
-d and $dir{$File::Find::name}++;
- }, $mcpath);
+ }, @dir);
print STDERR "<$pat>\n";
+my %seen;
find (sub {
-l and return;
-f or return;
exists $dir{$File::Find::dir} or return;
#print STDERR "$File::Find::dir - $_\n";
+ $File::Find::dir =~ m{^(?:$cwd/)?dist-3} and return;
+
open my $f, "<$_" or die "$File::Find::name: $!\n";
my $fnm = $File::Find::name;
$fnm =~ s{^$cwd/}{};
- print map { "$fnm:$_" } grep /$pat/, <$f>;
- }, $mcpath);
+ for (grep /$pat/, <$f>) {
+ if ($opt_l) {
+ $seen{$fnm}++ or print "$fnm\n";
+ next;
+ &nbs