if (!do_undump) {
my_perl = perl_alloc();
if (!my_perl)
+#ifdef VMS
+ exit(vaxc$errno);
+#else
exit(1);
+#endif
perl_construct( my_perl );
}
#endif
if (!fp) {
perror(argv[1]);
+#ifdef VMS
+ exit(vaxc$errno);
+#else
exit(1);
+#endif
}
argv++;
argc--;
my($self) = @_;
my($name, %dir, %xs, %c, %h, %ignore, %pl_files, %manifypods);
local(%pm); #the sub in find() has to see this hash
- $ignore{'test.pl'} = 1;
+ @ignore{qw(Makefile.PL test.pl)} = (1,1);
$ignore{'makefile.pl'} = 1 if $Is_VMS;
foreach $name ($self->lsdir($self->curdir)){
next if $name =~ /\#/;
unless $name =~ m/perlmain\.c/; # See MAP_TARGET
} elsif ($name =~ /\.h$/i){
$h{$name} = 1;
+ } elsif ($name =~ /\.PL$/) {
+ ($pl_files{$name} = $name) =~ s/\.PL$// ;
+ } elsif ($Is_VMS && $name =~ /\.pl$/) { # case-insensitive filesystem
+ local($/); open(PL,$name); my $txt = <PL>; close PL;
+ if ($txt =~ /Extracting \S+ \(with variable substitutions/) {
+ ($pl_files{$name} = $name) =~ s/\.pl$// ;
+ }
+ else { $pm{$name} = $self->catfile('$(INST_LIBDIR)',$name); }
} elsif ($name =~ /\.(p[ml]|pod)$/){
$pm{$name} = $self->catfile('$(INST_LIBDIR)',$name);
- } elsif ($name =~ /\.PL$/ && $name ne "Makefile.PL") {
- ($pl_files{$name} = $name) =~ s/\.PL$// ;
- } elsif ($Is_VMS && $name =~ /\.pl$/ && $name ne 'makefile.pl' &&
- $name ne 'test.pl') { # case-insensitive filesystem
- ($pl_files{$name} = $name) =~ s/\.pl$// ;
}
}
$modfname = &DynaLoader::mod2fname(\@modparts);
}
- ($self->{PARENT_NAME}, $self->{BASEEXT}) = $self->{NAME} =~ m!([\w:]+::)?(\w+)$! ;
+ ($self->{PARENT_NAME}, $self->{BASEEXT}) = $self->{NAME} =~ m!(?:([\w:]+)::)?(\w+)$! ;
if (defined &DynaLoader::mod2fname) {
# As of 5.001m, dl_os2 appends '_'
use File::Basename;
use vars qw($Revision);
-$Revision = '5.3901 (6-Mar-1997)';
+$Revision = '5.42 (31-Mar-1997)';
unshift @MM::ISA, 'ExtUtils::MM_VMS';
overrunning DCL's command buffer when MM[KS] is running.
If optional second argument has a TRUE value, then the return string is
-a VMS-syntax directory specification, otherwise it is a VMS-syntax file
-specification.
+a VMS-syntax directory specification, if it is FALSE, the return string
+is a VMS-syntax file specification, and if it is not specified, fixpath()
+checks to see whether it matches the name of a directory in the current
+default directory, and returns a directory or file specification accordingly.
=cut
$fixedpath = $path;
$fixedpath = vmspath($fixedpath) if $force_path;
}
- # Convert names without directory or type to paths
- if (!$force_path and $fixedpath !~ /[:>(.\]]/) { $fixedpath = vmspath($fixedpath); }
+ # No hints, so we try to guess
+ if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) {
+ $fixedpath = vmspath($fixedpath) if -d $fixedpath;
+ }
# Trim off root dirname if it's had other dirs inserted in front of it.
$fixedpath =~ s/\.000000([\]>])/$1/;
print "fixpath($path) = |$fixedpath|\n" if $Verbose >= 3;
}
foreach $name (@snames){
if ($name !~ m![/:>\]]!) { push(@cand,$self->catfile($dir,$name)); }
- else { push(@cand,$self->fixpath($name)); }
+ else { push(@cand,$self->fixpath($name,0)); }
}
}
foreach $name (@cand) {
if ($self->{OBJECT} =~ /\s/) {
$self->{OBJECT} =~ s/(\\)?\n+\s+/ /g;
- $self->{OBJECT} = $self->wraplist(map($self->fixpath($_),split(/,?\s+/,$self->{OBJECT})));
+ $self->{OBJECT} = $self->wraplist(map($self->fixpath($_,0),split(/,?\s+/,$self->{OBJECT})));
}
- $self->{LDFROM} = $self->wraplist(map($self->fixpath($_),split(/,?\s+/,$self->{LDFROM})));
+ $self->{LDFROM} = $self->wraplist(map($self->fixpath($_,0),split(/,?\s+/,$self->{LDFROM})));
# Fix up directory specs
# Fix up file specs
foreach $macro ( qw[LIBPERL_A FIRST_MAKEFILE MAKE_APERL_FILE MYEXTLIB] ) {
next unless defined $self->{$macro};
- $self->{$macro} = $self->fixpath($self->{$macro});
+ $self->{$macro} = $self->fixpath($self->{$macro},0);
}
foreach $macro (qw/
FULLEXT VERSION_FROM OBJECT LDFROM
/ ) {
next unless defined $self->{$tmp};
- push @m, "$tmp = ",$self->fixpath($self->{$tmp}),"\n";
+ push @m, "$tmp = ",$self->fixpath($self->{$tmp},0),"\n";
}
for $tmp (qw/
next unless defined $self->{$tmp};
my(%tmp,$key);
for $key (keys %{$self->{$tmp}}) {
- $tmp{$self->fixpath($key)} = $self->fixpath($self->{$tmp}{$key});
+ $tmp{$self->fixpath($key,0)} = $self->fixpath($self->{$tmp}{$key},0);
}
$self->{$tmp} = \%tmp;
}
next unless defined $self->{$tmp};
my(@tmp,$val);
for $val (@{$self->{$tmp}}) {
- push(@tmp,$self->fixpath($val));
+ push(@tmp,$self->fixpath($val,0));
}
$self->{$tmp} = \@tmp;
}
warn "Typemap $typemap not found.\n";
}
else{
- push(@tmdeps, $self->fixpath($typemap));
+ push(@tmdeps, $self->fixpath($typemap,0));
}
}
}
}
-# sub installpm_x { # called by installpm perl file
-# my($self, $dist, $inst, $splitlib) = @_;
-# if ($inst =~ m!#!) {
-# warn "Warning: MM[SK] would have problems processing this file: $inst, SKIPPED\n";
-# return '';
-# }
-# $inst = $self->fixpath($inst);
-# $dist = $self->fixpath($dist);
-# my($instdir) = $inst =~ /([^\)]+\))[^\)]*$/ ? $1 : dirname($inst);
-# my(@m);
-#
-# push(@m, "
-# $inst : $dist \$(MAKEFILE) ${instdir}.exists \$(INST_ARCHAUTODIR).exists
-# ",' $(NOECHO) $(RM_F) $(MMS$TARGET)
-# $(NOECHO) $(CP) ',"$dist $inst",'
-# $(CHMOD) 644 $(MMS$TARGET)
-# ');
-# push(@m, ' $(AUTOSPLITFILE) $(MMS$TARGET) ',
-# $self->catdir($splitlib,'auto')."\n\n")
-# if ($splitlib and $inst =~ /\.pm$/);
-# push(@m,$self->dir_target($instdir));
-#
-# join('',@m);
-# }
-
=item manifypods (override)
Use VMS-style quoting on command line, and VMS logical name
if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
push(@otherfiles, @{$self->{$key}});
}
- else { push(@otherfiles, $attribs{FILES}); }
+ else { push(@otherfiles, $word); }
}
}
push(@otherfiles, qw[ blib $(MAKE_APERL_FILE) extralibs.ld perlmain.c pm_to_blib.ts ]);
if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
push(@allfiles, @{$self->{$key}});
}
- else { push(@allfiles, $attribs{FILES}); }
+ else { push(@allfiles, $word); }
}
$line = '';
# Occasionally files are repeated several times from different sources
Set Default $(PERL_SRC)
$(MMS)],$mmsquals,);
if ($self->{PERL_ARCHLIB} =~ m|\[-| && $self->{PERL_SRC} =~ m|(\[-+)|) {
- my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm'));
+ my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm',0));
$target =~ s/\Q$prefix/[/;
push(@m," $target");
}
]);
}
- push(@m, join(" ", map($self->fixpath($_),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n")
+ push(@m, join(" ", map($self->fixpath($_,0),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n")
if %{$self->{XS}};
join('',@m);
push @m, '
# Fill in the target you want to produce if it\'s not perl
-MAP_TARGET = ',$self->fixpath($target),'
-MAP_SHRTARGET = ',$self->fixpath($shrtarget),"
+MAP_TARGET = ',$self->fixpath($target,0),'
+MAP_SHRTARGET = ',$self->fixpath($shrtarget,0),"
MAP_LINKCMD = $linkcmd
MAP_PERLINC = ", $perlinc ? map('"$_" ',@{$perlinc}) : '','
# We use the linker options files created with each extension, rather than
MAP_STATIC = ',@staticopts ? join(' ', @staticopts) : '','
MAP_OPTS = ',@staticopts ? ','.join(',', map($_.'/Option', @staticopts)) : '',"
MAP_EXTRA = $extralist
-MAP_LIBPERL = ",$self->fixpath($libperl),'
+MAP_LIBPERL = ",$self->fixpath($libperl,0),'
';
if ($_[0] =~ /$nextpat/) {
*S = shift;
}
- print S @_;
+
+ local $out = join $, , @_;
+ syswrite(S, $out, length $out);
if( $chat'debug ){
print STDERR "printed:";
print STDERR @_;
if (euid != uid || egid != gid)
croak("No -e allowed in setuid scripts");
if (!e_fp) {
-#ifdef HAS_UMASK
+#if defined(HAS_UMASK) && !defined(VMS)
int oldumask = PerlLIO_umask(0177);
#endif
e_tmpname = savepv(TMPPATH);
#endif
if (!e_fp)
croak("Cannot create temporary file \"%s\"", e_tmpname);
-#ifdef HAS_UMASK
+#if defined(HAS_UMASK) && !defined(VMS)
(void)PerlLIO_umask(oldumask);
#endif
}
}
[..normal %ENV behavior here..]
+It's also worth taking a moment to explain what happens when you
+localize a member of a composite type (i.e. an array or hash element).
+In this case, the element is localized I<by name>. This means that
+when the scope of the C<local()> ends, the saved value will be
+restored to the hash element whose key was named in the C<local()>, or
+the array element whose index was named in the C<local()>. If that
+element was deleted while the C<local()> was in effect (e.g. by a
+C<delete()> from a hash or a C<shift()> of an array), it will spring
+back into existence, possibly extending an array and filling in the
+skipped elements with C<undef>. For instance, if you say
+
+ %hash = ( 'This' => 'is', 'a' => 'test' );
+ @ary = ( 0..5 );
+ {
+ local($ary[5]) = 6;
+ local($hash{'a'}) = 'drill';
+ while (my $e = pop(@ary)) {
+ print "$e . . .\n";
+ last unless $e > 3;
+ }
+ if (@ary) {
+ $hash{'only a'} = 'test';
+ delete $hash{'a'};
+ }
+ }
+ print join(' ', map { "$_ $hash{$_}" } sort keys %hash),".\n";
+ print "The array has ",scalar(@ary)," elements: ",
+ join(', ', map { defined $_ ? $_ : 'undef' } @ary),"\n";
+
+Perl will print
+
+ 6 . . .
+ 4 . . .
+ 3 . . .
+ This is a test only a test.
+ The array has 6 elements: 0, 1, 2, undef, undef, 5
+
+In short, be careful when manipulating the containers for composite types
+whose elements have been localized.
=head2 Passing Symbol Table Entries (typeglobs)
* Version: 5.005
*/
-/* Configuration time: 7-Mar-1998 16:30
+/* Configuration time: 4-Apr-1998 21:30
* Configured by: Charles Bailey bailey@newman.upenn.edu
* Target system: VMS
*/
* when Perl is built. Please do not change it by hand; make
* any changes to FndVers.Com instead.
*/
-#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00463" /**/
+#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00464" /**/
#define ARCHLIB ARCHLIB_EXP /*config-skip*/
# define LONG_DOUBLESIZE 8 /**/
#endif
+/* LONGLONGSIZE:
+ * This symbol contains the size of a long long, so that the
+ * C preprocessor can make decisions based on it. It is only
+ * defined if the system supports long long.
+ */
+#undef HAS_LONG_LONG /**/
+#ifdef HAS_LONG_LONG
+#define LONGLONGSIZE 8 /**/
+#endif
+
/* HAS_MKSTEMP:
* This symbol, if defined, indicates that the mkstemp routine is
* available to create and open a unique temporary file.
*/
#define HAS_ENDSERVENT /*config-skip*/
+/* HAS_GETHOST_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for gethostent(), gethostbyname(), and
+ * gethostbyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
+ */
+#define HAS_GETHOST_PROTOS /*config-skip*/
+
+/* HAS_GETNET_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for getnetent(), getnetbyname(), and
+ * getnetbyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
+ */
+#define HAS_GETNET_PROTOS /*config-skip*/
+
+/* HAS_GETPROTO_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for getprotoent(), getprotobyname(), and
+ * getprotobyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
+ */
+#define HAS_GETPROTO_PROTOS /*config-skip*/
+
+/* HAS_GETSERV_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for getservent(), getservbyname(), and
+ * getservbyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
+ */
+#define HAS_GETSERV_PROTOS /*config-skip*/
+
#else /* VMS_DO_SOCKETS */
#undef HAS_SOCKET /*config-skip*/
#undef HAS_GETSERVENT /*config-skip*/
#undef HAS_SETSERVENT /*config-skip*/
#undef HAS_ENDSERVENT /*config-skip*/
+#undef HAS_GETHOST_PROTOS /*config-skip*/
+#undef HAS_GETNET_PROTOS /*config-skip*/
+#undef HAS_GETPROTO_PROTOS /*config-skip*/
+#undef HAS_GETSERV_PROTOS /*config-skip*/
#endif /* !VMS_DO_SOCKETS */
.endif
base : miniperl perl
@ $(NOOP)
-extras : Fcntl IO Opcode attrs Stdio DCLSym B $(POSIX) $(THREAD) SDBM_File libmods utils podxform
+extras : Fcntl IO Opcode attrs Stdio DCLsym B $(POSIX) $(THREAD) SDBM_File libmods utils podxform
@ $(NOOP)
libmods : $(LIBPREREQ)
@ $(NOOP)
[.ext.Fcntl]Descrip.MMS : [.ext.Fcntl]Makefile.PL $(LIBPREREQ) $(DBG)perlshr$(E)
$(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Fcntl]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]"
-Stdio : [.lib.vms]Stdio.pm [.lib.auto.vms.Stdio]Stdio$(E)
+Stdio : [.lib.vms]Stdio.pm [.lib.auto.vms.Stdio]Stdio$(E) [.t.lib]vms_stdio.t
@ $(NOOP)
[.lib.vms]Stdio.pm : [.vms.ext.stdio]Descrip.MMS
$(MMS)
@ Set Default [---]
+[.t.lib]vms_stdio.t : [.vms.ext.Stdio]test.pl
+ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir>
# ${@} necessary to distract different versions of MM[SK]/make
[.vms.ext.stdio]Descrip.MMS : [.vms.ext.Stdio]Makefile.PL $(LIBPREREQ) $(DBG)perlshr$(E)
$(MINIPERL) "-I[---.lib]" -e "chdir('[.vms.ext.Stdio]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[---.lib]" "INST_ARCHLIB=[---.lib]"
-DCLSym : [.lib.vms]DCLSym.pm [.lib.auto.vms.DCLSym]DCLSym$(E)
+DCLsym : [.lib.vms]DCLsym.pm [.lib.auto.vms.DCLsym]DCLsym$(E) [.t.lib]vms_dclsym.t
@ $(NOOP)
-[.lib.vms]DCLSym.pm : [.vms.ext.dclsym]Descrip.MMS
+[.lib.vms]DCLsym.pm : [.vms.ext.dclsym]Descrip.MMS
@ If F$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto]
- @ Set Default [.vms.ext.DCLSym]
+ @ Set Default [.vms.ext.DCLsym]
$(MMS)
@ Set Default [---]
-[.lib.auto.vms.DCLSym]DCLSym$(E) : [.vms.ext.DCLSym]Descrip.MMS
- @ Set Default [.vms.ext.DCLSym]
+[.lib.auto.vms.DCLsym]DCLsym$(E) : [.vms.ext.DCLsym]Descrip.MMS
+ @ Set Default [.vms.ext.DCLsym]
$(MMS)
@ Set Default [---]
+[.t.lib]vms_dclsym.t : [.vms.ext.DCLsym]test.pl
+ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir>
# ${@} necessary to distract different versions of MM[SK]/make
-[.vms.ext.DCLSym]Descrip.MMS : [.vms.ext.DCLSym]Makefile.PL $(LIBPREREQ) $(DBG)perlshr$(E)
- $(MINIPERL) "-I[---.lib]" -e "chdir('[.vms.ext.DCLSym]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[---.lib]" "INST_ARCHLIB=[---.lib]"
+[.vms.ext.DCLsym]Descrip.MMS : [.vms.ext.DCLsym]Makefile.PL $(LIBPREREQ) $(DBG)perlshr$(E)
+ $(MINIPERL) "-I[---.lib]" -e "chdir('[.vms.ext.DCLsym]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[---.lib]" "INST_ARCHLIB=[---.lib]"
attrs : [.lib]attrs.pm [.lib.auto.attrs]attrs$(E)
@ $(NOOP)
- $(MMS) clean
Set Default [--]
.endif
- Set Default [.ext.SDBM_File]
- - $(MMS) clean
- Set Default [--]
+ Set Default [.ext.SDBM_File]
+ - $(MMS) clean
+ Set Default [--]
+ Set Default [.vms.ext.Stdio]
+ - $(MMS) clean
+ Set Default [---]
+ Set Default [.vms.ext.DCLsym]
+ - $(MMS) clean
+ Set Default [---]
- If F$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*/Exclude=PerlShr_*.Opt
- If F$Search("[...]*$(O);*") .nes."" Then Delete/NoConfirm/Log [...]*$(O);*
- If F$Search("Config.H").nes."" Then Delete/NoConfirm/Log Config.H;*
- $(MMS) realclean
Set Default [--]
.endif
- Set Default [.ext.SDBM_File]
- - $(MMS) realclean
- Set Default [--]
+ Set Default [.ext.SDBM_File]
+ - $(MMS) realclean
+ Set Default [--]
+ Set Default [.vms.ext.Stdio]
+ - $(MMS) clean
+ Set Default [---]
+ Set Default [.vms.ext.DCLsym]
+ - $(MMS) clean
+ Set Default [---]
- If F$Search("*$(OLB)").nes."" Then Delete/NoConfirm/Log *$(OLB);*
- If F$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*
- $(MINIPERL) -e "use File::Path; rmtree(['lib/auto','lib/VMS','lib/$(ARCH)'],1,0);"
print OUT "netdb_name_type=",$dosock ? "'char *'\n" : "'undef'\n";
print OUT "netdb_host_type=",$dosock ? "'char *'\n" : "'undef'\n";
print OUT "netdb_hlen_type=",$dosock ? "'int'\n" : "'undef'\n";
+ print OUT "d_gethostprotos=",$dosock ? "'define'\n" : "'undef'\n";
+ print OUT "d_getnetprotos=",$dosock ? "'define'\n" : "'undef'\n";
+ print OUT "d_getservprotos=",$dosock ? "'define'\n" : "'undef'\n";
+ print OUT "d_getprotoprotos=",$dosock ? "'define'\n" : "'undef'\n";
if ($dosock and $cctype eq 'decc' and $ccflags =~ /DECCRTL_SOCKETS/) {
print OUT "selecttype='fd_set'\n";
Perl will print C<ONCE UPON A TIME THERE WAS>.
-The %ENV keys C<home>, C<path>,C<term>, and C<user>
-return the CRTL "environment variables" of the same
-names, if these logical names are not defined. The
-key C<default> returns the current default device
+The key C<default> returns the current default device
and directory specification, regardless of whether
-there is a logical name DEFAULT defined..
+there is a logical name DEFAULT defined. If you try to
+read an element of %ENV for which there is no corresponding
+logical name, and for which no corresponding CLI symbol
+exists (this is to identify "blocking" symbols only; to
+manipulate CLI symbols, see L<VMS::DCLSym>) then the key
+will be looked up in the CRTL-local environment array, and
+the corresponding value, if any returned. This lets you
+get at C-specific keys like C<home>, C<path>,C<term>, and
+C<user>, as well as other keys which may have been passed
+directly into the C-specific array if Perl was called from
+another C program using the version of execve() or execle()
+present in recent revisions of the DECCRTL.
Setting an element of %ENV defines a supervisor-mode logical
name in the process logical name table. C<Undef>ing or
logical name or a name in another logical name table will
replace the logical name just deleted. It is not possible
at present to define a search list logical name via %ENV.
+It is also not possible to delete an element from the
+C-local environ array.
+
+Note that if you want to pass on any elements of the
+C-local environ array to a subprocess which isn't
+started by fork/exec, or isn't running a C program, you
+can "promote" them to logical names in the current
+process, which will then be inherited by all subprocesses,
+by saying
+
+ foreach my $key (qw[C-local keys you want promoted]) {
+ my $temp = $ENV{$key}; # read from C-local array
+ $ENV{$key} = $temp; # and define as logical name
+ }
+
+(You can't just say C<$ENV{$key} = $ENV{$key}>, since the
+Perl optimizer is smart enough to elide the expression.)
At present, the first time you iterate over %ENV using
C<keys>, or C<values>, you will incur a time penalty as all
projects / p5sagit/p5-mst-13.2.git / commitdiff