lib/CPAN/FirstTime.pm Utility for creating CPAN config files
lib/CPAN/Nox.pm Runs CPAN while avoiding compiled extensions
lib/Carp.pm Error message base class
+lib/Carp/Heavy.pm Error message workhorse
lib/Class/Struct.pm Declare struct-like datatypes as Perl classes
lib/Cwd.pm Various cwd routines (getcwd, fastcwd, chdir)
lib/DB.pm Debugger API (draft)
# how to tr(anslate) newlines
TRNL = '$trnl'
-# this is where the sources are
-src = $src
-# this is src quoted for use in regexen
-srcqre = `echo $src|sed -e 's@^\.$@\\\.@' -e 's@^\./$@\\\./@' -e 's@^\.\./@\\\.\\\./@g`
-
-# nice makes grok this
-!GROK!THIS!
-if $test X. != X$src; then
-$spitshell >>Makefile <<!GROK!THIS!
-VPATH = .:$src
!GROK!THIS!
-else
-$spitshell >>Makefile <<!GROK!THIS!
-VPATH = .
-!GROK!THIS!
-fi
## In the following dollars and backticks do not need the extra backslash.
$spitshell >>Makefile <<'!NO!SUBS!'
FORCE:
@sh -c true
-miniperlmain$(OBJ_EXT): $(src)/miniperlmain.c
+miniperlmain$(OBJ_EXT): miniperlmain.c
$(CCCMD) $(PLDLFLAGS) $*.c
-perlmain.c: $(src)/miniperlmain.c config.sh $(FIRSTMAKEFILE)
+perlmain.c: miniperlmain.c config.sh $(FIRSTMAKEFILE)
sh writemain $(DYNALOADER) $(static_ext) > writemain.tmp
- sh $(src)/mv-if-diff writemain.tmp perlmain.c
+ sh mv-if-diff writemain.tmp perlmain.c
perlmain$(OBJ_EXT): perlmain.c
$(CCCMD) $(PLDLFLAGS) $*.c
miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL)
$(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) $(LLIBPERL) $(libs)
- $(LDLIBPTH) ./miniperl -w -Ilib -I$(src)/lib -MExporter -e 0 || $(MAKE) minitest
+ $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest
perl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs $(PERLEXPORT)
$(SHRPENV) $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
$(CCCMD) -DIAMSUID sperl.c
$(RMS) sperl.c
-lib:
- @sh ./makedir lib
-
# We have to call our ./makedir because Ultrix 4.3 make can't handle the line
# test -d lib/auto || mkdir lib/auto
#
preplibrary: miniperl lib/Config.pm $(plextract)
@sh ./makedir lib/auto
@echo " AutoSplitting perl library"
- $(LDLIBPTH) ./miniperl -Ilib -I$(src)/lib -e 'use AutoSplit; \
- autosplit_lib_modules(@ARGV)' $(src)/lib/*.pm $(src)/lib/*/*.pm
+ $(LDLIBPTH) ./miniperl -Ilib -e 'use AutoSplit; \
+ autosplit_lib_modules(@ARGV)' lib/*.pm lib/*/*.pm
# Take care to avoid modifying lib/Config.pm without reason
# (If trying to create a new port and having problems with the configpm script,
# try 'make minitest' and/or commenting out the tests at the end of configpm.)
-lib/Config.pm: lib config.sh miniperl configpm
+lib/Config.pm: config.sh miniperl configpm
$(LDLIBPTH) ./miniperl configpm configpm.tmp
- sh $(src)/mv-if-diff configpm.tmp $@
-
-lib/ExtUtils: lib
- @sh ./makedir lib/ExtUtils
+ sh mv-if-diff configpm.tmp $@
-lib/ExtUtils/Miniperl.pm: lib/ExtUtils miniperlmain.c miniperl minimod.pl lib/Config.pm
+lib/ExtUtils/Miniperl.pm: miniperlmain.c miniperl minimod.pl lib/Config.pm
$(LDLIBPTH) ./miniperl minimod.pl > minimod.tmp
- sh $(src)/mv-if-diff minimod.tmp $@
+ sh mv-if-diff minimod.tmp $@
-lib/re.pm: lib $(src)/ext/re/re.pm
+lib/re.pm: ext/re/re.pm
rm -f $@
- cat $(src)/ext/re/re.pm > $@
+ cat ext/re/re.pm > $@
-pod:
- @sh ./makedir pod
-
-$(plextract): pod miniperl lib/Config.pm lib/re.pm
- $(LDLIBPTH) ./miniperl -Ilib -I$(src)/lib $(src)/$@.PL
+$(plextract): miniperl lib/Config.pm lib/re.pm
+ $(LDLIBPTH) ./miniperl -Ilib $@.PL
install: all install.perl install.man
chmod 664 vms/perly_c.vms vms/perly_h.vms
perl vms/vms_yfix.pl perly.c perly.h vms/perly_c.vms vms/perly_h.vms
-perly$(OBJ_EXT): $(src)/perly.c
- $(CCCMD) $(PLDLFLAGS) $(src)/perly.c
-
# We don't want to regenerate perly.c and perly.h, but they might
# appear out-of-date after a patch is applied or a new distribution is
# made.
-perly.c: $(src)/perly.y
+perly.c: perly.y
-@sh -c true
-perly.h: $(src)/perly.y
+perly.h: perly.y
-@sh -c true
# No compat3.sym here since and including the 5.004_50.
# DynaLoader may be needed for extensions that use Makefile.PL.
$(DYNALOADER): miniperl preplibrary FORCE
- @$(LDLIBPTH) sh $(src)/ext/util/make_ext static $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
+ @$(LDLIBPTH) sh ext/util/make_ext static $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
d_dummy $(dynamic_ext): miniperl preplibrary $(DYNALOADER) FORCE
- @$(LDLIBPTH) sh $(src)/ext/util/make_ext dynamic $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
+ @$(LDLIBPTH) sh ext/util/make_ext dynamic $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
s_dummy $(static_ext): miniperl preplibrary $(DYNALOADER) FORCE
- @$(LDLIBPTH) sh $(src)/ext/util/make_ext static $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
+ @$(LDLIBPTH) sh ext/util/make_ext static $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
n_dummy $(nonxs_ext): miniperl preplibrary $(DYNALOADER) FORCE
- @$(LDLIBPTH) sh $(src)/ext/util/make_ext nonxs $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
+ @$(LDLIBPTH) sh ext/util/make_ext nonxs $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
clean: _tidy _mopup
cd x2p; $(MAKE) depend
# Cannot postpone this until $firstmakefile is ready ;-)
-makedepend: $(src)/makedepend.SH config.sh
- sh $(src)/makedepend.SH
+makedepend: makedepend.SH config.sh
+ sh ./makedepend.SH
# Cannot delegate rebuilding of t/perl to make to allow interlaced
# test and minitest
# Please *don't* use this unless all tests pass.
# If you want to report test failures, use "make nok" instead.
ok: utilities
- $(LDLIBPTH) ./perl -Ilib -I$(src)/lib utils/perlbug -ok -s '(UNINSTALLED)'
+ $(LDLIBPTH) ./perl -Ilib utils/perlbug -ok -s '(UNINSTALLED)'
okfile: utilities
- $(LDLIBPTH) ./perl -Ilib -I$(src)/lib utils/perlbug -ok -s '(UNINSTALLED)' -F perl.ok
+ $(LDLIBPTH) ./perl -Ilib utils/perlbug -ok -s '(UNINSTALLED)' -F perl.ok
nok: utilities
- $(LDLIBPTH) ./perl -Ilib -I$(src)/lib utils/perlbug -nok -s '(UNINSTALLED)'
+ $(LDLIBPTH) ./perl -Ilib utils/perlbug -nok -s '(UNINSTALLED)'
clist: $(c)
- echo $(c) | tr ' ' $(TRNL) | sed -e "s@^$(srcqre)/@@" >.clist
+ echo $(c) | tr ' ' $(TRNL) >.clist
hlist: $(h)
- echo $(h) | tr ' ' $(TRNL) | sed -e "s@^$(srcqre)/@@" >.hlist
+ echo $(h) | tr ' ' $(TRNL) >.hlist
shlist: $(sh)
- echo $(sh) | tr ' ' $(TRNL) | sed -e "s@^$(srcqre)/@@" >.shlist
+ echo $(sh) | tr ' ' $(TRNL) >.shlist
pllist: $(pl)
- echo $(pl) | tr ' ' $(TRNL) | sed -e "s@^$(srcqre)/@@" >.pllist
+ echo $(pl) | tr ' ' $(TRNL) >.pllist
Makefile: Makefile.SH ./config.sh
$(SHELL) Makefile.SH
-case $CONFIGDOTSH in
+case $CONFIG in
'')
if test -f config.sh; then TOP=.;
elif test -f ../config.sh; then TOP=..;
rm -f cflags
$spitshell >cflags <<!GROK!THIS!
$startsh
-src=$src
!GROK!THIS!
: In the following dollars and backticks do not need the extra backslash.
*) echo $n " $file.c $c" ;;
esac
- : allow for out-of-source experience
-
- if test "X$src" != X.; then
- ccflags="$ccflags -I$src -I."
- fi
-
: allow variables like toke_cflags to be evaluated
if echo $file | grep -v / >/dev/null
#!./miniperl -w
-# File::Spec?
my $config_pm = $ARGV[0] || 'lib/Config.pm';
-my $src = '.';
-# File::Dirname? File::Spec?
-if ($0 =~ m!^(?:(.+)/)configpm$!) {
- $src = $1;
- unshift @INC, "$1/lib";
-}
-# File::Spec?
-my $glossary = $ARGV[1] || "$src/Porting/Glossary";
+my $glossary = $ARGV[1] || 'Porting/Glossary';
@ARGV = "./config.sh";
# list names to put first (and hence lookup fastest)
print CONFIG "my \$summary = <<'!END!';\n";
-# File::Spec?
-my $myconfigdotSH =
- $src eq "." ? "myconfig.SH" : "$src/myconfig.SH";
-
-open(MYCONFIG,"<$myconfigdotSH") || die "open $myconfigdotSH failed: $!";
+open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
close(MYCONFIG);
makeargs=''
makeopts=''
-if test ! -d "$src/ext/$pname"; then
+if test ! -d "ext/$pname"; then
echo " Skipping $extspec (directory does not exist)"
exit 0 # not an error ?
fi
echo " Making $mname ($target)"
-mkdir ext 2>/dev/null
-mkdir ext/$pname 2>/dev/null
-if test ! -f ext/$pname/Makefile.PL; then
- cat $src/ext/$pname/Makefile.PL > ext/$pname/Makefile.PL
-fi
cd ext/$pname
# check link type and do any preliminaries
esac
if test ! -f $makefile ; then
- test -f Makefile.PL && ../$depth/miniperl -I../$depth/lib -I$src/lib Makefile.PL INSTALLDIRS=perl $passthru
+ test -f Makefile.PL && ../$depth/miniperl -I../$depth/lib Makefile.PL INSTALLDIRS=perl $passthru
fi
if test ! -f $makefile ; then
if test -f Makefile.SH; then
$dir =~ s#[\.\]]#/#g;
$_ = $dir . $name;
}
- autosplit_file("$_", "lib/auto",
+ autosplit_file("lib/$_", "lib/auto",
$Keep, $CheckForAutoloader, $CheckModTime);
}
0;
# each function call on the stack.
sub longmess {
- return @_ if ref $_[0];
- my $error = join '', @_;
- my $mess = "";
- my $i = 1 + $CarpLevel;
- my ($pack,$file,$line,$sub,$hargs,$eval,$require);
- my (@a);
- #
- # crawl up the stack....
- #
- while (do { { package DB; @a = caller($i++) } } ) {
- # get copies of the variables returned from caller()
- ($pack,$file,$line,$sub,$hargs,undef,$eval,$require) = @a;
- #
- # if the $error error string is newline terminated then it
- # is copied into $mess. Otherwise, $mess gets set (at the end of
- # the 'else {' section below) to one of two things. The first time
- # through, it is set to the "$error at $file line $line" message.
- # $error is then set to 'called' which triggers subsequent loop
- # iterations to append $sub to $mess before appending the "$error
- # at $file line $line" which now actually reads "called at $file line
- # $line". Thus, the stack trace message is constructed:
- #
- # first time: $mess = $error at $file line $line
- # subsequent times: $mess .= $sub $error at $file line $line
- # ^^^^^^
- # "called"
- if ($error =~ m/\n$/) {
- $mess .= $error;
- } else {
- # Build a string, $sub, which names the sub-routine called.
- # This may also be "require ...", "eval '...' or "eval {...}"
- if (defined $eval) {
- if ($require) {
- $sub = "require $eval";
- } else {
- $eval =~ s/([\\\'])/\\$1/g;
- if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
- substr($eval,$MaxEvalLen) = '...';
- }
- $sub = "eval '$eval'";
- }
- } elsif ($sub eq '(eval)') {
- $sub = 'eval {...}';
- }
- # if there are any arguments in the sub-routine call, format
- # them according to the format variables defined earlier in
- # this file and join them onto the $sub sub-routine string
- if ($hargs) {
- # we may trash some of the args so we take a copy
- @a = @DB::args; # must get local copy of args
- # don't print any more than $MaxArgNums
- if ($MaxArgNums and @a > $MaxArgNums) {
- # cap the length of $#a and set the last element to '...'
- $#a = $MaxArgNums;
- $a[$#a] = "...";
- }
- for (@a) {
- # set args to the string "undef" if undefined
- $_ = "undef", next unless defined $_;
- if (ref $_) {
- # dunno what this is for...
- $_ .= '';
- s/'/\\'/g;
- }
- else {
- s/'/\\'/g;
- # terminate the string early with '...' if too long
- substr($_,$MaxArgLen) = '...'
- if $MaxArgLen and $MaxArgLen < length;
- }
- # 'quote' arg unless it looks like a number
- $_ = "'$_'" unless /^-?[\d.]+$/;
- # print high-end chars as 'M-<char>' or '^<char>'
- s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
- s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
- }
- # append ('all', 'the', 'arguments') to the $sub string
- $sub .= '(' . join(', ', @a) . ')';
- }
- # here's where the error message, $mess, gets constructed
- $mess .= "\t$sub " if $error eq "called";
- $mess .= "$error at $file line $line";
- if (exists $main::{'Thread::'}) {
- my $tid = Thread->self->tid;
- $mess .= " thread $tid" if $tid;
- }
- $mess .= "\n";
- }
- # we don't need to print the actual error message again so we can
- # change this to "called" so that the string "$error at $file line
- # $line" makes sense as "called at $file line $line".
- $error = "called";
- }
- # this kludge circumvents die's incorrect handling of NUL
- my $msg = \($mess || $error);
- $$msg =~ tr/\0//d;
- $$msg;
+ require Carp::Heavy;
+ goto &longmess_heavy;
}
# you always get a stack trace
sub shortmess { # Short-circuit &longmess if called via multiple packages
- goto &longmess if $Verbose;
- return @_ if ref $_[0];
- my $error = join '', @_;
- my ($prevpack) = caller(1);
- my $extra = $CarpLevel;
- my $i = 2;
- my ($pack,$file,$line);
- # when reporting an error, we want to report it from the context of the
- # calling package. So what is the calling package? Within a module,
- # there may be many calls between methods and perhaps between sub-classes
- # and super-classes, but the user isn't interested in what happens
- # inside the package. We start by building a hash array which keeps
- # track of all the packages to which the calling package belongs. We
- # do this by examining its @ISA variable. Any call from a base class
- # method (one of our caller's @ISA packages) can be ignored
- my %isa = ($prevpack,1);
-
- # merge all the caller's @ISA packages into %isa.
- @isa{@{"${prevpack}::ISA"}} = ()
- if(@{"${prevpack}::ISA"});
-
- # now we crawl up the calling stack and look at all the packages in
- # there. For each package, we look to see if it has an @ISA and then
- # we see if our caller features in that list. That would imply that
- # our caller is a derived class of that package and its calls can also
- # be ignored
- while (($pack,$file,$line) = caller($i++)) {
- if(@{$pack . "::ISA"}) {
- my @i = @{$pack . "::ISA"};
- my %i;
- @i{@i} = ();
- # merge any relevant packages into %isa
- @isa{@i,$pack} = ()
- if(exists $i{$prevpack} || exists $isa{$pack});
- }
-
- # and here's where we do the ignoring... if the package in
- # question is one of our caller's base or derived packages then
- # we can ignore it (skip it) and go onto the next (but note that
- # the continue { } block below gets called every time)
- next
- if(exists $isa{$pack});
-
- # Hey! We've found a package that isn't one of our caller's
- # clan....but wait, $extra refers to the number of 'extra' levels
- # we should skip up. If $extra > 0 then this is a false alarm.
- # We must merge the package into the %isa hash (so we can ignore it
- # if it pops up again), decrement $extra, and continue.
- if ($extra-- > 0) {
- %isa = ($pack,1);
- @isa{@{$pack . "::ISA"}} = ()
- if(@{$pack . "::ISA"});
- }
- else {
- # OK! We've got a candidate package. Time to construct the
- # relevant error message and return it. die() doesn't like
- # to be given NUL characters (which $msg may contain) so we
- # remove them first.
- my $msg;
- $msg = "$error at $file line $line";
- if (exists $main::{'Thread::'}) {
- my $tid = Thread->self->tid;
- $mess .= " thread $tid" if $tid;
- }
- $msg .= "\n";
- $msg =~ tr/\0//d;
- return $msg;
- }
- }
- continue {
- $prevpack = $pack;
- }
-
- # uh-oh! It looks like we crawled all the way up the stack and
- # never found a candidate package. Oh well, let's call longmess
- # to generate a full stack trace. We use the magical form of 'goto'
- # so that this shortmess() function doesn't appear on the stack
- # to further confuse longmess() about it's calling package.
- goto &longmess;
+ require Carp::Heavy;
+ goto &shortmess_heavy;
}
--- /dev/null
+package Carp;
+# This package is heavily used. Be small. Be fast. Be good.
+
+# Comments added by Andy Wardley <abw@kfs.org> 09-Apr-98, based on an
+# _almost_ complete understanding of the package. Corrections and
+# comments are welcome.
+
+# longmess() crawls all the way up the stack reporting on all the function
+# calls made. The error string, $error, is originally constructed from the
+# arguments passed into longmess() via confess(), cluck() or shortmess().
+# This gets appended with the stack trace messages which are generated for
+# each function call on the stack.
+
+sub longmess_heavy {
+ return @_ if ref $_[0];
+ my $error = join '', @_;
+ my $mess = "";
+ my $i = 1 + $CarpLevel;
+ my ($pack,$file,$line,$sub,$hargs,$eval,$require);
+ my (@a);
+ #
+ # crawl up the stack....
+ #
+ while (do { { package DB; @a = caller($i++) } } ) {
+ # get copies of the variables returned from caller()
+ ($pack,$file,$line,$sub,$hargs,undef,$eval,$require) = @a;
+ #
+ # if the $error error string is newline terminated then it
+ # is copied into $mess. Otherwise, $mess gets set (at the end of
+ # the 'else {' section below) to one of two things. The first time
+ # through, it is set to the "$error at $file line $line" message.
+ # $error is then set to 'called' which triggers subsequent loop
+ # iterations to append $sub to $mess before appending the "$error
+ # at $file line $line" which now actually reads "called at $file line
+ # $line". Thus, the stack trace message is constructed:
+ #
+ # first time: $mess = $error at $file line $line
+ # subsequent times: $mess .= $sub $error at $file line $line
+ # ^^^^^^
+ # "called"
+ if ($error =~ m/\n$/) {
+ $mess .= $error;
+ } else {
+ # Build a string, $sub, which names the sub-routine called.
+ # This may also be "require ...", "eval '...' or "eval {...}"
+ if (defined $eval) {
+ if ($require) {
+ $sub = "require $eval";
+ } else {
+ $eval =~ s/([\\\'])/\\$1/g;
+ if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
+ substr($eval,$MaxEvalLen) = '...';
+ }
+ $sub = "eval '$eval'";
+ }
+ } elsif ($sub eq '(eval)') {
+ $sub = 'eval {...}';
+ }
+ # if there are any arguments in the sub-routine call, format
+ # them according to the format variables defined earlier in
+ # this file and join them onto the $sub sub-routine string
+ if ($hargs) {
+ # we may trash some of the args so we take a copy
+ @a = @DB::args; # must get local copy of args
+ # don't print any more than $MaxArgNums
+ if ($MaxArgNums and @a > $MaxArgNums) {
+ # cap the length of $#a and set the last element to '...'
+ $#a = $MaxArgNums;
+ $a[$#a] = "...";
+ }
+ for (@a) {
+ # set args to the string "undef" if undefined
+ $_ = "undef", next unless defined $_;
+ if (ref $_) {
+ # dunno what this is for...
+ $_ .= '';
+ s/'/\\'/g;
+ }
+ else {
+ s/'/\\'/g;
+ # terminate the string early with '...' if too long
+ substr($_,$MaxArgLen) = '...'
+ if $MaxArgLen and $MaxArgLen < length;
+ }
+ # 'quote' arg unless it looks like a number
+ $_ = "'$_'" unless /^-?[\d.]+$/;
+ # print high-end chars as 'M-<char>'
+ s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+ # print remaining control chars as ^<char>
+ s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+ }
+ # append ('all', 'the', 'arguments') to the $sub string
+ $sub .= '(' . join(', ', @a) . ')';
+ }
+ # here's where the error message, $mess, gets constructed
+ $mess .= "\t$sub " if $error eq "called";
+ $mess .= "$error at $file line $line";
+ if (exists $main::{'Thread::'}) {
+ my $tid = Thread->self->tid;
+ $mess .= " thread $tid" if $tid;
+ }
+ $mess .= "\n";
+ }
+ # we don't need to print the actual error message again so we can
+ # change this to "called" so that the string "$error at $file line
+ # $line" makes sense as "called at $file line $line".
+ $error = "called";
+ }
+ # this kludge circumvents die's incorrect handling of NUL
+ my $msg = \($mess || $error);
+ $$msg =~ tr/\0//d;
+ $$msg;
+}
+
+
+# shortmess() is called by carp() and croak() to skip all the way up to
+# the top-level caller's package and report the error from there. confess()
+# and cluck() generate a full stack trace so they call longmess() to
+# generate that. In verbose mode shortmess() calls longmess() so
+# you always get a stack trace
+
+sub shortmess_heavy { # Short-circuit &longmess if called via multiple packages
+ goto &longmess_heavy if $Verbose;
+ return @_ if ref $_[0];
+ my $error = join '', @_;
+ my ($prevpack) = caller(1);
+ my $extra = $CarpLevel;
+ my $i = 2;
+ my ($pack,$file,$line);
+ # when reporting an error, we want to report it from the context of the
+ # calling package. So what is the calling package? Within a module,
+ # there may be many calls between methods and perhaps between sub-classes
+ # and super-classes, but the user isn't interested in what happens
+ # inside the package. We start by building a hash array which keeps
+ # track of all the packages to which the calling package belongs. We
+ # do this by examining its @ISA variable. Any call from a base class
+ # method (one of our caller's @ISA packages) can be ignored
+ my %isa = ($prevpack,1);
+
+ # merge all the caller's @ISA packages into %isa.
+ @isa{@{"${prevpack}::ISA"}} = ()
+ if(@{"${prevpack}::ISA"});
+
+ # now we crawl up the calling stack and look at all the packages in
+ # there. For each package, we look to see if it has an @ISA and then
+ # we see if our caller features in that list. That would imply that
+ # our caller is a derived class of that package and its calls can also
+ # be ignored
+ while (($pack,$file,$line) = caller($i++)) {
+ if(@{$pack . "::ISA"}) {
+ my @i = @{$pack . "::ISA"};
+ my %i;
+ @i{@i} = ();
+ # merge any relevant packages into %isa
+ @isa{@i,$pack} = ()
+ if(exists $i{$prevpack} || exists $isa{$pack});
+ }
+
+ # and here's where we do the ignoring... if the package in
+ # question is one of our caller's base or derived packages then
+ # we can ignore it (skip it) and go onto the next (but note that
+ # the continue { } block below gets called every time)
+ next
+ if(exists $isa{$pack});
+
+ # Hey! We've found a package that isn't one of our caller's
+ # clan....but wait, $extra refers to the number of 'extra' levels
+ # we should skip up. If $extra > 0 then this is a false alarm.
+ # We must merge the package into the %isa hash (so we can ignore it
+ # if it pops up again), decrement $extra, and continue.
+ if ($extra-- > 0) {
+ %isa = ($pack,1);
+ @isa{@{$pack . "::ISA"}} = ()
+ if(@{$pack . "::ISA"});
+ }
+ else {
+ # OK! We've got a candidate package. Time to construct the
+ # relevant error message and return it. die() doesn't like
+ # to be given NUL characters (which $msg may contain) so we
+ # remove them first.
+ my $msg;
+ $msg = "$error at $file line $line";
+ if (exists $main::{'Thread::'}) {
+ my $tid = Thread->self->tid;
+ $mess .= " thread $tid" if $tid;
+ }
+ $msg .= "\n";
+ $msg =~ tr/\0//d;
+ return $msg;
+ }
+ }
+ continue {
+ $prevpack = $pack;
+ }
+
+ # uh-oh! It looks like we crawled all the way up the stack and
+ # never found a candidate package. Oh well, let's call longmess
+ # to generate a full stack trace. We use the magical form of 'goto'
+ # so that this shortmess() function doesn't appear on the stack
+ # to further confuse longmess() about it's calling package.
+ goto &longmess_heavy;
+}
+
+1;
#
MAKE=$make
trnl='$trnl'
-src=$src
!GROK!THIS!
$spitshell >>makedepend <<'!NO!SUBS!'
# This script should be called with
-# sh ./makedepend MAKE=$(MAKE) [src=$(src)]
+# sh ./makedepend MAKE=$(MAKE)
case "$1" in
- MAKE=*) eval $1 ; shift ;;
+ MAKE=*) eval $1 ;;
esac
export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh \$0; kill \$\$)
;;
esac
-case "$1" in
- src=*) eval $1 ; shift ;;
-esac
-
# We need .. when we are in the x2p directory if we are using the
# cppstdin wrapper script.
# Put .. and . first so that we pick up the present cppstdin, not
: might be identical
$test -d UU || mkdir UU
-$MAKE clist || (cd $src; $echo "Searching for .c files..."; \
- $echo *.c | $tr ' ' $trnl | $egrep -v '\*') >.clist
-for base in `$cat .clist`; do
- case "$src" in
- .) file="$base" ;;
- *) if test -f "$base"; then
- file="$base"
- elif test -f "$src/$base"; then
- file="$src/$base"
- fi
- ;;
- esac
+$MAKE clist || ($echo "Searching for .c files..."; \
+ $echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist)
+for file in `$cat .clist`; do
# for file in `cat /dev/null`; do
if [ "$osname" = uwin ]; then
uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g"
fi
fi
case "$file" in
+ *.c) filebase=`basename $file .c` ;;
+ *.y) filebase=`basename $file .y` ;;
+ esac
+ case "$file" in
*/*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;;
*) finc= ;;
esac
- case "$src" in
- '') ;;
- *) finc="-I$src" ;;
- esac
- basebase=`basename $base .c`
- $echo "Finding dependencies for $basebase$_o."
+ $echo "Finding dependencies for $filebase$_o."
( $echo "#line 1 \"$file\""; \
$sed -n <$file \
-e "/^${filebase}_init(/q" \
-e 's|/\*.*$||' \
-e 's|\\$||' \
-e p \
- -e '}' ) >UU/$base.c
- $cppstdin $finc -I. $cppflags $cppminus <UU/$base.c |
+ -e '}' ) >UU/$file.c
+ $cppstdin $finc -I. $cppflags $cppminus <UU/$file.c |
$sed \
-e '/^#.*<stdin>/d' \
-e '/^#.*"-"/d' \
-e 's#\.[0-9][0-9]*\.c#'"$file.c#" \
-e 's/^[ ]*#[ ]*line/#/' \
-e '/^# *[0-9][0-9]* *[".\/]/!d' \
- -e 's/^.*"\(.*\)".*$/'$base'\$(OBJ_EXT): \1/' \
- -e 's/^# *[0-9][0-9]* \(.*\)$/'$base'\$(OBJ_EXT): \1/' \
+ -e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \
+ -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \
-e 's|: \./|: |' \
-e 's|\.c\.c|.c|' $uwinfix | \
$uniq | $sort | $uniq >> .deptmp
$sed <$mf >$mf.new -e '1,/^# AUTOMATICALLY/!d'
-$MAKE shlist || (cd $src; $echo "Searching for .SH files..."; \
- $echo *.SH | $tr ' ' $trnl | $egrep -v '\*') >.shlist
+$MAKE shlist || ($echo "Searching for .SH files..."; \
+ $echo *.SH | $tr ' ' $trnl | $egrep -v '\*' >.shlist)
# Now extract the dependencies on makedepend.SH and Makefile.SH
# (they should reside in the main Makefile):
$sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \
>>$mf.new
else
- $MAKE hlist || (cd $src; $echo "Searching for .h files..."; \
- $echo *.h | $tr ' ' $trnl | $egrep -v '\*') >.hlist
+ $MAKE hlist || ($echo "Searching for .h files..."; \
+ $echo *.h | $tr ' ' $trnl | $egrep -v '\*' >.hlist)
$echo "You don't seem to have a proper C preprocessor. Using grep instead."
$egrep '^#include ' `cat .clist` `cat .hlist` >.deptmp
$echo "Updating $mf..."
use Config;
use File::Basename qw(&basename &dirname);
+use Cwd;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
# $startperl
# to ensure Configure will look for $Config{startperl}.
-$file = basename($0);
-$file =~ s/\.PL$//i;
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+$origdir = cwd;
+chdir dirname($0);
+$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';
-chdir("pod") or die "Can't chdir to pod: $!";
open OUT,">$file" or die "Can't create $file: $!";
print "Extracting $file (with variable substitutions)\n";
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
-
+chdir $origdir;
use Config;
use File::Basename qw(&basename &dirname);
+use Cwd;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
# $startperl
# to ensure Configure will look for $Config{startperl}.
-$file = basename($0);
-$file =~ s/\.PL$//i;
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+$origdir = cwd;
+chdir dirname($0);
+$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';
-chdir("pod") or die "Can't chdir to pod: $!";
open OUT,">$file" or die "Can't create $file: $!";
print "Extracting $file (with variable substitutions)\n";
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;
use Config;
use File::Basename qw(&basename &dirname);
+use Cwd;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
# $man3ext
# to ensure Configure will look for $Config{startperl}.
-$file = basename($0);
-$file =~ s/\.PL$//i;
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+$origdir = cwd;
+chdir dirname($0);
+$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';
-chdir("pod") or die "Can't chdir to pod: $!";
open OUT,">$file" or die "Can't create $file: $!";
print "Extracting $file (with variable substitutions)\n";
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;
use Config;
use File::Basename qw(&basename &dirname);
+use Cwd;
# List explicitly here the variables you want Configure to
# generate. Metaconfig only looks for shell variables, so you
# $startperl
# to ensure Configure will look for $Config{startperl}.
-$file = basename($0);
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+$origdir = cwd;
+chdir dirname($0);
$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';
-chdir("pod") or die "Can't chdir to pod: $!";
open OUT,">$file" or die "Can't create $file: $!";
print "Extracting $file (with variable substitutions)\n";
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;
# $startperl
# to ensure Configure will look for $Config{startperl}.
-$file = basename($0);
-$file =~ s/\.PL$//i;
-$file .= '.com' if $^O eq 'VMS';
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+ if ($^O eq 'VMS' or $^O eq 'os2'); # "case-forgiving"
-chdir("pod") or die "Can't chdir to pod: $!";
open OUT,">$file" or die "Can't create $file: $!";
print "Extracting $file (with variable substitutions)\n";
# $startperl
# to ensure Configure will look for $Config{startperl}.
-$file = basename($0);
-$file =~ s/\.PL$//i;
-$file .= '.com' if $^O eq 'VMS';
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+ if ($^O eq 'VMS' or $^O eq 'os2'); # "case-forgiving"
-chdir("pod") or die "Can't chdir to pod: $!";
open OUT,">$file" or die "Can't create $file: $!";
print "Extracting $file (with variable substitutions)\n";
# $startperl
# to ensure Configure will look for $Config{startperl}.
-$file = basename($0);
-$file =~ s/\.PL$//i;
-$file .= '.com' if $^O eq 'VMS';
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+ if ($^O eq 'VMS' or $^O eq 'os2'); # "case-forgiving"
-chdir("pod") or die "Can't chdir to pod: $!";
open OUT,">$file" or die "Can't create $file: $!";
print "Extracting $file (with variable substitutions)\n";
rm -f writemain
$spitshell >writemain <<!GROK!THIS!
$startsh
-src=$src
!GROK!THIS!
: In the following dollars and backticks do not need the extra backslash.
done
-sed '/Do not delete this line--writemain depends on it/q' $src/miniperlmain.c
+sed '/Do not delete this line--writemain depends on it/q' miniperlmain.c
if test X"$args" != "X" ; then
.SUFFIXES: .c \$(OBJ_EXT)
-# this is where the sources are
-src = $src
-
-# nice makes grok this
-#VPATH = .:$src
-
!GROK!THIS!
cat >>Makefile <<'!NO!SUBS!'
addedbyconf = $(shextract) $(plextract)
-h = EXTERN.h INTERN.h ../config.h handy.h hash.h a2p.h str.h util.h
+h = EXTERN.h INTERN.h ../config.h ../handy.h hash.h a2p.h str.h util.h
-c = hash.c str.c util.c walk.c
+c = hash.c $(mallocsrc) str.c util.c walk.c
obj = hash$(OBJ_EXT) $(mallocobj) str$(OBJ_EXT) util$(OBJ_EXT) walk$(OBJ_EXT)
lint $(lintflags) $(defs) $(c) > a2p.fuzz
depend: $(mallocsrc) ../makedepend
- sh ../makedepend MAKE=$(MAKE) src=$(src)/x2p
+ sh ../makedepend MAKE=$(MAKE)
clist:
echo $(c) | tr ' ' $(TRNL) >.clist
projects / p5sagit/p5-mst-13.2.git / commitdiff