Re: LWPng on Windows NT
Blair Zajac (blair@gps.caltech.edu)
Thu, 2 Jul 1998 13:46:49 -0700 (PDT)
> From gisle@aas.no Thu Jul 2 12:52 PDT 1998
>
> Blair Zajac <blair@gps.caltech.edu> writes:
>
> > Has anybody run LWPng on Windows NT?
>
> I have not.
>
> > I've been running into some
> > problems where spooled requests to LWP::UA are not handled and
> > mainloop->empty returns true.
>
> The following code (from LWP::Conn::HTTP) is probably not portable
> enough? The rest of the socket stuff and the LWP::EventLoop ought to
> work.
I think the socket stuff or the LWP::EventLoop may be the problem.
I'll need to look into it some more. Do you think there may be a
problem anywhere in the code that I should start looking at first?
>
> # A hack that should work at least on systems with POSIX.pm. It
> # implements the constant EINPROGRESS and IO::Handle->blocking;
> # XXX: When we require IO-1.18, then this hack can be removed.
>
I have developed a workaround for this code that works on both Windows NT
and Solaris machines, so that's not the problem. Just to make sure,
I'm including my patch to LWPng-alpha 0.21 below so people can look at it.
It creates a new module called LWP::Extras which tries to calculate the
EINPROGRESS constant. On Windows 32 systems, it'll set EINPROGRESS
to the value of WSAEINPROGRESS. I don't know if this is correct or not.
I guessed this from looking through the winsock.h header file.
I like the idea of the LWP::Extras, it doesn't require people to use the newer
IO-1.19 module. I'm up for changing the name to something else. LWP::IO
is already in use by LWP-attic-1.00.
>
> This code might not be triggered if the IO module update on CPAN is
> installed. Anybody know the status of IO-1.19 on WinNT?
>
> Regards,
> Gisle
>
Blair
diff -Nrc LWPng-alpha-0.21-orig/Extras/Extras.pm LWPng-alpha-0.21/Extras/Extras.pm
*** LWPng-alpha-0.21-orig/Extras/Extras.pm Wed Dec 31 17:00:00 1969
--- LWPng-alpha-0.21/Extras/Extras.pm Thu Jul 2 13:40:08 1998
***************
*** 0 ****
--- 1,125 ----
+ package LWP::Extras;
+
+ use strict;
+ use vars qw($VERSION @ISA);
+
+ use Exporter;
+ use DynaLoader;
+ use IO::Handle;
+
+ @ISA = qw(Exporter DynaLoader);
+ $VERSION = '0.01';
+
+ # Here we load the constant subroutines from the XS module.
+ bootstrap LWP::Extras $VERSION;
+
+ # Here we define the subroutine IO::EINPROGRESS and emulate the
+ # $handle->blocking call provided by newer versions of the IO
+ # module. This will not be needed when we require IO-1.18 or
+ # greater.
+
+ # &IO::EINPROGRESS is not defined in IO versions older than 1.18.
+ unless (defined &IO::EINPROGRESS) {
+ my $einprogress = -1;
+
+ if (defined &LWP::Extras::EINPROGRESS) {
+ # Try to use LWP::Extras::EINPROGRESS.
+ $einprogress = &LWP::Extras::EINPROGRESS;
+ }
+ else {
+ # Otherwise try to use POSIX.
+ eval {
+ require POSIX;
+ $einprogress = &POSIX::EINPROGRESS;
+ };
+ $! = $einprogress;
+ die "The system constant EINPROGRESS cannot be found ($!)" if ($@ or $! ne "Operation now in progress");
+ }
+ *IO::EINPROGRESS = sub () { $einprogress; };
+ }
+
+ # Emulate $handle->blocking call provided by newer versions of the IO modules.
+ unless (defined &IO::Handle::blocking) {
+ my ($O_NONBLOCK, $F_GETFL, $F_SETFL);
+ eval {
+ require Fcntl;
+ $O_NONBLOCK = Fcntl::O_NONBLOCK();
+ $F_GETFL = Fcntl::F_GETFL();
+ $F_SETFL = Fcntl::F_SETFL();
+ };
+ unless ($@) {
+ # We got the Fcntl constants OK.
+ *IO::Handle::blocking = sub {
+ my $fh = shift;
+ my $dummy = '';
+ my $old = fcntl($fh, $F_GETFL, $dummy);
+ return unless defined $old;
+ if (@_) {
+ my $new = $old;
+ if ($_[0]) {
+ $new &= ~$O_NONBLOCK;
+ } else {
+ $new |= $O_NONBLOCK;
+ }
+ fcntl($fh, $F_SETFL, $new);
+ }
+ ($old & $O_NONBLOCK) == 0;
+ }
+ }
+ else {
+ # We do not have Fcntl constants. We'll implement the blocking
+ # method call but it will not do anything.
+ *IO::Handle::blocking = sub {
+ return;
+ }
+ }
+ }
+
+
+ 1;
+
+ __END__
+
+ =pod
+
+ =head1 NAME
+
+ LWP::Extras - Create IO capabilites for older Perls
+
+ =head1 SYNOPSIS
+
+ use LWP::Extras;
+ print LWP::Extras::EINPROGRESS;
+ $handle->blocking(0);
+
+ =head1 DESCRIPTION
+
+ LWP::Extras is used to set up some IO specific constants and method
+ calls for Perls using older versions of the IO libraries. If the
+ IO::EINPROGRESS constant subroutine does not exist, then this module
+ will attempt to calculate the correct value for the EINPROGRESS
+ error return from a socket call and also set up the I<blocking>
+ method call for file handles. EINPROGRESS is found from the XS
+ module that comes with this module or, if that does not work, from
+ the POSIX module. If EINPROGRESS cannot be determined, the module
+ dies.
+
+ On Windows 32 systems which define WSAEINPROGRESS, WSAEINPROGRESS
+ is used instead of EINPROGRESS.
+
+ If the system has the NON_BLOCK, F_GETFL and F_SETFL constants from the
+ Fcntl module, then the IO::Handle::blocking method call will exist
+ and either turn on or off blocking and return the old setting for
+ blocking. If there is an error or the system does not have the Fcntl
+ constants, then it returns an empty list in a list context, an undefined
+ value in a scalar context, or nothing in a void context.
+
+ =head1 AUTHOR
+
+ Blair Zajac, blair@gps.caltech.edu
+
+ =head1 SEE ALSO
+
+ See also L<LWP::MainLoop> and L<IO>.
+
+ =cut
diff -Nrc LWPng-alpha-0.21-orig/Extras/Extras.xs LWPng-alpha-0.21/Extras/Extras.xs
*** LWPng-alpha-0.21-orig/Extras/Extras.xs Wed Dec 31 17:00:00 1969
--- LWPng-alpha-0.21/Extras/Extras.xs Wed Jul 1 15:49:53 1998
***************
*** 0 ****
--- 1,90 ----
+ #ifdef __cplusplus
+ extern "C" {
+ #endif
+ #include "EXTERN.h"
+ #include "perl.h"
+ #include "XSUB.h"
+ #include "patchlevel.h"
+ #ifdef __cplusplus
+ }
+ #endif
+
+
+ #if (PATCHLEVEL < 3) || ((PATCHLEVEL == 3) && (SUBVERSION < 22))
+ /* before 5.003_22 */
+ # define MY_start_subparse(fmt,flags) start_subparse()
+ #else
+ # if (PATCHLEVEL == 3) && (SUBVERSION == 22)
+ /* 5.003_22 */
+ # define MY_start_subparse(fmt,flags) start_subparse(flags)
+ # else
+ /* 5.003_23 onwards */
+ # define MY_start_subparse(fmt,flags) start_subparse(fmt,flags)
+ # endif
+ #endif
+
+ #ifndef gv_stashpvn
+ #define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
+ #endif
+
+ #ifndef newCONSTSUB
+ /*
+ * Define an XSUB that returns a constant scalar. The resulting structure is
+ * identical to that created by the parser when it parses code like :
+ *
+ * sub xyz () { 123 }
+ *
+ * This allows the constants from the XSUB to be inlined.
+ *
+ */
+
+ static void
+ newCONSTSUB(stash,name,sv)
+ HV *stash;
+ char *name;
+ SV *sv;
+ {
+ #ifdef dTHR
+ dTHR;
+ #endif
+ U32 oldhints = hints;
+ HV *old_cop_stash = curcop->cop_stash;
+ HV *old_curstash = curstash;
+ line_t oldline = curcop->cop_line;
+ curcop->cop_line = copline;
+
+ hints &= ~HINT_BLOCK_SCOPE;
+ if(stash)
+ curstash = curcop->cop_stash = stash;
+
+ newSUB(
+ MY_start_subparse(FALSE, 0),
+ newSVOP(OP_CONST, 0, newSVpv(name,0)),
+ newSVOP(OP_CONST, 0, &sv_no), /* SvPV(&sv_no) == "" -- GMB */
+ newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
+ );
+
+ hints = oldhints;
+ curcop->cop_stash = old_cop_stash;
+ curstash = old_curstash;
+ curcop->cop_line = oldline;
+ }
+ #endif
+
+ MODULE = LWP::Extras PACKAGE = LWP::Extras
+
+ BOOT:
+ {
+ HV *stash;
+ /*
+ * Declare constant subroutines.
+ */
+ stash = gv_stashpvn("LWP::Extras", 11, TRUE);
+ #ifdef WSAEINPROGRESS
+ #undef EINPROGRESS
+ #define EINPROGRESS (WSAEINPROGRESS)
+ #endif
+ #ifdef EINPROGRESS
+ newCONSTSUB(stash, "EINPROGRESS", newSViv(EINPROGRESS));
+ #endif
+ }
diff -Nrc LWPng-alpha-0.21-orig/Extras/MANIFEST LWPng-alpha-0.21/Extras/MANIFEST
*** LWPng-alpha-0.21-orig/Extras/MANIFEST Wed Dec 31 17:00:00 1969
--- LWPng-alpha-0.21/Extras/MANIFEST Wed Jul 1 15:29:55 1998
***************
*** 0 ****
--- 1,5 ----
+ Extras.pm
+ Extras.xs
+ MANIFEST
+ Makefile.PL
+ t/01extras.t
diff -Nrc LWPng-alpha-0.21-orig/Extras/Makefile.PL LWPng-alpha-0.21/Extras/Makefile.PL
*** LWPng-alpha-0.21-orig/Extras/Makefile.PL Wed Dec 31 17:00:00 1969
--- LWPng-alpha-0.21/Extras/Makefile.PL Mon Jun 29 20:37:17 1998
***************
*** 0 ****
--- 1,7 ----
+ use ExtUtils::MakeMaker;
+ # See lib/ExtUtils/MakeMaker.pm for details of how to influence
+ # the contents of the Makefile that is written.
+ WriteMakefile(
+ 'NAME' => 'LWP::Extras',
+ 'VERSION_FROM' => 'Extras.pm', # finds $VERSION
+ );
diff -Nrc LWPng-alpha-0.21-orig/Extras/t/01extras.t LWPng-alpha-0.21/Extras/t/01extras.t
*** LWPng-alpha-0.21-orig/Extras/t/01extras.t Wed Dec 31 17:00:00 1969
--- LWPng-alpha-0.21/Extras/t/01extras.t Wed Jul 1 15:46:58 1998
***************
*** 0 ****
--- 1,34 ----
+ # Before `make install' is performed this script should be runnable with
+ # `make test'. After `make install' it should work as `perl test.pl'
+
+ ######################### We start with some black magic to print on failure.
+
+ # Change 1..1 below to 1..last_test_to_print .
+ # (It may become useful if the test is moved to ./t subdirectory.)
+
+ use strict;
+ use vars qw($loaded);
+ BEGIN { $| = 1; print "1..5\n"; }
+ END {print "not ok 1\n" unless $loaded;}
+
+ my $ok_count = 1;
+ sub ok {
+ shift or print "not ";
+ print "ok $ok_count\n";
+ ++$ok_count;
+ }
+
+ use LWP::Extras;
+ $loaded = 1;
+ ok(1); # 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):
+
+ ok( defined &LWP::Extras::EINPROGRESS ); # 2
+ ok( defined &IO::EINPROGRESS ); # 3
+ ok( &IO::EINPROGRESS ); # 4
+ ok( defined &IO::Handle::blocking ); # 5
diff -Nrc LWPng-alpha-0.21-orig/MANIFEST LWPng-alpha-0.21/MANIFEST
*** LWPng-alpha-0.21-orig/MANIFEST Sat Jun 27 02:31:23 1998
--- LWPng-alpha-0.21/MANIFEST Wed Jul 1 15:52:07 1998
***************
*** 12,17 ****
--- 12,22 ----
bot/dbclear
bot/dblist
bot/ngbot
+ Extras/Extras.pm
+ Extras/Extras.xs
+ Extras/MANIFEST
+ Extras/Makefile.PL
+ Extras/t/01extras.t
lib/LWP/Authen.pm
lib/LWP/Authen/basic.pm
lib/LWP/Authen/digest.pm
diff -Nrc LWPng-alpha-0.21-orig/Makefile.PL LWPng-alpha-0.21/Makefile.PL
*** LWPng-alpha-0.21-orig/Makefile.PL Fri Apr 24 01:19:17 1998
--- LWPng-alpha-0.21/Makefile.PL Wed Jul 1 14:44:10 1998
***************
*** 4,9 ****
WriteMakefile(
NAME => "LWPng-alpha",
VERSION_FROM => "lib/LWP/Version.pm",
! PREREQ_PM => { LWP => '5.32', },
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz'},
);
--- 4,9 ----
WriteMakefile(
NAME => "LWPng-alpha",
VERSION_FROM => "lib/LWP/Version.pm",
! PREREQ_PM => { LWP => '5.33', },
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz'},
);
diff -Nrc LWPng-alpha-0.21-orig/lib/LWP/Conn/HTTP.pm LWPng-alpha-0.21/lib/LWP/Conn/HTTP.pm
*** LWPng-alpha-0.21-orig/lib/LWP/Conn/HTTP.pm Sat Jun 27 02:21:09 1998
--- LWPng-alpha-0.21/lib/LWP/Conn/HTTP.pm Mon Jun 29 21:23:45 1998
***************
*** 7,56 ****
# This library is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
- # A hack that should work at least on systems with POSIX.pm. It
- # implements the constant EINPROGRESS and IO::Handle->blocking;
- # XXX: When we require IO-1.18, then this hack can be removed.
- require IO::Handle;
- unless (defined &IO::EINPROGRESS) {
- my $einprogress = -1;
- eval {
- require POSIX;
- $einprogress = &POSIX::EINPROGRESS;
- };
- $! = $einprogress;
- die "No EINPROGRESS found ($!)" if ($@ or $! ne "Operation now in progress");
- *IO::EINPROGRESS = sub () { $einprogress; };
-
- # we also emulate $handle->blocking call provided by newer versions of
- # the IO modules
- require Fcntl;
- my $O_NONBLOCK = Fcntl::O_NONBLOCK();
- my $F_GETFL = Fcntl::F_GETFL();
- my $F_SETFL = Fcntl::F_SETFL();
- *IO::Handle::blocking = sub {
- my $fh = shift;
- my $dummy = '';
- my $old = fcntl($fh, $F_GETFL, $dummy);
- return undef unless defined $old;
- if (@_) {
- my $new = $old;
- if ($_[0]) {
- $new &= ~$O_NONBLOCK;
- } else {
- $new |= $O_NONBLOCK;
- }
- fcntl($fh, $F_SETFL, $new);
- }
- ($old & $O_NONBLOCK) == 0;
- }
- }
-
use strict;
use vars qw($DEBUG);
use vars qw(@TE);
@TE = qw(deflate base64 rot13);
my $TCP_PROTO = (getprotobyname('tcp'))[2];
use Carp ();
use IO::Socket qw(AF_INET SOCK_STREAM inet_aton pack_sockaddr_in);
use LWP::MainLoop qw(mainloop);
--- 7,19 ----
# This library is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
use strict;
use vars qw($DEBUG);
use vars qw(@TE);
@TE = qw(deflate base64 rot13);
my $TCP_PROTO = (getprotobyname('tcp'))[2];
+ use LWP::Extras;
use Carp ();
use IO::Socket qw(AF_INET SOCK_STREAM inet_aton pack_sockaddr_in);
use LWP::MainLoop qw(mainloop);
diff -Nrc LWPng-alpha-0.21-orig/lib/LWP/Conn/_Connect.pm LWPng-alpha-0.21/lib/LWP/Conn/_Connect.pm
*** LWPng-alpha-0.21-orig/lib/LWP/Conn/_Connect.pm Sat Jun 27 02:21:09 1998
--- LWPng-alpha-0.21/lib/LWP/Conn/_Connect.pm Mon Jun 29 21:25:12 1998
***************
*** 7,53 ****
# This library is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
-
use strict;
use vars qw($DEBUG @ISA);
!
! # A hack that should work at least on systems with POSIX.pm. It
! # implements the constant EINPROGRESS and IO::Handle->blocking;
! # XXX: When we require IO-1.18, then this hack can be removed.
! require IO::Handle;
! unless (defined &IO::EINPROGRESS) {
! my $einprogress = -1;
! eval {
! require POSIX;
! $einprogress = &POSIX::EINPROGRESS;
! };
! $! = $einprogress;
! die "No EINPROGRESS found ($!)" if ($@ or $! ne "Operation now in progress!
! *IO::EINPROGRESS = sub () { $einprogress; };
!
! # we also emulate $handle->blocking call provided by newer versions of
! # the IO modules
! require Fcntl;
! my $O_NONBLOCK = Fcntl::O_NONBLOCK();
! my $F_GETFL = Fcntl::F_GETFL();
! my $F_SETFL = Fcntl::F_SETFL();
! *IO::Handle::blocking = sub {
! my $fh = shift;
! my $dummy = '';
! my $old = fcntl($fh, $F_GETFL, $dummy);
! return undef unless defined $old;
! if (@_) {
! my $new = $old;
! if ($_[0]) {
! $new &= ~$O_NONBLOCK;
! } else {
! $new |= $O_NONBLOCK;
! }
! fcntl($fh, $F_SETFL, $new);
! }
! ($old & $O_NONBLOCK) == 0;
! }
! }
my $TCP_PROTO = (getprotobyname('tcp'))[2];
use Carp ();
--- 7,15 ----
# This library is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
use strict;
use vars qw($DEBUG @ISA);
! use LWP::Extras;
my $TCP_PROTO = (getprotobyname('tcp'))[2];
use Carp ();