summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNick Ing-Simmons <nik@tiuk.ti.com>2002-02-03 18:52:09 +0000
committerNick Ing-Simmons <nik@tiuk.ti.com>2002-02-03 18:52:09 +0000
commit4cf4f8f871391c98cb64b9c8574ca8e07b0f4a78 (patch)
treed832a30b4c111d2fe93311d7fe5fd47289cdd900
parent0b3236bb1fb664bc9c9ccd069cac189e80c3ef35 (diff)
parent2c237f47c4de5c8e57791c6b441d4cc2dc74391d (diff)
downloadperl-4cf4f8f871391c98cb64b9c8574ca8e07b0f4a78.tar.gz
Integrate mainline
p4raw-id: //depot/perlio@14541
-rw-r--r--README.solaris19
-rw-r--r--doio.c11
-rw-r--r--ext/Encode/MANIFEST2
-rw-r--r--ext/Encode/lib/Encode/Tcl/Escape.pm116
-rw-r--r--hints/solaris_2.sh2
-rw-r--r--lib/File/Copy.pm1
-rw-r--r--lib/I18N/LangTags/List.pm18
-rw-r--r--lib/Net/t/netrc.t6
-rw-r--r--lib/charnames.t2
-rw-r--r--os2/OS2/Process/Makefile.PL30
-rw-r--r--pod/perldiag.pod23
-rw-r--r--pod/perlfaq.pod31
-rw-r--r--pod/perlfaq1.pod6
-rw-r--r--pod/perlfaq4.pod9
-rw-r--r--pod/perlfaq6.pod2
-rw-r--r--pod/perlfaq7.pod2
-rw-r--r--pod/perltodo.pod4
-rw-r--r--pp_sys.c11
-rw-r--r--regcomp.c4
-rw-r--r--regexec.c4
-rw-r--r--t/lib/warnings/doio16
-rw-r--r--t/lib/warnings/pp_sys17
-rwxr-xr-xt/op/stat.t13
-rwxr-xr-xt/op/taint.t2
-rwxr-xr-xt/op/ver.t2
-rw-r--r--t/test.pl1
-rw-r--r--t/uni/fold.t3
-rw-r--r--toke.c13
-rw-r--r--utils/h2xs.PL124
29 files changed, 327 insertions, 167 deletions
diff --git a/README.solaris b/README.solaris
index 0243f85703..5ec59d51f8 100644
--- a/README.solaris
+++ b/README.solaris
@@ -153,14 +153,31 @@ your Solaris release.
=head3 GNU as and GNU ld
+The following information applies to gcc version 2. Volunteers to
+update it as appropropriate for gcc version 3 would be appreciated.
+
The versions of as and ld supplied with Solaris work fine for building
-perl. There is normally no need to install the GNU versions.
+perl. There is normally no need to install the GNU versions to
+compile perl.
If you decide to ignore this advice and use the GNU versions anyway,
then be sure that they are relatively recent. Versions newer than 2.7
are apparently new enough. Older versions may have trouble with
dynamic loading.
+If you wish to use GNU ld, then you need to pass it the -Wl,-E flag.
+The hints/solaris_2.sh file tries to do this automatically by executing
+the following commands:
+
+ ccdlflags="$ccdlflags -Wl,-E"
+ lddlflags="$lddlflags -Wl,-E -G"
+
+However, over the years, changes in gcc, GNU ld, and Solaris ld have made
+it difficult to automatically detect which ld ultimately gets called.
+You may have to manually edit config.sh and add the -Wl,-E flags
+yourself, or else run Configure interactively and add the flags at the
+appropriate prompts.
+
If your gcc is configured to use GNU as and ld but you want to use the
Solaris ones instead to build perl, then you'll need to add
-B/usr/ccs/bin/ to the gcc command line. One convenient way to do
diff --git a/doio.c b/doio.c
index 3c06585356..68853c2d38 100644
--- a/doio.c
+++ b/doio.c
@@ -1308,13 +1308,22 @@ Perl_my_lstat(pTHX)
Perl_croak(aTHX_ "The stat preceding -l _ wasn't an lstat");
return PL_laststatval;
}
- Perl_croak(aTHX_ "You can't use -l on a filehandle");
+ if (ckWARN(WARN_IO)) {
+ Perl_warner(aTHX_ WARN_IO, "Use of -l on filehandle %s",
+ GvENAME(cGVOP_gv));
+ return (PL_laststatval = -1);
+ }
}
PL_laststype = OP_LSTAT;
PL_statgv = Nullgv;
sv = POPs;
PUTBACK;
+ if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV && ckWARN(WARN_IO)) {
+ Perl_warner(aTHX_ WARN_IO, "Use of -l on filehandle %s",
+ GvENAME((GV*) SvRV(sv)));
+ return (PL_laststatval = -1);
+ }
sv_setpv(PL_statname,SvPV(sv, n_a));
PL_laststatval = PerlLIO_lstat(SvPV(sv, n_a),&PL_statcache);
if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n'))
diff --git a/ext/Encode/MANIFEST b/ext/Encode/MANIFEST
index d3edd0e842..bbeee2b239 100644
--- a/ext/Encode/MANIFEST
+++ b/ext/Encode/MANIFEST
@@ -134,7 +134,7 @@ README
compile
encengine.c
encode.h
-lib/Encode.pm
+Encode.pm
lib/Encode/Encoding.pm
lib/Encode/Internal.pm
lib/Encode/Tcl.pm
diff --git a/ext/Encode/lib/Encode/Tcl/Escape.pm b/ext/Encode/lib/Encode/Tcl/Escape.pm
index 572e2bf8d7..d3f55d7d5f 100644
--- a/ext/Encode/lib/Encode/Tcl/Escape.pm
+++ b/ext/Encode/lib/Encode/Tcl/Escape.pm
@@ -7,13 +7,13 @@ use Carp;
use constant SI => "\cO";
use constant SO => "\cN";
-use constant SS2 => "\eN";
-use constant SS3 => "\eO";
+use constant SS2 => "\e\x4E"; # ESC N
+use constant SS3 => "\e\x4F"; # ESC O
sub read
{
my ($obj,$fh,$name) = @_;
- my(%tbl, @seq, $enc, @esc, %grp);
+ my(%tbl, @seq, $enc, @esc, %grp, %mbc);
while (<$fh>)
{
next unless /^(\S+)\s+(.*)$/;
@@ -21,27 +21,40 @@ sub read
$val =~ s/^\{(.*?)\}/$1/g;
$val =~ s/\\x([0-9a-f]{2})/chr(hex($1))/ge;
- if($enc = Encode->getEncoding($key))
+ if ($enc = Encode->getEncoding($key))
{
- $tbl{$val} = ref($enc) eq 'Encode::Tcl' ? $enc->loadEncoding : $enc;
+ $tbl{$val} =
+ ref($enc) eq 'Encode::Tcl' ? $enc->loadEncoding : $enc;
+
+ $mbc{$val} =
+ $val !~ /\e\x24/ ? 1 : # single-byte
+ $val =~ /[\x30-\x3F]$/ ? 2 : # (only 2 is supported)
+ $val =~ /[\x40-\x5F]$/ ? 2 : # double byte
+ $val =~ /[\x60-\x6F]$/ ? 3 : # triple byte
+ $val =~ /[\x70-\x7F]$/ ? 4 :
+ # 4 or more (only 4 is supported)
+ croak("odd sequence is defined");
+
push @seq, $val;
+
$grp{$val} =
- $val =~ m|[(]| ? 0 : # G0 : SI eq "\cO"
- $val =~ m|[)-]| ? 1 : # G1 : SO eq "\cN"
- $val =~ m|[*.]| ? 2 : # G2 : SS2 eq "\eN"
- $val =~ m|[+/]| ? 3 : # G3 : SS3 eq "\eO"
- 0; # G0
+ $val =~ /\e\x24?[\x28]/ ? 0 : # G0 : SI
+ $val =~ /\e\x24?[\x29\x2D]/ ? 1 : # G1 : SO
+ $val =~ /\e\x24?[\x2A\x2E]/ ? 2 : # G2 : SS2
+ $val =~ /\e\x24?[\x2B\x2F]/ ? 3 : # G3 : SS3
+ 0; # G0 (ESC 02/04 F, etc.)
}
else
{
$obj->{$key} = $val;
}
- if($val =~ /^\e(.*)/)
+ if ($val =~ /^\e(.*)/)
{
push(@esc, quotemeta $1);
}
}
$obj->{'Grp'} = \%grp; # graphic chars
+ $obj->{'Mbc'} = \%mbc; # bytes per char
$obj->{'Seq'} = \@seq; # escape sequences
$obj->{'Tbl'} = \%tbl; # encoding tables
$obj->{'Esc'} = join('|', @esc); # regex of sequences following ESC
@@ -51,13 +64,11 @@ sub read
sub decode
{
my ($obj,$str,$chk) = @_;
- my $name = $obj->{'Name'};
my $tbl = $obj->{'Tbl'};
my $seq = $obj->{'Seq'};
+ my $mbc = $obj->{'Mbc'};
my $grp = $obj->{'Grp'};
my $esc = $obj->{'Esc'};
- my $ini = $obj->{'init'};
- my $fin = $obj->{'final'};
my $std = $seq->[0];
my $cur = $std;
my @sta = ($std, undef, undef, undef); # G0 .. G3 state
@@ -66,21 +77,20 @@ sub decode
my $uni;
while (length($str))
{
- my $cc = substr($str,0,1,'');
- if($cc eq "\e")
+ if ($str =~ s/^\e//)
{
- if($str =~ s/^($esc)//)
+ if ($str =~ s/^($esc)//)
{
my $e = "\e$1";
$sta[ $grp->{$e} ] = $e if $tbl->{$e};
}
# appearance of "\eN\eO" or "\eO\eN" isn't supposed.
# but in that case, the former will be ignored.
- elsif($str =~ s/^N//)
+ elsif ($str =~ s/^\x4E//)
{
$ss = 2;
}
- elsif($str =~ s/^O//)
+ elsif ($str =~ s/^\x4F//)
{
$ss = 3;
}
@@ -88,7 +98,7 @@ sub decode
{
# strictly, ([\x20-\x2F]*[\x30-\x7E]). '?' for chopped.
$str =~ s/^([\x20-\x2F]*[\x30-\x7E]?)//;
- if($chk && ! length $str)
+ if ($chk && ! length $str)
{
$str = "\e$1"; # split sequence
last;
@@ -97,54 +107,31 @@ sub decode
}
next;
}
- if($cc eq SO)
+ if ($str =~ s/^\cN//) # SO
{
$s = 1; next;
}
- if($cc eq SI)
+ if ($str =~ s/^\cO//) # SI
{
$s = 0; next;
}
$cur = $ss ? $sta[$ss] : $sta[$s];
- if(ref($tbl->{$cur}) ne 'Encode::Tcl::Table')
- {
- $uni .= $tbl->{$cur}->decode($cc);
- $ss = 0;
- next;
- }
- my $ch = ord($cc);
- my $rep = $tbl->{$cur}->{'Rep'};
- my $touni = $tbl->{$cur}->{'ToUni'};
- my $x;
- if (&$rep($ch) eq 'C')
- {
- $x = $touni->[0][$ch];
- }
- else
- {
- if(! length $str)
- {
- $str = $cc; # split leading byte
- last;
- }
- my $c2 = substr($str,0,1,'');
- $cc .= $c2;
- $x = $touni->[$ch][ord($c2)];
- }
- unless (defined $x)
- {
- Encode::Tcl::no_map_in_decode($name, $cc.$str);
- }
+ length($str) < $mbc->{$cur} and last; # split leading byte
+
+ my $cc = substr($str, 0, $mbc->{$cur}, '');
+
+ my $x = $tbl->{$cur}->decode($cc);
+ defined $x or Encode::Tcl::no_map_in_decode($obj->{'Name'}, $cc);
$uni .= $x;
$ss = 0;
}
- if($chk)
+ if ($chk)
{
my $back = join('', grep defined($_) && $_ ne $std, @sta);
$back .= SO if $s;
- $back .= $ss == 2 ? SS2 : SS3 if $ss;
+ $back .= $ss == 2 ? SS2 : $ss == 3 ? SS3 : '';
$_[1] = $back.$str;
}
return $uni;
@@ -153,12 +140,10 @@ sub decode
sub encode
{
my ($obj,$uni,$chk) = @_;
- my $name = $obj->{'Name'};
my $tbl = $obj->{'Tbl'};
my $seq = $obj->{'Seq'};
my $grp = $obj->{'Grp'};
my $ini = $obj->{'init'};
- my $fin = $obj->{'final'};
my $std = $seq->[0];
my $str = $ini;
my @sta = ($std,undef,undef,undef); # G0 .. G3 state
@@ -166,7 +151,7 @@ sub encode
my $pG = 0; # previous G: 0 or 1.
my $cG = 0; # current G: 0,1,2,3.
- if($ini && defined $grp->{$ini})
+ if ($ini && defined $grp->{$ini})
{
$sta[ $grp->{$ini} ] = $ini;
}
@@ -177,25 +162,14 @@ sub encode
my $x;
foreach my $e_seq (@$seq)
{
- $x = ref($tbl->{$e_seq}) eq 'Encode::Tcl::Table'
- ? $tbl->{$e_seq}->{FmUni}->{$ch}
- : $tbl->{$e_seq}->encode($ch,1);
+ $x = $tbl->{$e_seq}->encode($ch, 1);
$cur = $e_seq, last if defined $x;
}
unless (defined $x)
{
- unless($chk)
- {
- Encode::Tcl::no_map_in_encode(ord($ch), $name)
- }
+ $chk or Encode::Tcl::no_map_in_encode(ord($ch), $obj->{'Name'});
return undef;
}
- if(ref($tbl->{$cur}) eq 'Encode::Tcl::Table')
- {
- my $def = $tbl->{$cur}->{'Def'};
- my $rep = $tbl->{$cur}->{'Rep'};
- $x = pack(&$rep($x),$x);
- }
$cG = $grp->{$cur};
$str .= $sta[$cG] = $cur unless $cG < 2 && $cur eq $sta[$cG];
@@ -207,8 +181,8 @@ sub encode
$pG = $cG if $cG < 2;
}
$str .= SI if $pG == 1; # back to G0
- $str .= $std unless $std eq $sta[0]; # GO to ASCII
- $str .= $fin; # necessary?
+ $str .= $std unless $std eq $sta[0]; # G0 to ASCII
+ $str .= $obj->{'final'}; # necessary? I don't know what is this for.
$_[1] = $uni if $chk;
return $str;
}
diff --git a/hints/solaris_2.sh b/hints/solaris_2.sh
index 01a0d10c2a..f89842a646 100644
--- a/hints/solaris_2.sh
+++ b/hints/solaris_2.sh
@@ -272,7 +272,7 @@ doesn't work, you should use -B/usr/ccs/bin/ instead.
END
ccdlflags="$ccdlflags -Wl,-E"
- lddlflags="$lddlflags -W,l-E -G"
+ lddlflags="$lddlflags -Wl,-E -G"
fi
fi
diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm
index be184a6e14..5558bafe11 100644
--- a/lib/File/Copy.pm
+++ b/lib/File/Copy.pm
@@ -72,6 +72,7 @@ sub copy {
if ($Config{d_symlink} && $Config{d_readlink} &&
!($^O eq 'Win32' || $^O eq 'os2' || $^O eq 'vms')) {
+ no warnings 'io'; # don't warn if -l on filehandle
if ((-e $from && -l $from) || (-e $to && -l $to)) {
my @fs = stat($from);
my @ts = stat($to);
diff --git a/lib/I18N/LangTags/List.pm b/lib/I18N/LangTags/List.pm
index ca5ae42c09..2dbd19a5d7 100644
--- a/lib/I18N/LangTags/List.pm
+++ b/lib/I18N/LangTags/List.pm
@@ -1,10 +1,10 @@
require 5;
package I18N::LangTags::List;
-# Time-stamp: "2001-06-20 12:01:15 MDT"
+# Time-stamp: "2002-02-02 20:13:58 MST"
use strict;
use vars qw(%Name $Debug $VERSION);
-$VERSION = '0.24';
+$VERSION = '0.25';
# POD at the end.
#----------------------------------------------------------------------
@@ -117,7 +117,7 @@ when qualified by a country code ("en-US"). Less well-known are the
arbitrary-length non-ISO codes (like "i-mingo"), and the
recently (in 2001) introduced three-letter ISO-639-2 codes.
-Remember this important facts:
+Remember these important facts:
=over
@@ -128,7 +128,7 @@ instead of a "-", (almost?) always matches C<m/^\w\w_\w\w\b/>, and
I<means> something different than a language tag. A language tag
denotes a language. A locale ID denotes a language I<as used in>
a particular place, in combination with non-linguistic
-location-specific information such as what currency in used
+location-specific information such as what currency is used
there. Locales I<also> often denote character set information,
as in "en_US.ISO8859-1".
@@ -139,7 +139,7 @@ Language tags are not for computer languages.
=item *
"Dialect" is not a useful term, since there is no objective
-criterion for establishing when two languages are
+criterion for establishing when two language-forms are
dialects of eachother, or are separate languages.
=item *
@@ -157,7 +157,7 @@ bibliographic tags that classify whole groups of languages, as
with cus "Cushitic (Other)" (i.e., a
language that has been classed as Cushtic, but which has no more
specific code) or the even less linguistically coherent
-sai for "South American Indian (Other)". While useful in
+sai for "South American Indian (Other)". Though useful in
bibliography, B<SUCH TAGS ARE NOT
FOR GENERAL USE>. For further guidance, email me.
@@ -1339,8 +1339,8 @@ eq Kiswahili
=item {sv} : Swedish
Notable forms:
-sv-se {Sweden Swedish};
-sv-fi {Finland Swedish}.
+{sv-se} Sweden Swedish;
+{sv-fi} Finland Swedish.
=item {syr} : Syriac
@@ -1558,7 +1558,7 @@ L<I18N::LangTags|I18N::LangTags> and its "See Also" section.
=head1 COPYRIGHT AND DISCLAIMER
-Copyright (c) 2001 Sean M. Burke. All rights reserved.
+Copyright (c) 2001,2002 Sean M. Burke. All rights reserved.
You can redistribute and/or
modify this document under the same terms as Perl itself.
diff --git a/lib/Net/t/netrc.t b/lib/Net/t/netrc.t
index 885b515452..464794b956 100644
--- a/lib/Net/t/netrc.t
+++ b/lib/Net/t/netrc.t
@@ -58,7 +58,8 @@ SKIP: {
$stat[2] = 077;
ok( !defined(Net::Netrc::_readrc()),
'_readrc() should not read world-writable file' );
- ok( $warn =~ /^Bad permissions:/, '... and should warn about it' );
+ ok( scalar( $warn =~ /^Bad permissions:/ ),
+ '... and should warn about it' );
# the owner field should still not match
$stat[2] = 0;
@@ -66,7 +67,8 @@ SKIP: {
if ($<) {
ok( !defined(Net::Netrc::_readrc()),
'_readrc() should not read file owned by someone else' );
- ok( $warn =~ /^Not owner:/, '... and should warn about it' );
+ ok( scalar( $warn =~ /^Not owner:/ ),
+ '... and should warn about it' );
} else {
ok(1, "Skip - testing as root") for 1..2;
}
diff --git a/lib/charnames.t b/lib/charnames.t
index adc4b3f23e..e12b920f31 100644
--- a/lib/charnames.t
+++ b/lib/charnames.t
@@ -12,7 +12,7 @@ print "1..22\n";
use charnames ':full';
-print "not " unless "Here\N{EXCLAMATION MARK}?" eq "Here\041?";
+print "not " unless "Here\N{EXCLAMATION MARK}?" eq "Here!?";
print "ok 1\n";
{
diff --git a/os2/OS2/Process/Makefile.PL b/os2/OS2/Process/Makefile.PL
index 9c97ad0c10..c1417579c7 100644
--- a/os2/OS2/Process/Makefile.PL
+++ b/os2/OS2/Process/Makefile.PL
@@ -1,4 +1,7 @@
use ExtUtils::MakeMaker;
+
+create_constants(); # Make a module
+
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
@@ -12,3 +15,30 @@ WriteMakefile(
# _16_Win16SetTitle => 'pmshapi.93',
},
);
+
+sub create_constants {
+ return if -d 'Process_constants';
+ my $src_dir;
+ my @try = qw(.. ../.. ../../.. ../../../..);
+ for (@try) {
+ $src_dir = $_, last if -d "$_/utils" and -r "$_/utils/h2xs";
+ }
+ warn("Can't find \$PERL_SRC/utils/h2xs in @try, falling back to no constants"),
+ return unless defined $src_dir;
+ # Can't name it *::Constants, otherwise constants.xs would overwrite it...
+ # This produces warnings from PSZ-conversion on WS_* constants.
+ system $^X, "-I$src_dir/lib", "$src_dir/utils/h2xs", '-fn', 'OS2::Process::Const',
+ '--skip-exporter', '--skip-autoloader', # too large memory overhead
+ '--skip-strict', '--skip-warnings', # likewise
+ '--skip-ppport', # will not work without dynaloading.
+ # Most useful for OS2::Process:
+ '-M^(HWND|WM|SC|SWP|WC|PROG|QW|EDI|WS)_',
+ '-F', '-DINCL_NLS -DINCL_BASE -DINCL_PM', # Define more symbols
+ 'os2emx.h' # EMX version of OS/2 API
+ and warn("Can't build module with contants, falling back to no constants"),
+ return;
+ rename 'OS2/Process/Const', 'Process_constants'
+ or warn("Error renaming module, falling back to no constants: $!"),
+ return;
+ return 1;
+}
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 76fb6aa57d..791b302d18 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1846,6 +1846,12 @@ effective uids or gids failed.
to check the return value of your socket() call? See
L<perlfunc/listen>.
+=item lstat() on filehandle %s
+
+(W io) You tried to do an lstat on a filehandle. What did you mean
+by that? lstat() makes sense only on filenames. (Perl did a fstat()
+instead on the filehandle.)
+
=item Lvalue subs returning %s not implemented yet
(F) Due to limitations in the current implementation, array and hash
@@ -3954,6 +3960,12 @@ In code that currently says C<use AutoLoader; @ISA = qw(AutoLoader);>
you should remove AutoLoader from @ISA and change C<use AutoLoader;> to
C<use AutoLoader 'AUTOLOAD';>.
+=item Use of -l on filehandle %s
+
+(W io) A filehandle represents an opened file, and when you opened the file
+it already went past any symlink you are presumably trying to look for.
+The operation returned C<undef>. Use a filename instead.
+
=item Use of "package" with no arguments is deprecated
(D deprecated) You used the C<package> keyword without specifying a package
@@ -4208,17 +4220,6 @@ supported.
(F) The use of an external subroutine as a sort comparison is not yet
supported.
-=item You can't use C<-l> on a filehandle
-
-(F) A filehandle represents an opened file, and when you opened the file
-it already went past any symlink you are presumably trying to look for.
-Use a filename instead.
-
-=item You can't use lstat() on a filehandle
-
-(F) You tried to do an lstat on a filehandle. lstat() makes sense only
-on filenames.
-
=item YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!
(F) And you probably never will, because you probably don't have the
diff --git a/pod/perlfaq.pod b/pod/perlfaq.pod
index 3d3b10fa06..059dd13c34 100644
--- a/pod/perlfaq.pod
+++ b/pod/perlfaq.pod
@@ -1,6 +1,6 @@
=head1 NAME
-perlfaq - frequently asked questions about Perl ($Date: 2002/01/28 04:17:26 $)
+perlfaq - frequently asked questions about Perl ($Date: 2002/01/31 04:27:54 $)
=head1 DESCRIPTION
@@ -13,7 +13,7 @@ This document.
=head2 L<perlfaq1>: General Questions About Perl
-Very general, high-level information about Perl.
+Very general, high-level questions about Perl.
=over 4
@@ -75,14 +75,14 @@ Where can I get a list of Larry Wall witticisms?
=item *
-How can I convince my sysadmin/supervisor/employees to use version 5/5.005/Perl instead of some other language?
+How can I convince my sysadmin/supervisor/employees to use version 5/5.6.1/Perl instead of some other language?
=back
=head2 L<perlfaq2>: Obtaining and Learning about Perl
-Where to find source and documentation to Perl, support,
+Where to find source and documentation for Perl, support,
and related matters.
=over 4
@@ -157,7 +157,7 @@ Where do I send bug reports?
=item *
-What is perl.com? Perl Mongers? pm.org? perl.org?
+What is perl.com? Perl Mongers? pm.org? perl.org? cpan.org?
=back
@@ -287,8 +287,7 @@ my C program; what am I doing wrong?
=item *
-When I tried to run my script, I got this message. What does it
-mean?
+When I tried to run my script, I got this message. What does it mean?
=item *
@@ -318,7 +317,7 @@ Does Perl have a round() function? What about ceil() and floor()? Trig functio
=item *
-How do I convert bits into ints?
+How do I convert between numeric representations?
=item *
@@ -463,7 +462,7 @@ How can I remove duplicate elements from a list or array?
=item *
-How can I tell whether a list or array contains a certain element?
+How can I tell whether a certain element is contained in a list or array?
=item *
@@ -606,7 +605,7 @@ How do I pack arrays of doubles or floats for XS code?
=head2 L<perlfaq5>: Files and Formats
-I/O and the "f" issues: filehandles, flushing, formats and footers.
+I/O and the "f" issues: filehandles, flushing, formats, and footers.
=over 4
@@ -757,7 +756,7 @@ Why do I get weird spaces when I print an array of lines?
=back
-=head2 L<perlfaq6>: Regexps
+=head2 L<perlfaq6>: Regular Expressions
Pattern matching and regular expressions.
@@ -1188,12 +1187,16 @@ What is socket.ph and where do I get it?
=head2 L<perlfaq9>: Networking
-Networking, the Internet, and a few on the web.
+Networking, the internet, and a few on the web.
=over 4
=item *
+What is the correct form of response from a CGI script?
+
+=item *
+
My CGI script runs from the command line but not the browser. (500 Server Error)
=item *
@@ -1270,6 +1273,10 @@ How do I send mail?
=item *
+How do I use MIME to make an attachment to a mail message?
+
+=item *
+
How do I read mail?
=item *
diff --git a/pod/perlfaq1.pod b/pod/perlfaq1.pod
index 78720e75df..f2154d2a1e 100644
--- a/pod/perlfaq1.pod
+++ b/pod/perlfaq1.pod
@@ -1,6 +1,6 @@
=head1 NAME
-perlfaq1 - General Questions About Perl ($Revision: 1.5 $, $Date: 2002/01/27 20:22:52 $)
+perlfaq1 - General Questions About Perl ($Revision: 1.6 $, $Date: 2002/01/31 01:46:23 $)
=head1 DESCRIPTION
@@ -264,7 +264,7 @@ http://www.cpan.org/misc/japh .
Over a hundred quips by Larry, from postings of his or source code,
can be found at http://www.cpan.org/misc/lwall-quotes.txt.gz .
-=head2 How can I convince my sysadmin/supervisor/employees to use version 5/5.005/Perl instead of some other language?
+=head2 How can I convince my sysadmin/supervisor/employees to use version 5/5.6.1/Perl instead of some other language?
If your manager or employees are wary of unsupported software, or
software which doesn't officially ship with your operating system, you
@@ -296,7 +296,7 @@ for any given task. Also mention that the difference between version
(Well, OK, maybe it's not quite that distinct, but you get the idea.)
If you want support and a reasonable guarantee that what you're
developing will continue to work in the future, then you have to run
-the supported version. As of April 2001 that probably means
+the supported version. As of January 2002 that probably means
running either of the releases 5.6.1 (released in April 2001) or
5.005_03 (released in March 1999), although 5.004_05 isn't that bad
if you B<absolutely> need such an old version (released in April 1999)
diff --git a/pod/perlfaq4.pod b/pod/perlfaq4.pod
index d5622ce337..5d3e595f07 100644
--- a/pod/perlfaq4.pod
+++ b/pod/perlfaq4.pod
@@ -1,12 +1,11 @@
=head1 NAME
-perlfaq4 - Data Manipulation ($Revision: 1.12 $, $Date: 2002/01/28 04:17:26 $)
+perlfaq4 - Data Manipulation ($Revision: 1.13 $, $Date: 2002/01/31 04:27:54 $)
=head1 DESCRIPTION
-The section of the FAQ answers questions related to the manipulation
-of data as numbers, dates, strings, arrays, hashes, and miscellaneous
-data issues.
+This section of the FAQ answers questions related to manipulating
+numbers, dates, strings, arrays, hashes, and miscellaneous data issues.
=head1 Data: Numbers
@@ -123,7 +122,7 @@ Perl numbers whose absolute values are integers under 2**31 (on 32 bit
machines) will work pretty much like mathematical integers. Other numbers
are not guaranteed.
-=head2 How do I convert between numeric representations:
+=head2 How do I convert between numeric representations?
As always with Perl there is more than one way to do it. Below
are a few examples of approaches to making common conversions
diff --git a/pod/perlfaq6.pod b/pod/perlfaq6.pod
index 1c878af3ee..c4512e695a 100644
--- a/pod/perlfaq6.pod
+++ b/pod/perlfaq6.pod
@@ -1,6 +1,6 @@
=head1 NAME
-perlfaq6 - Regexes ($Revision: 1.7 $, $Date: 2002/01/28 04:17:26 $)
+perlfaq6 - Regular Expressions ($Revision: 1.8 $, $Date: 2002/01/31 04:27:55 $)
=head1 DESCRIPTION
diff --git a/pod/perlfaq7.pod b/pod/perlfaq7.pod
index 77886ab516..96c5870d81 100644
--- a/pod/perlfaq7.pod
+++ b/pod/perlfaq7.pod
@@ -1,6 +1,6 @@
=head1 NAME
-perlfaq7 - Perl Language Issues ($Revision: 1.6 $, $Date: 2002/01/28 04:17:26 $)
+perlfaq7 - General Perl Language Issues ($Revision: 1.7 $, $Date: 2002/01/31 04:27:55 $)
=head1 DESCRIPTION
diff --git a/pod/perltodo.pod b/pod/perltodo.pod
index 16e2fac21c..1b64991faf 100644
--- a/pod/perltodo.pod
+++ b/pod/perltodo.pod
@@ -303,6 +303,10 @@ properly on error.
This is possible to do, but would be pretty messy to implement, as it
would rely on even more sed hackery in F<perly.fixer>.
+=head2 pack for IV, UVs, NVs, and long doubles
+
+j, J, g, G?
+
=head2 pack "(stuff)*"
That's to say, C<pack "(sI)40"> would be the same as C<pack "sI"x40>
diff --git a/pp_sys.c b/pp_sys.c
index b1ce18a100..4b1a1e7b9f 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -2726,9 +2726,11 @@ PP(pp_stat)
if (PL_op->op_flags & OPf_REF) {
gv = cGVOP_gv;
if (PL_op->op_type == OP_LSTAT) {
- if (gv != PL_defgv)
- Perl_croak(aTHX_ "You can't use lstat() on a filehandle");
- if (PL_laststype != OP_LSTAT)
+ if (gv != PL_defgv) {
+ if (ckWARN(WARN_IO))
+ Perl_warner(aTHX_ WARN_IO,
+ "lstat() on filehandle %s", GvENAME(gv));
+ } else if (PL_laststype != OP_LSTAT)
Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
}
@@ -2754,6 +2756,9 @@ PP(pp_stat)
}
else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
gv = (GV*)SvRV(sv);
+ if (PL_op->op_type == OP_LSTAT && ckWARN(WARN_IO))
+ Perl_warner(aTHX_ WARN_IO,
+ "lstat() on filehandle %s", GvENAME(gv));
goto do_fstat;
}
sv_setpv(PL_statname, SvPV(sv,n_a));
diff --git a/regcomp.c b/regcomp.c
index bf4d226c69..c238f4eaa5 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -4065,9 +4065,9 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
STRLEN foldlen;
UV f;
- uvchr_to_utf8(tmpbuf, value);
+ uvchr_to_utf8(tmpbuf, NATIVE_TO_UNI(value));
to_utf8_fold(tmpbuf, foldbuf, &foldlen);
- f = utf8_to_uvchr(foldbuf, 0);
+ f = UNI_TO_NATIVE(utf8_to_uvchr(foldbuf, 0));
/* If folding and foldable and a single
* character, insert also the folded version
diff --git a/regexec.c b/regexec.c
index 70d401dd63..830488afc1 100644
--- a/regexec.c
+++ b/regexec.c
@@ -2332,7 +2332,7 @@ S_regmatch(pTHX_ regnode *prog)
if (l >= PL_regeol)
sayNO;
if (NATIVE_TO_UNI(*(U8*)s) !=
- utf8_to_uvchr((U8*)l, &ulen))
+ utf8_to_uvuni((U8*)l, &ulen))
sayNO;
l += ulen;
s ++;
@@ -2344,7 +2344,7 @@ S_regmatch(pTHX_ regnode *prog)
if (l >= PL_regeol)
sayNO;
if (NATIVE_TO_UNI(*((U8*)l)) !=
- utf8_to_uvchr((U8*)s, &ulen))
+ utf8_to_uvuni((U8*)s, &ulen))
sayNO;
s += ulen;
l ++;
diff --git a/t/lib/warnings/doio b/t/lib/warnings/doio
index 9ba4d31633..0db1a1315c 100644
--- a/t/lib/warnings/doio
+++ b/t/lib/warnings/doio
@@ -36,6 +36,8 @@
warn(warn_nl, "lstat"); [Perl_my_lstat]
lstat "ab\ncd"
+ Use of -l on filehandle %s [Perl_my_lstat]
+
Can't exec \"%s\": %s [Perl_do_aexec5]
Can't exec \"%s\": %s [Perl_do_exec3]
@@ -154,6 +156,20 @@ EXPECT
Unsuccessful stat on filename containing newline at - line 3.
Unsuccessful stat on filename containing newline at - line 4.
########
+# doio.c [Perl_my_stat]
+use warnings 'io';
+-l STDIN;
+-l $fh;
+open $fh, $0 or die "# $!";
+-l $fh;
+no warnings 'io';
+-l STDIN;
+-l $fh;
+close $fh;
+EXPECT
+Use of -l on filehandle STDIN at - line 3.
+Use of -l on filehandle $fh at - line 6.
+########
# doio.c [Perl_do_aexec5]
use warnings 'io' ;
exec "lskdjfalksdjfdjfkls","" ;
diff --git a/t/lib/warnings/pp_sys b/t/lib/warnings/pp_sys
index 4b9c8b1a96..57abd6986d 100644
--- a/t/lib/warnings/pp_sys
+++ b/t/lib/warnings/pp_sys
@@ -96,8 +96,8 @@
my $file = "./xcv" ;
open(F, ">$file") ;
my $a = sysread(F, $a,10) ;
-
-
+
+ lstat on filehandle %s [pp_lstat]
__END__
# pp_sys.c [pp_untie]
@@ -396,3 +396,16 @@ $a = "BLERG";binmode($a);
EXPECT
binmode() on unopened filehandle BLARG at - line 3.
binmode() on unopened filehandle at - line 4.
+########
+# pp_sys.c [pp_lstat]
+use warnings 'io';
+lstat STDIN;
+open my $fh, $0 or die "# $!";
+lstat $fh;
+no warnings 'io';
+lstat STDIN;
+lstat $fh;
+close $fh;
+EXPECT
+lstat() on filehandle STDIN at - line 3.
+lstat() on filehandle $fh at - line 5.
diff --git a/t/op/stat.t b/t/op/stat.t
index ad87c25b0b..312dd1d06a 100755
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -9,7 +9,7 @@ BEGIN {
use Config;
use File::Spec;
-plan tests => 75;
+plan tests => 73;
my $Perl = which_perl();
@@ -336,14 +336,14 @@ SKIP: {
ok(! -B FOO, ' !-B');
$_ = <FOO>;
- ok(/perl/, 'after readline');
+ like($_, qr/perl/, 'after readline');
ok(-T FOO, ' still -T');
ok(! -B FOO, ' still -B');
close(FOO);
open(FOO,'op/stat.t');
$_ = <FOO>;
- ok(/perl/, 'reopened and after readline');
+ like($_, qr/perl/, 'reopened and after readline');
ok(-T FOO, ' still -T');
ok(! -B FOO, ' still !-B');
@@ -390,13 +390,6 @@ SKIP: {
like( $@, qr/^The stat preceding -l _ wasn't an lstat/,
'-l _ croaks after stat' );
- eval { lstat STDIN };
- like( $@, qr/^You can't use lstat\(\) on a filehandle/,
- 'lstat FILEHANDLE croaks' );
- eval { -l STDIN };
- like( $@, qr/^You can't use -l on a filehandle/,
- '-l FILEHANDLE croaks' );
-
# bug id 20020124.004
# If we have d_lstat, we should have symlink()
my $linkname = 'dolzero';
diff --git a/t/op/taint.t b/t/op/taint.t
index 7c83019e7c..63fc32e8a4 100755
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -16,7 +16,7 @@ use strict;
use Config;
my $test = 177;
-sub ok {
+sub ok ($;$) {
my($ok, $name) = @_;
# You have to do it this way or VMS will get confused.
diff --git a/t/op/ver.t b/t/op/ver.t
index a7e57a63ce..1dc28d2d35 100755
--- a/t/op/ver.t
+++ b/t/op/ver.t
@@ -191,7 +191,7 @@ SKIP: {
my $ip = v2004.148.0.1;
my $host;
eval { $host = gethostbyaddr($ip,Socket::AF_INET) };
- ok($@ =~ /Wide character/,"Non-bytes leak to gethostbyaddr");
+ like($@, qr/Wide character/, "Non-bytes leak to gethostbyaddr");
}
# Chapter 28, pp671
diff --git a/t/test.pl b/t/test.pl
index e7376653b2..be052b5487 100644
--- a/t/test.pl
+++ b/t/test.pl
@@ -77,6 +77,7 @@ sub _where {
return "at $caller[1] line $caller[2]";
}
+# DON'T use this for matches. Use like() instead.
sub ok {
my ($pass, $name, @mess) = @_;
_ok($pass, _where(), $name, @mess);
diff --git a/t/uni/fold.t b/t/uni/fold.t
index a068e6511a..936a690343 100644
--- a/t/uni/fold.t
+++ b/t/uni/fold.t
@@ -9,12 +9,15 @@ my $CF = File::Spec->catfile(File::Spec->catdir(File::Spec->updir,
"lib", "unicore"),
"CaseFolding.txt");
+use constant EBCDIC => ord 'A' == 193;
+
if (open(CF, $CF)) {
my @CF;
while (<CF>) {
if (/^([0-9A-F]+); ([CFSI]); ((?:[0-9A-F]+)(?: [0-9A-F]+)*); \# (.+)/) {
next if $2 eq 'S'; # we are going for 'F'ull case folding
+ next if EBCDIC && hex $1 < 0x100;
push @CF, [$1, $2, $3, $4];
}
}
diff --git a/toke.c b/toke.c
index 9d3acd212a..7db985e5cd 100644
--- a/toke.c
+++ b/toke.c
@@ -1557,6 +1557,19 @@ S_scan_const(pTHX_ char *start)
if (has_utf8)
sv_utf8_upgrade(res);
str = SvPV(res,len);
+#ifdef EBCDIC
+ {
+ UV uv = utf8_to_uvchr((U8*)str, 0);
+
+ if (uv < 0x100) {
+ U8 tmpbuf[UTF8_MAXLEN+1], *d;
+
+ d = uvchr_to_utf8(tmpbuf, UNI_TO_NATIVE(uv));
+ sv_setpvn(res, (char *)tmpbuf, d - tmpbuf);
+ str = SvPV(res, len);
+ }
+ }
+#endif
if (!has_utf8 && SvUTF8(res)) {
char *ostart = SvPVX(sv);
SvCUR_set(sv, d - ostart);
diff --git a/utils/h2xs.PL b/utils/h2xs.PL
index 9b7584c9bb..a18dac6ecf 100644
--- a/utils/h2xs.PL
+++ b/utils/h2xs.PL
@@ -83,7 +83,8 @@ the POD template.
=item B<-F>, B<--cpp-flags>=I<addflags>
Additional flags to specify to C preprocessor when scanning header for
-function declarations. Should not be used without B<-x>.
+function declarations. Writes these options in the generated F<Makefile.PL>
+too.
=item B<-M>, B<--func-mask>=I<regular expression>
@@ -214,6 +215,27 @@ C<Makefile.PL>.
Will force the generation of test code that uses the older C<Test> module.
+=item B<--skip-exporter>
+
+Do not use C<Exporter> and/or export any symbol.
+
+=item B<--skip-ppport>
+
+Do not use C<Devel::PPPort>: no portability to older version.
+
+=item B<--skip-autoloader>
+
+Do not use the module C<AutoLoader>; but keep the constant() function
+and C<sub AUTOLOAD> for constants.
+
+=item B<--skip-strict>
+
+Do not use the pragma C<strict>.
+
+=item B<--skip-warnings>
+
+Do not use the pragma C<warnings>.
+
=item B<-v>, B<--version>=I<version>
Specify a version number for this extension. This version number is added
@@ -447,7 +469,6 @@ $Text::Wrap::huge = 'overflow';
$Text::Wrap::columns = 80;
use ExtUtils::Constant qw (WriteConstants WriteMakefileSnippet autoload);
use File::Compare;
-use Devel::PPPort;
sub usage {
warn "@_\n" if @_;
@@ -458,7 +479,7 @@ OPTIONS:
-A, --omit-autoload Omit all autoloading facilities (implies -c).
-C, --omit-changes Omit creating the Changes file, add HISTORY heading
to stub POD.
- -F, --cpp-flags Additional flags for C preprocessor (used with -x).
+ -F, --cpp-flags Additional flags for C preprocessor/compile.
-M, --func-mask Mask to select C functions/macros
(default is select all).
-O, --overwrite-ok Allow overwriting of a pre-existing extension directory.
@@ -485,6 +506,11 @@ OPTIONS:
-t, --default-type Default type for autoloaded constants (default is IV)
--use-new-tests Use Test::More in backward compatible modules
--use-old-tests Use the module Test rather than Test::More
+ --skip-exporter Do not export symbols
+ --skip-ppport Do not use portability layer
+ --skip-autoloader Do not use the module C<AutoLoader>
+ --skip-strict Do not use the pragma C<strict>
+ --skip-warnings Do not use the pragma C<warnings>
-v, --version Specify a version number for this extension.
-x, --autogen-xsubs Autogenerate XSUBs using C::Scan.
@@ -518,7 +544,12 @@ my ($opt_A,
$opt_b,
$opt_t,
$new_test,
- $old_test
+ $old_test,
+ $skip_exporter,
+ $skip_ppport,
+ $skip_autoloader,
+ $skip_strict,
+ $skip_warnings,
);
Getopt::Long::Configure('bundling');
@@ -548,7 +579,12 @@ my %options = (
'version|v=s' => \$opt_v,
'autogen-xsubs|x' => \$opt_x,
'use-new-tests' => \$new_test,
- 'use-old-tests' => \$old_test
+ 'use-old-tests' => \$old_test,
+ 'skip-exporter' => \$skip_exporter,
+ 'skip-ppport' => \$skip_ppport,
+ 'skip-autoloader' => \$skip_autoloader,
+ 'skip-warnings' => \$skip_warnings,
+ 'skip-strict' => \$skip_strict,
);
GetOptions(%options) || usage;
@@ -581,7 +617,7 @@ if( $opt_v ){
}
# -A implies -c.
-$opt_c = 1 if $opt_A;
+$skip_autoloader = $opt_c = 1 if $opt_A;
# -X implies -c and -f
$opt_c = $opt_f = 1 if $opt_X;
@@ -638,8 +674,11 @@ EOD
}
}
elsif ($opt_o or $opt_F) {
- warn <<EOD;
-Options -o and -F do not make sense without -x.
+ warn <<EOD if $opt_o;
+Option -o does not make sense without -x.
+EOD
+ warn <<EOD if $opt_F and $opt_X ;
+Option -F does not make sense with -X.
EOD
}
@@ -820,10 +859,12 @@ my %vdecl_hash;
my @vdecls;
if( ! $opt_X ){ # use XS, unless it was disabled
- warn "Writing $ext$modpname/ppport.h\n";
- Devel::PPPort::WriteFile('ppport.h')
- || die "Can't create $ext$modpname/ppport.h: $!\n";
-
+ unless ($skip_ppport) {
+ require Devel::PPPort;
+ warn "Writing $ext$modpname/ppport.h\n";
+ Devel::PPPort::WriteFile('ppport.h')
+ || die "Can't create $ext$modpname/ppport.h: $!\n";
+ }
open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n";
if ($opt_x) {
require Config; # Run-time directive
@@ -942,9 +983,13 @@ print PM <<"END";
package $module;
use $compat_version;
+END
+
+print PM <<"END" unless $skip_strict;
use strict;
END
-print PM "use warnings;\n" unless $compat_version < 5.006;
+
+print PM "use warnings;\n" unless $skip_warnings or $compat_version < 5.006;
unless( $opt_X || $opt_c || $opt_A ){
# we'll have an AUTOLOAD(), and it will have $AUTOLOAD and
@@ -954,18 +999,19 @@ use Carp;
END
}
-print PM <<'END';
+print PM <<'END' unless $skip_exporter;
require Exporter;
END
-print PM <<"END" if ! $opt_X; # use DynaLoader, unless XS was disabled
+my $use_Dyna = (not $opt_X and $compat_version < 5.006);
+print PM <<"END" if $use_Dyna; # use DynaLoader, unless XS was disabled
require DynaLoader;
END
# Are we using AutoLoader or not?
-unless ($opt_A) { # no autoloader whatsoever.
+unless ($skip_autoloader) { # no autoloader whatsoever.
unless ($opt_c) { # we're doing the AUTOLOAD
print PM "use AutoLoader;\n";
}
@@ -976,23 +1022,33 @@ unless ($opt_A) { # no autoloader whatsoever.
if ( $compat_version < 5.006 ) {
if ( $opt_X || $opt_c || $opt_A ) {
- print PM 'use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);';
+ if ($skip_exporter) {
+ print PM 'use vars qw($VERSION @ISA);';
+ } else {
+ print PM 'use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);';
+ }
} else {
- print PM 'use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);';
+ if ($skip_exporter) {
+ print PM 'use vars qw($VERSION @ISA $AUTOLOAD);';
+ } else {
+ print PM 'use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);';
+ }
}
}
# Determine @ISA.
-my $myISA = 'our @ISA = qw(Exporter'; # We seem to always want this.
-$myISA .= ' DynaLoader' unless $opt_X; # no XS
-$myISA .= ');';
+my @modISA;
+push @modISA, 'Exporter' unless $skip_exporter;
+push @modISA, 'DynaLoader' if $use_Dyna; # no XS
+my $myISA = "our \@ISA = qw(@modISA);";
$myISA =~ s/^our // if $compat_version < 5.006;
print PM "\n$myISA\n\n";
my @exported_names = (@const_names, @fnames_no_prefix, map '$'.$_, @vdecls);
-my $tmp=<<"END";
+my $tmp='';
+$tmp .= <<"END" unless $skip_exporter;
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@@ -1009,6 +1065,10 @@ our \@EXPORT_OK = ( \@{ \$EXPORT_TAGS{'all'} } );
our \@EXPORT = qw(
@const_names
);
+
+END
+
+$tmp .= <<"END";
our \$VERSION = '$TEMPLATE_VERSION';
END
@@ -1024,9 +1084,16 @@ if (@vdecls) {
print PM autoload ($module, $compat_version) unless $opt_c or $opt_X;
if( ! $opt_X ){ # print bootstrap, unless XS is disabled
+ if ($use_Dyna) {
print PM <<"END";
bootstrap $module \$VERSION;
END
+ } else {
+ print PM <<"END";
+require XSLoader;
+XSLoader::load('$module', \$VERSION);
+END
+ }
}
# tying the variables can happen only after bootstrap
@@ -1096,7 +1163,7 @@ $revhist = <<EOT if $opt_C;
#
EOT
-my $exp_doc = <<EOD;
+my $exp_doc = $skip_exporter ? '' : <<EOD;
#
#=head2 EXPORT
#
@@ -1105,7 +1172,7 @@ my $exp_doc = <<EOD;
EOD
if (@const_names and not $opt_P) {
- $exp_doc .= <<EOD;
+ $exp_doc .= <<EOD unless $skip_exporter;
#=head2 Exportable constants
#
# @{[join "\n ", @const_names]}
@@ -1114,7 +1181,7 @@ EOD
}
if (defined $fdecls and @$fdecls and not $opt_P) {
- $exp_doc .= <<EOD;
+ $exp_doc .= <<EOD unless $skip_exporter;
#=head2 Exportable functions
#
EOD
@@ -1123,7 +1190,7 @@ EOD
#When accessing these functions from Perl, prefix C<$opt_p> should be removed.
#
#EOD
- $exp_doc .= <<EOD;
+ $exp_doc .= <<EOD unless $skip_exporter;
# @{[join "\n ", @known_fnames{@fnames}]}
#
EOD
@@ -1203,9 +1270,14 @@ print XS <<"END";
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
+
+END
+
+print XS <<"END" unless $skip_ppport;
#include "ppport.h"
END
+
if( @path_h ){
foreach my $path_h (@path_h_ini) {
my($h) = $path_h;