Version v5.7.2 Development release working toward v5.8
--------------
____________________________________________________________________________
+[ 13810] By: jhi on 2001/12/19 16:50:12
+ Log: Subject: Re: [BUG] bleadperl regexp (was ok in 5.6.0)
+ From: Wolfgang Laun <Wolfgang.Laun@alcatel.at>
+ Date: Wed, 19 Dec 2001 12:35:07 +0100
+ Message-ID: <3C207B6B.A687A8EC@alcatel.at>
+
+ Subject: Re: [BUG] bleadperl regexp (was ok in 5.6.0)
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Date: Wed, 19 Dec 2001 17:34:51 +0000
+ Message-Id: <200112191734.fBJHYpd30715@crypt.compulink.co.uk>
+ Branch: perl
+ ! pod/perlre.pod
+____________________________________________________________________________
+[ 13809] By: jhi on 2001/12/19 16:47:11
+ Log: Integrate perlio.
+ Branch: perl
+ !> ext/Encode/Encode.xs ext/PerlIO/Scalar/Scalar.xs
+ !> ext/PerlIO/Via/Via.xs perlio.c perliol.h
+____________________________________________________________________________
+[ 13807] By: jhi on 2001/12/19 15:59:02
+ Log: One more embedded (?sx) de-embedded, from Wolfgang Laun.
+ Branch: perl
+ ! ext/B/B/Assembler.pm
+____________________________________________________________________________
+[ 13806] By: jhi on 2001/12/19 15:08:29
+ Log: Reword the alarm explanation.
+ Branch: perl
+ ! pod/perlfunc.pod
+____________________________________________________________________________
+[ 13805] By: jhi on 2001/12/19 15:04:03
+ Log: Subject: [PATCH @13746] OS/2 build
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Wed, 19 Dec 2001 02:45:41 -0500
+ Message-ID: <20011219024541.A29803@math.ohio-state.edu>
+
+ (skipped the t/TEST change)
+ Branch: perl
+ ! lib/English.t lib/ExtUtils/t/Embed.t lib/File/stat.t
+ ! lib/Shell.t os2/Makefile.SHs os2/OS2/REXX/DLL/Makefile.PL
+ ! os2/os2.c os2/perlrexx.c t/op/alarm.t util.c
+____________________________________________________________________________
+[ 13804] By: jhi on 2001/12/19 14:55:26
+ Log: Upgrade to Net::Ping 2.09.
+ Branch: perl
+ + lib/Net/Ping/CHANGES lib/Net/Ping/README
+ + lib/Net/Ping/t/100_load.t lib/Net/Ping/t/110_icmp_inst.t
+ + lib/Net/Ping/t/120_udp_inst.t lib/Net/Ping/t/130_tcp_inst.t
+ + lib/Net/Ping/t/140_stream_inst.t lib/Net/Ping/t/200_ping_tcp.t
+ + lib/Net/Ping/t/300_ping_stream.t
+ ! MANIFEST lib/Net/Ping.pm
+____________________________________________________________________________
+[ 13802] By: jhi on 2001/12/19 14:25:27
+ Log: B::Assembler/B::Disassembler patches and test;
+ from Wolfgang Laun.
+
+ TODO: getting perlcc working.
+ Branch: perl
+ + ext/B/t/assembler.t
+ ! MANIFEST ext/B/B/Assembler.pm ext/B/B/Disassembler.pm
+____________________________________________________________________________
+[ 13801] By: jhi on 2001/12/19 14:18:10
+ Log: Can't printf U8s as UVs.
+ Branch: perl
+ ! utf8.c
+____________________________________________________________________________
+[ 13800] By: jhi on 2001/12/19 14:12:02
+ Log: Subject: Re: [PATCH] ...while $var = glob(...)
+ From: Robin Houston <robin@kitsite.com>
+ Date: Wed, 19 Dec 2001 13:48:55 +0000
+ Message-ID: <20011219134855.A20452@puffinry.freeserve.co.uk>
+
+ Not exactly a glob test but internal-logically correct.
+ Branch: perl
+ ! t/op/glob.t
+____________________________________________________________________________
+[ 13799] By: jhi on 2001/12/19 13:51:37
+ Log: Subject: [PATCH lib/lib_pm.PL lib/lib.t] portability snag
+ From: Michael G Schwern <schwern@pobox.com>
+ Date: Wed, 19 Dec 2001 07:42:54 -0500
+ Message-ID: <20011219124254.GF8630@blackrider>
+ Branch: perl
+ + lib/lib.t
+ ! MANIFEST lib/lib_pm.PL
+____________________________________________________________________________
+[ 13798] By: jhi on 2001/12/19 13:35:59
+ Log: Integrate with perlio.
+ Branch: perl
+ !> hv.c hv.h scope.c util.c
+____________________________________________________________________________
+[ 13793] By: jhi on 2001/12/19 04:58:51
+ Log: Regen toc.
+ Branch: perl
+ ! pod/perltoc.pod
+____________________________________________________________________________
+[ 13792] By: jhi on 2001/12/19 04:56:42
+ Log: FAQ sync.
+ Branch: perl
+ ! pod/perlfaq5.pod
+____________________________________________________________________________
+[ 13791] By: jhi on 2001/12/19 04:38:47
+ Log: Reformat round.
+ Branch: perl
+ ! pod/perlunicode.pod
+____________________________________________________________________________
+[ 13790] By: jhi on 2001/12/19 04:32:06
+ Log: Subject: [PATCH] pod/perlunicode.pod
+ From: Jeffrey Friedl <jfriedl@yahoo.com>
+ Date: Tue, 18 Dec 2001 21:31:13 -0800 (PST)
+ Message-Id: <200112190531.fBJ5VDp57308@ventrue.corp.yahoo.com>
+ Branch: perl
+ ! pod/perlunicode.pod
+____________________________________________________________________________
+[ 13789] By: jhi on 2001/12/19 04:16:39
+ Log: Subject: Re: [PATCH] pod/perluniintro.pod (removes unnecessary UTF-8 references)
+ From: Jeffrey Friedl <jfriedl@yahoo.com>
+ Date: Tue, 18 Dec 2001 21:13:59 -0800 (PST)
+ Message-Id: <200112190513.fBJ5DxN56315@ventrue.corp.yahoo.com>
+ Branch: perl
+ ! pod/perluniintro.pod
+____________________________________________________________________________
+[ 13788] By: jhi on 2001/12/19 03:54:08
+ Log: Slight pod reformatting.
+ Branch: perl
+ ! pod/perluniintro.pod
+____________________________________________________________________________
+[ 13787] By: jhi on 2001/12/19 03:41:45
+ Log: Subject: [PATCH] pod/perluniintro.pod (removes unnecessary UTF-8 references)
+ From: Jeffrey Friedl <jfriedl@yahoo.com>
+ Date: Tue, 18 Dec 2001 20:27:42 -0800 (PST)
+ Message-Id: <200112190427.fBJ4RgP53458@ventrue.corp.yahoo.com>
+ Branch: perl
+ ! pod/perluniintro.pod
+____________________________________________________________________________
+[ 13786] By: jhi on 2001/12/19 01:14:04
+ Log: Subject: Re: [ID 20011213.001] Segfault with overload and Test
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Date: Wed, 19 Dec 2001 01:45:23 +0000
+ Message-Id: <200112190145.fBJ1jNt23668@crypt.compulink.co.uk>
+ Branch: perl
+ ! sv.c
+____________________________________________________________________________
+[ 13785] By: jhi on 2001/12/19 01:11:45
+ Log: Subject: Porting/checkURL.pl
+ From: abigail@foad.org
+ Date: Tue, 18 Dec 2001 19:03:22 +0100
+ Message-ID: <20011218180322.8278.qmail@foad.org>
+ Branch: perl
+ ! Porting/checkURL.pl
+____________________________________________________________________________
+[ 13783] By: jhi on 2001/12/19 00:26:34
+ Log: A bit too oversweeping matching in #13778.
+ Branch: perl
+ ! Configure
+____________________________________________________________________________
+[ 13782] By: jhi on 2001/12/19 00:09:10
+ Log: Re-gen Configure based on #13778..13781.
+ Branch: perl
+ ! Configure config_h.SH
+____________________________________________________________________________
+[ 13767] By: jhi on 2001/12/18 22:13:14
+ Log: Subject: Re: Benchmark.t failure on Linux
+ From: Nicholas Clark <nick@ccl4.org>
+ Date: Tue, 18 Dec 2001 22:51:25 +0000
+ Message-ID: <20011218225124.N21702@plum.flirble.org>
+ Branch: perl
+ ! lib/Benchmark.t
+____________________________________________________________________________
+[ 13766] By: jhi on 2001/12/18 22:07:35
+ Log: Re-applying #13752 until a better solution can be found.
+ Branch: perl
+ ! lib/ExtUtils/t/MM_Unix.t
+____________________________________________________________________________
+[ 13765] By: jhi on 2001/12/18 21:05:13
+ Log: Subject: [PATCH] Suggested doc enhancement(?) to Exporter.pm
+ From: "Giroux, Mike (Exchange)" <mgiroux@bear.com>
+ Date: Tue, 18 Dec 2001 12:05:40 -0500
+ Message-ID: <03CF7D5B2CFFD211990300A0C95DEA0C080BEB5A@whmsx18.is.bear.com>
+ Branch: perl
+ ! lib/Exporter.pm
+____________________________________________________________________________
+[ 13764] By: jhi on 2001/12/18 20:58:44
+ Log: %g -> NVgf cleanup, based on Schwern's RedHat 7.1/Alpha
+ findings -- some of the warnings I can't explain except
+ by NVgf being detected wrong, though.
+ Branch: perl
+ ! dump.c pp.c sv.c x2p/a2p.h x2p/str.c
+____________________________________________________________________________
+[ 13763] By: jhi on 2001/12/18 20:54:28
+ Log: Subject: [PATCH] pod/perluniintro.pod
+ From: Jeffrey Friedl <jfriedl@yahoo.com>
+ Date: Tue, 18 Dec 2001 10:27:45 -0800 (PST)
+ Message-Id: <200112181827.fBIIRjv16547@ventrue.corp.yahoo.com>
+ Branch: perl
+ ! pod/perluniintro.pod
+____________________________________________________________________________
+[ 13762] By: jhi on 2001/12/18 17:49:07
+ Log: ".pm" is the native executable suffix in VOS.
+ Branch: perl
+ ! hints/vos.sh
+____________________________________________________________________________
+[ 13761] By: jhi on 2001/12/18 15:57:39
+ Log: Integrate perlio;
+ Tidied version of Jeffrey Friedl's <jfriedl@yahoo.com> restricted hashes
+ Branch: perl
+ !> ext/Devel/Peek/Peek.t hv.c hv.h scope.c sv.c t/lib/access.t
+____________________________________________________________________________
+[ 13759] By: jhi on 2001/12/18 15:54:19
+ Log: (Undone by #13766.)
+ Retract #13752.
+ Branch: perl
+ ! lib/ExtUtils/t/MM_Unix.t
+____________________________________________________________________________
+[ 13758] By: jhi on 2001/12/18 15:26:18
+ Log: Echoes of #13757.
+ Branch: perl
+ ! t/lib/warnings/utf8
+____________________________________________________________________________
+[ 13757] By: jhi on 2001/12/18 15:24:50
+ Log: Make the utf8 malformedness messages more verbose.
+ Branch: perl
+ ! lib/utf8.t utf8.c
+____________________________________________________________________________
+[ 13755] By: jhi on 2001/12/18 14:05:26
+ Log: README.aix updates from Jens-Uwe Mager.
+ Branch: perl
+ ! README.aix
+____________________________________________________________________________
+[ 13754] By: jhi on 2001/12/18 14:03:31
+ Log: Subject: [PATCH lib/Benchmark.t] Show value of $fastslow on failure
+ From: Michael G Schwern <schwern@pobox.com>
+ Date: Tue, 18 Dec 2001 00:58:18 -0500
+ Message-ID: <20011218055818.GC4362@blackrider>
+ Branch: perl
+ ! lib/Benchmark.t
+____________________________________________________________________________
+[ 13753] By: jhi on 2001/12/18 14:02:49
+ Log: Subject: [PATCH lib/ExtUtils/t/Installed.t] Making it somewhat more portable
+ From: Michael G Schwern <schwern@pobox.com>
+ Date: Tue, 18 Dec 2001 00:40:38 -0500
+ Message-ID: <20011218054038.GB4362@blackrider>
+ Branch: perl
+ ! lib/ExtUtils/Installed.pm lib/ExtUtils/t/Installed.t
+____________________________________________________________________________
+[ 13752] By: jhi on 2001/12/18 14:01:44
+ Log: (reintroduced by #13766)
+ (retracted by #13759)
+
+ Subject: [PATCH lib/ExtUtils/t/MM_Unix.t] All the world's not a Unix
+ From: Michael G Schwern <schwern@pobox.com>
+ Date: Tue, 18 Dec 2001 00:00:23 -0500
+ Message-ID: <20011218050023.GA27893@blackrider>
+ Branch: perl
+ ! lib/ExtUtils/t/MM_Unix.t
+____________________________________________________________________________
+[ 13751] By: jhi on 2001/12/18 13:59:32
+ Log: Re-patch #13749.
+ Branch: perl
+ ! t/op/glob.t
+____________________________________________________________________________
+[ 13750] By: jhi on 2001/12/18 13:56:34
+ Log: Subject: [doc patch] s{(?<=perldeb)ug}{guts}
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Date: Tue, 18 Dec 2001 12:55:43 +0000
+ Message-Id: <200112181255.fBICthb09977@crypt.compulink.co.uk>
+ Branch: perl
+ ! ext/Devel/Peek/Peek.pm
+____________________________________________________________________________
+[ 13749] By: jhi on 2001/12/18 13:55:12
+ Log: Subject: Third time lucky? (Re: [PATCH] ...while $var = glob(...))
+ From: Robin Houston <robin@kitsite.com>
+ Date: Tue, 18 Dec 2001 14:54:33 +0000
+ Message-ID: <20011218145433.A18835@puffinry.freeserve.co.uk>
+ Branch: perl
+ ! t/op/glob.t
+____________________________________________________________________________
+[ 13748] By: jhi on 2001/12/17 23:54:41
+ Log: Subject: [PATCH] slightly more for Exporter.pm
+ From: Nicholas Clark <nick@ccl4.org>
+ Date: Tue, 18 Dec 2001 00:22:03 +0000
+ Message-ID: <20011218002203.M21702@plum.flirble.org>
+ Branch: perl
+ ! lib/Exporter.pm
+____________________________________________________________________________
+[ 13747] By: jhi on 2001/12/17 21:59:07
+ Log: Subject: [PATCH] Re: chomp/chop prototype changed?
+ From: Rafael Garcia-Suarez <rgarciasuarez@free.fr>
+ Date: Mon, 17 Dec 2001 16:37:18 +0100
+ Message-ID: <20011217163718.A2292@rafael>
+
+ Subject: Re: [PATCH] Re: chomp/chop prototype changed?
+ From: Rafael Garcia-Suarez <rgarciasuarez@free.fr>
+ Date: Mon, 17 Dec 2001 23:17:06 +0100
+ Message-ID: <20011217231706.A730@rafael>
+ Branch: perl
+ ! pod/perlsub.pod pp.c toke.c
+____________________________________________________________________________
+[ 13746] By: jhi on 2001/12/17 20:22:08
+ Log: Update Changes.
+ Branch: perl
+ ! Changes patchlevel.h
+____________________________________________________________________________
[ 13745] By: jhi on 2001/12/17 20:12:37
Log: New test warrants a MANIFEST entry.
Branch: perl
lib/Net/Netrc.pm libnet
lib/Net/NNTP.pm libnet
lib/Net/Ping.pm Hello, anybody home?
+lib/Net/Ping/CHANGES Net::Ping
+lib/Net/Ping/README Net::Ping
+lib/Net/Ping/t/100_load.t Ping Net::Ping
+lib/Net/Ping/t/110_icmp_inst.t Ping Net::Ping
+lib/Net/Ping/t/120_udp_inst.t Ping Net::Ping
+lib/Net/Ping/t/130_tcp_inst.t Ping Net::Ping
+lib/Net/Ping/t/140_stream_inst.t Ping Net::Ping
+lib/Net/Ping/t/200_ping_tcp.t Ping Net::Ping
+lib/Net/Ping/t/300_ping_stream.t Ping Net::Ping
lib/Net/POP3.pm libnet
lib/Net/protoent.pm By-name interface to Perl's builtin getproto*
lib/Net/protoent.t See if Net::protoent works
#define invert Perl_invert
#define is_gv_magical Perl_is_gv_magical
#define is_lvalue_sub Perl_is_lvalue_sub
+#define to_uni_upper_lc Perl_to_uni_upper_lc
+#define to_uni_title_lc Perl_to_uni_title_lc
+#define to_uni_lower_lc Perl_to_uni_lower_lc
#define is_uni_alnum Perl_is_uni_alnum
#define is_uni_alnumc Perl_is_uni_alnumc
#define is_uni_idfirst Perl_is_uni_idfirst
#define invert(a) Perl_invert(aTHX_ a)
#define is_gv_magical(a,b,c) Perl_is_gv_magical(aTHX_ a,b,c)
#define is_lvalue_sub() Perl_is_lvalue_sub(aTHX)
+#define to_uni_upper_lc(a) Perl_to_uni_upper_lc(aTHX_ a)
+#define to_uni_title_lc(a) Perl_to_uni_title_lc(aTHX_ a)
+#define to_uni_lower_lc(a) Perl_to_uni_lower_lc(aTHX_ a)
#define is_uni_alnum(a) Perl_is_uni_alnum(aTHX_ a)
#define is_uni_alnumc(a) Perl_is_uni_alnumc(aTHX_ a)
#define is_uni_idfirst(a) Perl_is_uni_idfirst(aTHX_ a)
p |bool |io_close |IO* io|bool not_implicit
p |OP* |invert |OP* cmd
dp |bool |is_gv_magical |char *name|STRLEN len|U32 flags
-p |I32 |is_lvalue_sub
+Ap |I32 |is_lvalue_sub
+Ap |U32 |to_uni_upper_lc|U32 c
+Ap |U32 |to_uni_title_lc|U32 c
+Ap |U32 |to_uni_lower_lc|U32 c
Ap |bool |is_uni_alnum |UV c
Ap |bool |is_uni_alnumc |UV c
Ap |bool |is_uni_idfirst |UV c
#define PL_maxscream (vTHX->Tmaxscream)
#define PL_modcount (vTHX->Tmodcount)
#define PL_na (vTHX->Tna)
+#define PL_nrs (vTHX->Tnrs)
#define PL_ofs_sv (vTHX->Tofs_sv)
#define PL_op (vTHX->Top)
#define PL_opsave (vTHX->Topsave)
#define PL_tmps_stack (vTHX->Ttmps_stack)
#define PL_top_env (vTHX->Ttop_env)
#define PL_toptarget (vTHX->Ttoptarget)
-#define PL_unused_1 (vTHX->Tunused_1)
#define PL_watchaddr (vTHX->Twatchaddr)
#define PL_watchok (vTHX->Twatchok)
#define PL_maxscream (aTHX->Tmaxscream)
#define PL_modcount (aTHX->Tmodcount)
#define PL_na (aTHX->Tna)
+#define PL_nrs (aTHX->Tnrs)
#define PL_ofs_sv (aTHX->Tofs_sv)
#define PL_op (aTHX->Top)
#define PL_opsave (aTHX->Topsave)
#define PL_tmps_stack (aTHX->Ttmps_stack)
#define PL_top_env (aTHX->Ttop_env)
#define PL_toptarget (aTHX->Ttoptarget)
-#define PL_unused_1 (aTHX->Tunused_1)
#define PL_watchaddr (aTHX->Twatchaddr)
#define PL_watchok (aTHX->Twatchok)
#define PL_Tmaxscream PL_maxscream
#define PL_Tmodcount PL_modcount
#define PL_Tna PL_na
+#define PL_Tnrs PL_nrs
#define PL_Tofs_sv PL_ofs_sv
#define PL_Top PL_op
#define PL_Topsave PL_opsave
#define PL_Ttmps_stack PL_tmps_stack
#define PL_Ttop_env PL_top_env
#define PL_Ttoptarget PL_toptarget
-#define PL_Tunused_1 PL_unused_1
#define PL_Twatchaddr PL_watchaddr
#define PL_Twatchok PL_watchok
sub strip_comments {
my $stmt = shift;
# Comments only allowed in instructions which don't take string arguments
+ # Treat string as a single line so .* eats \n characters.
$stmt =~ s{
- (?sx) # Snazzy extended regexp coming up. Also, treat
- # string as a single line so .* eats \n characters.
^\s* # Ignore leading whitespace
(
[^"]* # A double quote '"' indicates a string argument. If we
)
\s*\# # Any amount of whitespace plus the comment marker...
.*$ # ...which carries on to end-of-string.
- }{$1}; # Keep only the instruction and optional argument.
+ }{$1}sx; # Keep only the instruction and optional argument.
return $stmt;
}
is( $DEBUGGING, $^D, '$DEBUGGING' );
is( $WARNING, 0, '$WARNING' );
-like( $EXECUTABLE_NAME, qr/perl/, '$EXECUTABLE_NAME' );
+like( $EXECUTABLE_NAME, qr/perl/i, '$EXECUTABLE_NAME' );
is( $OSNAME, $Config{osname}, '$OSNAME' );
# may be non-portable
print "1..9\n";
my $cc = $Config{'cc'};
my $cl = ($^O eq 'MSWin32' && $cc eq 'cl');
-my $exe = 'embed_test' . $Config{'exe_ext'};
+my $skip_exe = $^O eq 'os2' && $Config{ldflags} =~ /(?<!\S)-Zexe\b/;
+my $exe = 'embed_test';
+$exe .= $Config{'exe_ext'} unless $skip_exe; # Linker will auto-append it
my $obj = 'embed_test' . $Config{'obj_ext'};
my $inc = File::Spec->updir;
my $lib = File::Spec->updir;
local $SIG{__WARN__} = sub {
warn $_[0] unless $_[0] =~ /No library found for -lperl/
};
+ push(@cmd, '-Zlinker', '/PM:VIO') # Otherwise puts a warning to STDOUT!
+ if $^O eq 'os2' and $Config{ldflags} =~ /(?<!\S)-Zomf\b/;
push(@cmd,ldopts());
}
$status = system($embed_test);
print (($status? 'not ':'')."ok 9 # $status\n");
unlink($exe,"embed_test.c",$obj);
+unlink("$exe$Config{exe_ext}") if $skip_exe;
unlink("embed_test.map","embed_test.lis") if $^O eq 'VMS';
unlink(glob("./libperl*.dll")) if $^O eq 'cygwin';
unlink("../libperl.a") if $^O eq 'cygwin';
# On OS/2 (fake) ino is not constant, it is incremented each time
SKIP: {
- skip(1, 'inode number is not constant on OS/2') if $^O eq 'os2';
+ skip('inode number is not constant on OS/2', 1) if $^O eq 'os2';
is( $stat->ino, $stat[1], "inode number in position 1" );
}
package Net::Ping;
-# $Id: Ping.pm,v 1.11 2001/12/04 02:41:51 rob Exp $
+# $Id: Ping.pm,v 1.13 2001/12/07 02:18:44 rob Exp $
require 5.002;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(pingecho);
-$VERSION = 2.07;
+$VERSION = 2.09;
# Constants
$child = waitpid($pid, &POSIX::WNOHANG);
$! = $? >> 8;
$@ = $!;
- sleep 1;
+ select(undef, undef, undef, 0.1);
} while time < $patience && $child != $pid;
if ($child == $pid) {
Net::Ping - check a remote host for reachability
-$Id: Ping.pm,v 1.11 2001/12/04 02:41:51 rob Exp $
+$Id: Ping.pm,v 1.13 2001/12/07 02:18:44 rob Exp $
=head1 SYNOPSIS
--- /dev/null
+CHANGES
+-------
+
+2.09 Dec 06 19:00 2001
+ - Documental and test changes only.
+ - No functional changes.
+
+2.08 Dec 04 13:00 2001
+ - Faster response for Win32 tcp_connect.
+ - Better explanations in test comments.
+
+2.07 Nov 28 13:00 2001
+ - Compatibility changes
+ - Works with UNIX and Win32 OS
+ - Works with Perl 5.005 5.6.x 5.7.x 5.8.x
+ - Applied several patches from distro
+ - External protocol added thanks to
+ colinm@cpan.org (Colin McMillen)
+ - Stream protocol added thanks to
+ bronson@trestle.com (Scott Bronson)
+
+2.06 Nov 19 12:00 2001
+ - Added Net-Ping.spec for RPM to easily
+ utilize using "rpm -ta Net-Ping*tar.gz"
+ - Moved Copyright section to perldoc
+
+2.05 Nov 18 20:00 2001
+ - Added test suite
+
+2.04 Nov 16 16:00 2001
+ - Added CHANGES and README to tarball.
+ - No functional changes.
+
+2.03 Nov 15 12:00 2001
+ - Portability adjustments to ping_tcp()
+ made by Rob Brown to work with most
+ default systems.
+
+2.02 Sep 27 12:00 1996
+ - Magic version by Russell Mosemann from CPAN
--- /dev/null
+NAME
+ Net::Ping - check a remote host for reachability
+
+ $Id: Ping.pm,v 1.13 2001/12/07 02:18:44 rob Exp $
+
+SYNOPSIS
+ use Net::Ping;
+
+ $p = Net::Ping->new();
+ print "$host is alive.\n" if $p->ping($host);
+ $p->close();
+
+ $p = Net::Ping->new("icmp");
+ foreach $host (@host_array)
+ {
+ print "$host is ";
+ print "NOT " unless $p->ping($host, 2);
+ print "reachable.\n";
+ sleep(1);
+ }
+ $p->close();
+
+ $p = Net::Ping->new("tcp", 2);
+ # Try connecting to the www port instead of the echo port
+ $p->{port_num} = getservbyname("http", "tcp");
+ while ($stop_time > time())
+ {
+ print "$host not reachable ", scalar(localtime()), "\n"
+ unless $p->ping($host);
+ sleep(300);
+ }
+ undef($p);
+
+ # For backward compatibility
+ print "$host is alive.\n" if pingecho($host);
+
+DESCRIPTION
+ This module contains methods to test the reachability of remote hosts on
+ a network. A ping object is first created with optional parameters, a
+ variable number of hosts may be pinged multiple times and then the
+ connection is closed.
+
+ You may choose one of four different protocols to use for the ping. The
+ "udp" protocol is the default. Note that a live remote host may still
+ fail to be pingable by one or more of these protocols. For example,
+ www.microsoft.com is generally alive but not pingable.
+
+ With the "tcp" protocol the ping() method attempts to establish a
+ connection to the remote host's echo port. If the connection is
+ successfully established, the remote host is considered reachable. No
+ data is actually echoed. This protocol does not require any special
+ privileges but has higher overhead than the other two protocols.
+
+ Specifying the "udp" protocol causes the ping() method to send a udp
+ packet to the remote host's echo port. If the echoed packet is received
+ from the remote host and the received packet contains the same data as
+ the packet that was sent, the remote host is considered reachable. This
+ protocol does not require any special privileges. It should be borne in
+ mind that, for a udp ping, a host will be reported as unreachable if it
+ is not running the appropriate echo service. For Unix-like systems see
+ the inetd(8) manpage for more information.
+
+ If the "icmp" protocol is specified, the ping() method sends an icmp
+ echo message to the remote host, which is what the UNIX ping program
+ does. If the echoed message is received from the remote host and the
+ echoed information is correct, the remote host is considered reachable.
+ Specifying the "icmp" protocol requires that the program be run as root
+ or that the program be setuid to root.
+
+ If the "external" protocol is specified, the ping() method attempts to
+ use the `Net::Ping::External' module to ping the remote host.
+ `Net::Ping::External' interfaces with your system's default `ping'
+ utility to perform the ping, and generally produces relatively accurate
+ results. If `Net::Ping::External' if not installed on your system,
+ specifying the "external" protocol will result in an error.
+
+ Functions
+
+ Net::Ping->new([$proto [, $def_timeout [, $bytes]]]);
+ Create a new ping object. All of the parameters are optional. $proto
+ specifies the protocol to use when doing a ping. The current choices
+ are "tcp", "udp" or "icmp". The default is "udp".
+
+ If a default timeout ($def_timeout) in seconds is provided, it is
+ used when a timeout is not given to the ping() method (below). The
+ timeout must be greater than 0 and the default, if not specified, is
+ 5 seconds.
+
+ If the number of data bytes ($bytes) is given, that many data bytes
+ are included in the ping packet sent to the remote host. The number
+ of data bytes is ignored if the protocol is "tcp". The minimum (and
+ default) number of data bytes is 1 if the protocol is "udp" and 0
+ otherwise. The maximum number of data bytes that can be specified is
+ 1024.
+
+ $p->ping($host [, $timeout]);
+ Ping the remote host and wait for a response. $host can be either
+ the hostname or the IP number of the remote host. The optional
+ timeout must be greater than 0 seconds and defaults to whatever was
+ specified when the ping object was created. If the hostname cannot
+ be found or there is a problem with the IP number, undef is
+ returned. Otherwise, 1 is returned if the host is reachable and 0 if
+ it is not. For all practical purposes, undef and 0 and can be
+ treated as the same case.
+
+ $p->open($host);
+ When you are using the stream protocol, this call pre-opens the tcp
+ socket. It's only necessary to do this if you want to provide a
+ different timeout when creating the connection, or remove the
+ overhead of establishing the connection from the first ping. If you
+ don't call `open()', the connection is automatically opened the
+ first time `ping()' is called. This call simply does nothing if you
+ are using any protocol other than stream.
+
+ $p->open($host);
+ When you are using the stream protocol, this call pre-opens the tcp
+ socket. It's only necessary to do this if you want to provide a
+ different timeout when creating the connection, or remove the
+ overhead of establishing the connection from the first ping. If you
+ don't call `open()', the connection is automatically opened the
+ first time `ping()' is called. This call simply does nothing if you
+ are using any protocol other than stream.
+
+ $p->close();
+ Close the network connection for this ping object. The network
+ connection is also closed by "undef $p". The network connection is
+ automatically closed if the ping object goes out of scope (e.g. $p
+ is local to a subroutine and you leave the subroutine).
+
+ pingecho($host [, $timeout]);
+ To provide backward compatibility with the previous version of
+ Net::Ping, a pingecho() subroutine is available with the same
+ functionality as before. pingecho() uses the tcp protocol. The
+ return values and parameters are the same as described for the
+ ping() method. This subroutine is obsolete and may be removed in a
+ future version of Net::Ping.
+
+WARNING
+ pingecho() or a ping object with the tcp protocol use alarm() to
+ implement the timeout. So, don't use alarm() in your program while you
+ are using pingecho() or a ping object with the tcp protocol. The udp and
+ icmp protocols do not use alarm() to implement the timeout.
+
+NOTES
+ There will be less network overhead (and some efficiency in your
+ program) if you specify either the udp or the icmp protocol. The tcp
+ protocol will generate 2.5 times or more traffic for each ping than
+ either udp or icmp. If many hosts are pinged frequently, you may wish to
+ implement a small wait (e.g. 25ms or more) between each ping to avoid
+ flooding your network with packets.
+
+ The icmp protocol requires that the program be run as root or that it be
+ setuid to root. The other protocols do not require special privileges,
+ but not all network devices implement tcp or udp echo.
+
+ Local hosts should normally respond to pings within milliseconds.
+ However, on a very congested network it may take up to 3 seconds or
+ longer to receive an echo packet from the remote host. If the timeout is
+ set too low under these conditions, it will appear that the remote host
+ is not reachable (which is almost the truth).
+
+ Reachability doesn't necessarily mean that the remote host is actually
+ functioning beyond its ability to echo packets. tcp is slightly better
+ at indicating the health of a system than icmp because it uses more of
+ the networking stack to respond.
+
+ Because of a lack of anything better, this module uses its own routines
+ to pack and unpack ICMP packets. It would be better for a separate
+ module to be written which understands all of the different kinds of
+ ICMP packets.
+
+AUTHOR(S)
+ Current maintainer Net::Ping base code:
+ colinm@cpan.org (Colin McMillen)
+
+ Stream protocol:
+ bronson@trestle.com (Scott Bronson)
+
+ Original pingecho():
+ karrer@bernina.ethz.ch (Andreas Karrer)
+ pmarquess@bfsec.bt.co.uk (Paul Marquess)
+
+ Original Net::Ping author:
+ mose@ns.ccsn.edu (Russell Mosemann)
+
+ Compatibility porting:
+ bbb@cpan.org (Rob Brown)
+
+COPYRIGHT
+ Copyright (c) 2001, Colin McMillen. All rights reserved. Copyright (c)
+ 2001, Rob Brown. All rights reserved.
+
+ This program is free software; you may redistribute it and/or modify it
+ under the same terms as Perl itself.
+
--- /dev/null
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.t'
+
+######################### We start with some black magic to print on failure.
+
+use Test;
+BEGIN { plan tests => 1; $loaded = 0}
+END { ok $loaded;}
+
+# Just make sure everything compiles
+use Net::Ping;
+
+$loaded = 1;
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
--- /dev/null
+# Test to make sure object can be instantiated for icmp protocol.
+# Root access is required to actually perform icmp testing.
+
+use Test;
+use Net::Ping;
+plan tests => 2;
+
+# Everything loaded fine
+ok 1;
+
+my $p = new Net::Ping "tcp";
+ok !!$p;
--- /dev/null
+# Test to make sure object can be instantiated for udp protocol.
+# I do not know of any servers that support udp echo anymore.
+
+use Test;
+use Net::Ping;
+plan tests => 2;
+
+# Everything loaded fine
+ok 1;
+
+my $p = new Net::Ping "udp";
+ok !!$p;
--- /dev/null
+# Test to make sure object can be instantiated for tcp protocol.
+
+use Test;
+use Net::Ping;
+plan tests => 2;
+
+# Everything loaded fine
+ok 1;
+
+my $p = new Net::Ping "tcp";
+ok !!$p;
--- /dev/null
+# Test to make sure object can be instantiated for stream protocol.
+
+use Test;
+use Net::Ping;
+plan tests => 2;
+
+# Everything loaded fine
+ok 1;
+
+my $p = new Net::Ping "stream";
+ok !!$p;
--- /dev/null
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ unless ($ENV{PERL_TEST_Net_Ping}) {
+ print "1..0 # Skip: network dependent test\n";
+ exit;
+ }
+ chdir 't' if -d 't';
+ @INC = qw(../lib);
+ }
+}
+
+# Remote network test using tcp protocol.
+#
+# NOTE:
+# Network connectivity will be required for all tests to pass.
+# Firewalls may also cause some tests to fail, so test it
+# on a clear network. If you know you do not have a direct
+# connection to remote networks, but you still want the tests
+# to pass, use the following:
+#
+# $ PERL_CORE=1 make test
+
+use Test;
+use Net::Ping;
+plan tests => 13;
+
+# Everything loaded fine
+ok 1;
+
+my $p = new Net::Ping "tcp";
+
+# new() worked?
+ok !!$p;
+
+# Test on the default port
+ok $p -> ping("localhost");
+
+# Change to use the more common web port.
+# This will pull from /etc/services on UNIX.
+# (Make sure getservbyname works in scalar context.)
+ok ($p -> {port_num} = (getservbyname("http", "tcp") || 80));
+
+# Test localhost on the web port
+ok $p -> ping("localhost");
+
+# Hopefully this is not a routeable host
+ok !$p -> ping("10.12.14.16");
+
+# Test a few remote servers
+# Hopefully they are up when the tests are run.
+
+ok $p -> ping("www.geocities.com");
+ok $p -> ping("ftp.geocities.com");
+
+ok $p -> ping("www.freeservers.com");
+ok $p -> ping("ftp.freeservers.com");
+
+ok $p -> ping("yahoo.com");
+ok $p -> ping("www.yahoo.com");
+ok $p -> ping("www.about.com");
--- /dev/null
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ unless ($ENV{PERL_TEST_Net_Ping}) {
+ print "1..0 # Skip: network dependent test\n";
+ exit;
+ }
+ chdir 't' if -d 't';
+ @INC = qw(../lib);
+ }
+}
+
+# Test of stream protocol using loopback interface.
+#
+# NOTE:
+# The echo service must be enabled on localhost
+# to really test the stream protocol ping.
+
+use Test;
+use Net::Ping;
+plan tests => 12;
+
+my $p = new Net::Ping "stream";
+
+# new() worked?
+ok !!$p;
+
+# Attempt to connect to the echo port
+if ($p -> ping("localhost")) {
+ ok 1;
+ # Try several pings while it is connected
+ for (1..10) {
+ ok $p -> ping("localhost");
+ }
+} else {
+ # Echo port is off, skip the tests
+ for (2..12) { skip "Local echo port is off", 1; }
+ exit;
+}
+
+__END__
+
+A simple xinetd configuration to enable the echo service can easily be made.
+Just create the following file before restarting xinetd:
+
+/etc/xinetd.d/echo:
+
+# description: echo service
+service echo
+{
+ socket_type = stream
+ wait = no
+ user = root
+ server = /bin/cat
+ disable = no
+}
#!./perl
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
use Test::More tests => 4;
BEGIN { use_ok('Shell'); }
$tmpfile++;
}
-END { -f $tmpfile && unlink $tmpfile };
+END { -f $tmpfile && (open STDERR, '>&SAVERR' and unlink $tmpfile) };
xXx(); # Ok someone could have a program called this :(
-ok( !(-s $tmpfile) ,'$Shell::capture_stderr');
+# On os2 the warning is on by default...
+ok( ($^O eq 'os2' xor !(-s $tmpfile)) ,'$Shell::capture_stderr');
$Shell::capture_stderr = 0; #
$spitshell >>Makefile <<'!NO!SUBS!'
$(LIBPERL): perl.imp $(PERL_DLL) perl5.def libperl_override.lib
emximp -o $(LIBPERL) perl.imp
+ cp $(LIBPERL) perl.lib
-libperl_override.imp: os2/os2add.sym
+libperl_override.imp: os2/os2add.sym miniperl
./miniperl -wnle 'print "$$_\t$(PERL_DLL_BASE)\t$$_\t?"' os2/os2add.sym > tmp.imp
echo 'strdup $(PERL_DLL_BASE) Perl_strdup ?' >> tmp.imp
echo 'putenv $(PERL_DLL_BASE) Perl_putenv ?' >> tmp.imp
$(AOUT_LIBPERL) : $(aout_obj) perl$(AOUT_OBJ_EXT)
rm -f $@
$(AOUT_AR) rcu $@ perl$(AOUT_OBJ_EXT) $(aout_obj)
+ cp $@ perl.a
.c$(AOUT_OBJ_EXT):
$(AOUT_CCCMD) $(PLDLFLAGS) -c $*.c
# Forking statically loaded perl
-perl_$(EXE_EXT) perl_: $& aout_perlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) $(AOUT_DYNALOADER) $(aout_static_ext) ext.libs
+# Need a miniperl_ dependency, since $(AOUT_DYNALOADER) is build via implicit
+# rules, thus would not rebuild miniperl_ via an explicit rule
+
+perl_$(EXE_EXT) perl_: $& miniperl_ aout_perlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) $(AOUT_DYNALOADER) $(aout_static_ext) ext.libs
$(CC) $(AOUT_CLDFLAGS) $(CCDLFLAGS) -o perl_ aout_perlmain$(AOUT_OBJ_EXT) $(AOUT_DYNALOADER) $(aout_static_ext) $(AOUT_LIBPERL) `cat ext.libs` $(libs)
# Remove -Zcrtdll
@cd ext/$(basename $(notdir $@)) ; make -f Makefile.aout config || echo "\$(MAKE) config failed, continuing anyway..."
cd ext/$(basename $(notdir $@)) ; make -f Makefile.aout LINKTYPE=static CCCDLFLAGS=
-ext/%/Makefile.aout : miniperl_ \$(_preplibrary) \$(AOUT_EXTENSIONS_FORCE)
+ext/%/Makefile.aout : miniperl_ $(_preplibrary) $(AOUT_EXTENSIONS_FORCE)
cd $(dir $@) ; ../../miniperl_ -I ../../lib Makefile.PL FIRST_MAKEFILE=Makefile.aout INSTALLDIRS=perl
!NO!SUBS!
WriteMakefile(
NAME => 'OS2::DLL',
- VERSION => '0.01',
+ VERSION_FROM => 'DLL.pm',
MAN3PODS => {}, # Pods will be built by installman.
XSPROTOARG => '-noprototypes',
PERL_MALLOC_OK => 1,
if (strEQ(PL_Argv[0],"/bin/sh"))
PL_Argv[0] = PL_sh_path;
- if (PL_Argv[0][0] != '/' && PL_Argv[0][0] != '\\'
- && !(PL_Argv[0][0] && PL_Argv[0][1] == ':'
- && (PL_Argv[0][2] == '/' || PL_Argv[0][2] != '\\'))
- ) /* will spawnvp use PATH? */
- TAINT_ENV(); /* testing IFS here is overkill, probably */
/* We should check PERL_SH* and PERLLIB_* as well? */
if (!really || !*(tmps = SvPV(really, n_a)))
tmps = PL_Argv[0];
+ if (tmps[0] != '/' && tmps[0] != '\\'
+ && !(tmps[0] && tmps[1] == ':'
+ && (tmps[2] == '/' || tmps[2] != '\\'))
+ ) /* will spawnvp use PATH? */
+ TAINT_ENV(); /* testing IFS here is overkill, probably */
reread:
force_shell = 0;
retstr->strlength = 0;
return 0;
}
-#define INCL_DOSPROCESS
-#define INCL_DOSSEMAPHORES
-#define INCL_DOSMODULEMGR
-#define INCL_DOSMISC
-#define INCL_DOSEXCEPTIONS
-#define INCL_DOSERRORS
-#define INCL_REXXSAA
-#include <os2.h>
-
-/*
- * "The Road goes ever on and on, down from the door where it began."
- */
-
-#ifdef OEMVS
-#ifdef MYMALLOC
-/* sbrk is limited to first heap segement so make it big */
-#pragma runopts(HEAP(8M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON))
-#else
-#pragma runopts(HEAP(2M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON))
-#endif
-#endif
-
-
-#include "EXTERN.h"
-#include "perl.h"
-
-static void xs_init (pTHX);
-static PerlInterpreter *my_perl;
-
-#if defined (__MINT__) || defined (atarist)
-/* The Atari operating system doesn't have a dynamic stack. The
- stack size is determined from this value. */
-long _stksize = 64 * 1024;
-#endif
-
-/* Register any extra external extensions */
-
-/* Do not delete this line--writemain depends on it */
-EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
-
-static void
-xs_init(pTHX)
-{
- char *file = __FILE__;
- dXSUB_SYS;
- newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
-}
-
-int perlos2_is_inited;
-
-static void
-init_perlos2(void)
-{
-/* static char *env[1] = {NULL}; */
-
- Perl_OS2_init3(0, 0, 0);
-}
-
-static int
-init_perl(int doparse)
-{
- int exitstatus;
- char *argv[3] = {"perl_in_REXX", "-e", ""};
-
- if (!perlos2_is_inited) {
- perlos2_is_inited = 1;
- init_perlos2();
- }
- if (my_perl)
- return 1;
- if (!PL_do_undump) {
- my_perl = perl_alloc();
- if (!my_perl)
- return 0;
- perl_construct(my_perl);
- PL_perl_destruct_level = 1;
- }
- if (!doparse)
- return 1;
- exitstatus = perl_parse(my_perl, xs_init, 3, argv, (char **)NULL);
- return !exitstatus;
-}
-
-/* The REXX-callable entrypoints ... */
-
-ULONG PERL (PCSZ name, LONG rargc, const RXSTRING *rargv,
- PCSZ queuename, PRXSTRING retstr)
-{
- int exitstatus;
- char buf[256];
- char *argv[3] = {"perl_from_REXX", "-e", buf};
- ULONG ret;
-
- if (rargc != 1) {
- sprintf(retstr->strptr, "one argument expected, got %ld", rargc);
- retstr->strlength = strlen (retstr->strptr);
- return 1;
- }
- if (rargv[0].strlength >= sizeof(buf)) {
- sprintf(retstr->strptr,
- "length of the argument %ld exceeds the maximum %ld",
- rargv[0].strlength, (long)sizeof(buf) - 1);
- retstr->strlength = strlen (retstr->strptr);
- return 1;
- }
-
- if (!init_perl(0))
- return 1;
-
- memcpy(buf, rargv[0].strptr, rargv[0].strlength);
- buf[rargv[0].strlength] = 0;
-
- exitstatus = perl_parse(my_perl, xs_init, 3, argv, (char **)NULL);
- if (!exitstatus) {
- exitstatus = perl_run(my_perl);
- }
-
- perl_destruct(my_perl);
- perl_free(my_perl);
- my_perl = 0;
-
- if (exitstatus)
- ret = 1;
- else {
- ret = 0;
- sprintf(retstr->strptr, "%s", "ok");
- retstr->strlength = strlen (retstr->strptr);
- }
- PERL_SYS_TERM1(0);
- return ret;
-}
-
-ULONG PERLEXIT (PCSZ name, LONG rargc, const RXSTRING *rargv,
- PCSZ queuename, PRXSTRING retstr)
-{
- if (rargc != 0) {
- sprintf(retstr->strptr, "no arguments expected, got %ld", rargc);
- retstr->strlength = strlen (retstr->strptr);
- return 1;
- }
- PERL_SYS_TERM1(0);
- return 0;
-}
-
-ULONG PERLTERM (PCSZ name, LONG rargc, const RXSTRING *rargv,
- PCSZ queuename, PRXSTRING retstr)
-{
- if (rargc != 0) {
- sprintf(retstr->strptr, "no arguments expected, got %ld", rargc);
- retstr->strlength = strlen (retstr->strptr);
- return 1;
- }
- if (!my_perl) {
- sprintf(retstr->strptr, "no perl interpreter present");
- retstr->strlength = strlen (retstr->strptr);
- return 1;
- }
- perl_destruct(my_perl);
- perl_free(my_perl);
- my_perl = 0;
-
- sprintf(retstr->strptr, "%s", "ok");
- retstr->strlength = strlen (retstr->strptr);
- return 0;
-}
-
-
-ULONG PERLINIT (PCSZ name, LONG rargc, const RXSTRING *rargv,
- PCSZ queuename, PRXSTRING retstr)
-{
- if (rargc != 0) {
- sprintf(retstr->strptr, "no argument expected, got %ld", rargc);
- retstr->strlength = strlen (retstr->strptr);
- return 1;
- }
- if (!init_perl(1))
- return 1;
-
- sprintf(retstr->strptr, "%s", "ok");
- retstr->strlength = strlen (retstr->strptr);
- return 0;
-}
-
-ULONG PERLEVAL (PCSZ name, LONG rargc, const RXSTRING *rargv,
- PCSZ queuename, PRXSTRING retstr)
-{
- SV *res, *in;
- STRLEN len;
- char *str;
-
- if (rargc != 1) {
- sprintf(retstr->strptr, "one argument expected, got %ld", rargc);
- retstr->strlength = strlen (retstr->strptr);
- return 1;
- }
-
- if (!init_perl(1))
- return 1;
-
- {
- dSP;
- int ret;
-
- ENTER;
- SAVETMPS;
-
- PUSHMARK(SP);
- in = sv_2mortal(newSVpvn(rargv[0].strptr, rargv[0].strlength));
- eval_sv(in, G_SCALAR);
- SPAGAIN;
- res = POPs;
- PUTBACK;
-
- ret = 0;
- if (SvTRUE(ERRSV) || !SvOK(res))
- ret = 1;
- str = SvPV(res, len);
- if (len <= 256 /* Default buffer is 256-char long */
- || !DosAllocMem((PPVOID)&retstr->strptr, len,
- PAG_READ|PAG_WRITE|PAG_COMMIT)) {
- memcpy(retstr->strptr, str, len);
- retstr->strlength = len;
- } else
- ret = 1;
-
- FREETMPS;
- LEAVE;
-
- return ret;
- }
-}
#if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT)
static char *local_patches[] = {
NULL
- ,"DEVEL13745"
+ ,"DEVEL13810"
,NULL
};
#define PL_modcount (*Perl_Tmodcount_ptr(aTHX))
#undef PL_na
#define PL_na (*Perl_Tna_ptr(aTHX))
+#undef PL_nrs
+#define PL_nrs (*Perl_Tnrs_ptr(aTHX))
#undef PL_ofs_sv
#define PL_ofs_sv (*Perl_Tofs_sv_ptr(aTHX))
#undef PL_op
#define PL_top_env (*Perl_Ttop_env_ptr(aTHX))
#undef PL_toptarget
#define PL_toptarget (*Perl_Ttoptarget_ptr(aTHX))
-#undef PL_unused_1
-#define PL_unused_1 (*Perl_Tunused_1_ptr(aTHX))
#undef PL_watchaddr
#define PL_watchaddr (*Perl_Twatchaddr_ptr(aTHX))
#undef PL_watchok
=item alarm
Arranges to have a SIGALRM delivered to this process after the
-specified number of seconds have elapsed. If SECONDS is not specified,
-the value stored in C<$_> is used. (On some machines,
-unfortunately, the elapsed time may be up to one second less than you
-specified because of how seconds are counted.) Only one timer may be
-counting at once. Each call disables the previous timer, and an
-argument of C<0> may be supplied to cancel the previous timer without
-starting a new one. The returned value is the amount of time remaining
-on the previous timer.
+specified number of wallclock seconds have elapsed. If SECONDS is not
+specified, the value stored in C<$_> is used. (On some machines,
+unfortunately, the elapsed time may be up to one second less or more
+than you specified because of how seconds are counted, and process
+scheduling may delay the delivery of the signal even further.)
+
+Only one timer may be counting at once. Each call disables the
+previous timer, and an argument of C<0> may be supplied to cancel the
+previous timer without starting a new one. The returned value is the
+amount of time remaining on the previous timer.
For delays of finer granularity than one second, you may use Perl's
four-argument version of select() leaving the first three arguments
=item C<(?imsx-imsx)>
-One or more embedded pattern-match modifiers. This is particularly
-useful for dynamic patterns, such as those read in from a configuration
-file, read in as an argument, are specified in a table somewhere,
-etc. Consider the case that some of which want to be case sensitive
-and some do not. The case insensitive ones need to include merely
-C<(?i)> at the front of the pattern. For example:
+One or more embedded pattern-match modifiers, to be turned on (or
+turned off, if preceded by C<->) for the remainder of the pattern or
+the remainder of the enclosing pattern group (if any). This is
+particularly useful for dynamic patterns, such as those read in from a
+configuration file, read in as an argument, are specified in a table
+somewhere, etc. Consider the case that some of which want to be case
+sensitive and some do not. The case insensitive ones need to include
+merely C<(?i)> at the front of the pattern. For example:
$pattern = "foobar";
if ( /$pattern/i ) { }
$pattern = "(?i)foobar";
if ( /$pattern/ ) { }
-Letters after a C<-> turn those modifiers off. These modifiers are
-localized inside an enclosing group (if any). For example,
+These modifiers are restored at the end of the enclosing group. For example,
( (?i) blah ) \s+ \1
{
UV left = 0;
UV right = 0;
- bool left_neg;
- bool right_neg;
+ bool left_neg = FALSE;
+ bool right_neg = FALSE;
bool use_double = FALSE;
bool dright_valid = FALSE;
NV dright = 0.0;
PERL_CALLCONV OP* Perl_invert(pTHX_ OP* cmd);
PERL_CALLCONV bool Perl_is_gv_magical(pTHX_ char *name, STRLEN len, U32 flags);
PERL_CALLCONV I32 Perl_is_lvalue_sub(pTHX);
+PERL_CALLCONV U32 Perl_to_uni_upper_lc(pTHX_ U32 c);
+PERL_CALLCONV U32 Perl_to_uni_title_lc(pTHX_ U32 c);
+PERL_CALLCONV U32 Perl_to_uni_lower_lc(pTHX_ U32 c);
PERL_CALLCONV bool Perl_is_uni_alnum(pTHX_ UV c);
PERL_CALLCONV bool Perl_is_uni_alnumc(pTHX_ UV c);
PERL_CALLCONV bool Perl_is_uni_idfirst(pTHX_ UV c);
# alarm time might be one second less than you said.
is( $@, "ALARM!\n", 'alarm w/$SIG{ALRM} vs inf loop' );
-ok( $diff == 3 || $diff == 2, ' right time' );
+ok( abs($diff - 3) <= 1, " right time" );
my $start_time = time;
# alarm time might be one second less than you said.
is( $@, "ALARM!\n", 'alarm w/$SIG{ALRM} vs system()' );
-ok( $diff == 3 || $diff == 2, ' right time' );
+ok( abs($diff - 3) <= 1, ' right time' );
/* Fields used by magic variables such as $@, $/ and so on */
PERLVAR(Ttainted, bool) /* using variables controlled by $< */
PERLVAR(Tcurpm, PMOP *) /* what to do \ interps in REs from */
-PERLVAR(Tunused_1, SV *) /* placeholder: was Tnrs */
+PERLVAR(Tnrs, SV *) /* placeholder: unused since 5.8.0 (5.7.2 patch #12027 for bug ID 20010815.012) */
/*
=for apidoc mn|SV*|PL_rs
goto hard_way;
# endif
result = PerlProc_waitpid(pid,statusp,flags);
+ goto finish;
#endif
#if !defined(HAS_WAITPID) && defined(HAS_WAIT4)
result = wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *));
+ goto finish;
#endif
#if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME)
hard_way:
}
}
#endif
+ finish:
if (result < 0 && errno == EINTR) {
PERL_ASYNC_CHECK();
}
PL_no_usym
PL_no_wrongref
PL_nomemok
+ PL_nrs
PL_ofmt
PL_oldbufptr
PL_oldname
projects / p5sagit/p5-mst-13.2.git / commitdiff