Skip Menu |
 

This queue is for tickets about the HTTP-Server-Simple CPAN distribution.

Report information
The Basics
Id: 16960
Status: resolved
Priority: 0/
Queue: HTTP-Server-Simple

People
Owner: Nobody in particular
Requestors: lloy0076 [...] adam.com.au
Cc:
AdminCc:

Bug Information
Severity: Important
Broken in: 0.16
Fixed in: (no value)



MIME-Version: 1.0
X-Mailer: MIME-tools 5.418 (Entity 5.418)
Subject: Setup Method :: Does Not Behave as I Expect
Content-Type: multipart/mixed; boundary="----------=_1136702022-26544-1"
Content-Length: 0
Content-Type: text/plain
Content-Disposition: inline
Content-Transfer-Encoding: binary
X-RT-Original-Encoding: iso-8859-1
Content-Length: 4419
Download (untitled) / with headers
text/plain 4.3k
The documentation says: -- setup(name => $value, ...) This method is called with a name => value list of various things to do with the request. This list is given below. The default setup handler simply tries to call methods with the names of keys of this list. -- But I apply the patch (which simply prints out what what the $self->can($item) is attempting to test for), I get: -- If can(dsl::server=HASH(0x814ab44)) If can(GET) If can(HTTP/1.1) If can() If can(/) If can(/) If can(localhost) If can(8080) If can(127.0.0.1) If can(127.0.0.1) -- In other words, it's checking for the VALUES not the ITEMS. Here's my little test class: -- #!/usr/bin/perl use strict; my $server=dsl::server->new(); $server->run(); 1; package dsl::server; use base qw(HTTP::Server::Simple); use Carp; use Data::Dumper; sub method { my $self=shift; $self->{'X'}="HELLO"; } sub handler { my $self=shift; if ($self->can('method')) { print "I can method, method and so I should have ".$self->{'X'}." set to something." } } 1; -- NB: The 'I can method...' part at the bottom was to make sure that my Perl was checking the package correctly. Other info: Mozilla 1.7.12-1 (Debian Package) root:/usr/local/share/perl/5.8.7/HTTP/Server:$ perl -V Summary of my perl5 (revision 5 version 8 subversion 7) configuration: Platform: osname=linux, osvers=2.6.14.3, archname=i486-linux-gnu-thread-multi uname='linux ninsei 2.6.14.3 #1 smp preempt mon nov 28 19:51:50 pst 2005 i686 gnulinux ' config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchname=i486-linux-gnu -Dprefix=/usr -Dprivlib=/usr/share/perl/5.8 -Darchlib=/usr/lib/perl/5.8 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.8.7 -Dsitearch=/usr/local/lib/perl/5.8.7 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Uusesfio -Uusenm -Duseshrplib -Dlibperl=libperl.so.5.8.7 -Dd_dosuid -des' hint=recommended, useposix=true, d_sigaction=define usethreads=define use5005threads=undef useithreads=define usemultiplicity=define useperlio=define d_sfio=undef uselargefiles=define usesocks=undef use64bitint=undef use64bitall=undef uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64', optimize='-O2', cppflags='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -pipe -I/usr/local/include' ccversion='', gccversion='4.0.3 20051201 (prerelease) (Debian 4.0.2-5)', gccosandvers='' intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12 ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8 alignbytes=4, prototype=define Linker and Libraries: ld='cc', ldflags =' -L/usr/local/lib' libpth=/usr/local/lib /lib /usr/lib libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt perllibs=-ldl -lm -lpthread -lc -lcrypt libc=/lib/libc-2.3.5.so, so=so, useshrplib=true, libperl=libperl.so.5.8.7 gnulibc_version='2.3.5' Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E' cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib' Characteristics of this binary (from libperl): Compile-time options: MULTIPLICITY USE_ITHREADS USE_LARGE_FILES PERL_IMPLICIT_CONTEXT Locally applied patches: SPRINTF0 - fixes for sprintf formatting issues - CVE-2005-3962 Built under linux Compiled at Dec 15 2005 17:19:17 @INC: /etc/perl /usr/local/lib/perl/5.8.7 /usr/local/share/perl/5.8.7 /usr/lib/perl5 /usr/share/perl5 /usr/lib/perl/5.8 /usr/share/perl/5.8 /usr/local/lib/site_perl /usr/local/lib/perl/5.8.4 /usr/local/share/perl/5.8.4 I installed HTTP::Server::Simple and the ::CGI version with: # cpanp i HTTP::Server::Simple # uname -a Linux gondor 2.6.11 #1 Sun Jun 5 11:04:21 CST 2005 i686 GNU/Linux (aka Debian GNU/Linux SID with a customised kernel I built) DSL
Content-Type: text/x-patch; name="context.diff"
Content-Disposition: inline; filename="context.diff"
Content-Transfer-Encoding: binary
X-RT-Original-Encoding: iso-8859-1
Content-Length: 325
Download context.diff
text/x-diff 325b
*** Simple.pm Sun Jan 8 16:55:23 2006 --- /tmp/Simple.pm Sun Jan 8 16:55:18 2006 *************** *** 423,428 **** --- 423,429 ---- sub setup { my ($self) = @_; while ( my ( $item, $value ) = splice @_, 0, 2 ) { + print "If can(".$item.")\n"; $self->$item($value) if $self->can($item); } }
MIME-Version: 1.0
X-Mailer: MIME-tools 5.418 (Entity 5.418)
From: lloy0076 [...] adam.com.au
Content-Type: multipart/mixed; boundary="----------=_1136702969-26544-2"
Content-Length: 0
Content-Type: text/plain
Content-Disposition: inline
Content-Transfer-Encoding: binary
X-RT-Original-Encoding: iso-8859-1
Content-Length: 20
This fixes it. DSL
Content-Type: text/x-patch; name="fixed-it.patch"
Content-Disposition: inline; filename="fixed-it.patch"
Content-Transfer-Encoding: binary
X-RT-Original-Encoding: iso-8859-1
Content-Length: 455
Download fixed-it.patch
text/x-diff 455b
*** Simple.pm Sun Jan 8 17:12:50 2006 --- /tmp/Simple.pm Sun Jan 8 17:04:36 2006 *************** *** 422,428 **** sub setup { my ($self) = @_; ! while ( my ( $item, $value) = splice @_, 0, 2 ) { $self->$item($value) if $self->can($item); } } --- 422,428 ---- sub setup { my ($self) = @_; ! while ( my ( $value, $item) = splice @_, 0, 2 ) { $self->$item($value) if $self->can($item); } }


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.