diff options
| author | Perl 5 Porters <perl5-porters@africa.nicoh.com> | 1997-03-09 11:57:19 +1200 |
|---|---|---|
| committer | Chip Salzenberg <chip@atlantic.net> | 1997-03-09 11:57:19 +1200 |
| commit | 68dc074516a6859e3424b48d1647bcb08b1a1a7d (patch) | |
| tree | 125011c6d8e4a04727ff97166dc19199809958e4 | |
| parent | 699e6cd4da8c333ef83554732e73ab6734463b5d (diff) | |
| download | perl-68dc074516a6859e3424b48d1647bcb08b1a1a7d.tar.gz | |
[inseparable changes from match from perl-5.003_93 to perl-5.003_94]
BUILD PROCESS
Subject: Don't use db 2.x, we're not yet ready for it
From: Paul Marquess <pmarquess@bfsec.bt.co.uk>
Files: Configure
Subject: Warn if #! command is longer than 32 chars
From: Chip Salzenberg <chip@perl.com>
Files: Configure
Subject: patches re perl -wc install{perl,man}
Date: Tue, 11 Mar 97 13:13:16 GMT
From: Robin Barker <rmb1@cise.npl.co.uk>
Files: installman installperl
I got the new installhtml from CPAN
(TOMC/scripts/pod2html-v2.0beta.shar.gz)
I had problems getting the system call to splitpod at line 376 to work.
1. splitroot was not being found
2. splitroot was not finding its library
3. I changed htmlroot to podroot at line 175 to match the documentation.
p5p-msgid: 3180.9703270906@tempest.cise.npl.co.uk
private-msgid: 21544.9703111313@tempest.cise.npl.co.uk
Subject: 3_93 doesn't install pods
Date: Sun, 16 Mar 1997 02:21:35 -0500
From: Spider Boardman <spider@orb.nashua.nh.us>
Files: installperl
Msg-ID: 199703160721.CAA08339@Orb.Nashua.NH.US
(applied based on p5p patch as commit 43506a616735d616e03d277d64fbae1e864024bf)
Subject: When installing, use File::Copy instead of `cp`
From: Chip Salzenberg <chip@perl.com>
Files: installperl
Subject: Make hint files' warnings more visible
Date: Thu, 20 Mar 1997 23:18:03 +0100 (MET)
From: Hallvard B Furuseth <h.b.furuseth@usit.uio.no>
Files: hints/3b1.sh hints/apollo.sh hints/cxux.sh hints/dcosx.sh hints/dgux.sh hints/esix4.sh hints/freebsd.sh hints/hpux.sh hints/irix_4.sh hints/mips.sh hints/next_3_0.sh hints/os2.sh hints/qnx.sh hints/sco_2_3_3.sh hints/sco_2_3_4.sh hints/solaris_2.sh hints/ultrix_4.sh hints/utekv.sh
private-msgid: 199703202218.XAA09041@bombur2.uio.no
CORE LANGUAGE CHANGES
Subject: Defer creation of array and hash elements as parameters
From: Chip Salzenberg <chip@perl.com>
Files: dump.c global.sym mg.c op.c op.h perl.h pp.c pp_hot.c proto.h sv.c
Subject: New special literal: __PACKAGE__
From: Chip Salzenberg <chip@perl.com>
Files: keywords.pl pod/perldata.pod toke.c
Subject: Abort compilation at C<BEGIN{}> or C<use> after errors
From: Chip Salzenberg <chip@perl.com>
Files: op.c pod/perldiag.pod t/pragma/subs.t
Subject: allow C<substr 'hello', -10>
Date: Mon, 10 Mar 1997 15:55:44 -0800
From: David Dyck <dcd@tc.fluke.com>
Files: pp.c
Msg-ID: 97Mar10.155517pst.35716-2@gateway.fluke.com
(applied based on p5p patch as commit 77f720bf92f3d0100352416caeedd57936807ff2)
Subject: Regularize C<x % y>, esp. when y is negative
From: Chip Salzenberg <chip@perl.com>
Files: pp.c
Subject: Flush before C<flock(FOO, LOCK_UN)>
From: Chip Salzenberg <chip@perl.com>
Files: pod/perldelta.pod pod/perlfunc.pod pp_sys.c
Subject: Close loopholes in prototype mismatch warning
From: Chip Salzenberg <chip@perl.com>
Files: op.c sv.c toke.c
Subject: Warn on C<while ($x = each %y) {}>
From: Chip Salzenberg <chip@perl.com>
Files: op.c pod/perldiag.pod
Subject: Don't warn on C<print $fh func()>
From: Chip Salzenberg <chip@perl.com>
Files: toke.c
CORE PORTABILITY
Subject: Don't say 'static var = 1'
Date: Sun, 9 Mar 1997 15:19:57 +0200 (EET)
From: Jarkko Hietaniemi <jhi@iki.fi>
Files: malloc.c
private-msgid: 199703091319.PAA24714@alpha.hut.fi
Subject: HP/UX hint comments
Date: Fri, 21 Mar 1997 15:43:07 -0500 (EST)
From: Andy Dougherty <doughera@fractal.phys.lafayette.edu>
Files: hints/hpux.sh
private-msgid: Pine.SOL.3.95q.970321153918.28770B-100000@fractal.lafayette.
Subject: VMS update
Date: Tue, 11 Mar 1997 22:00:55 -0500 (EST)
From: Charles Bailey <bailey@hmivax.humgen.upenn.edu>
Files: lib/ExtUtils/MM_VMS.pm lib/Test/Harness.pm t/op/taint.t utils/perlbug.PL vms/descrip.mms
Msg-ID: 1997Mar11.220056.1873182@hmivax.humgen.upenn.edu
(applied based on p5p patch as commit 2b5725676da60b49978f38b85bb7f8ee20b4cb55)
Subject: vmsish.t and related patches
Date: Fri, 21 Mar 1997 01:32:47 -0500 (EST)
From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
Files: MANIFEST perl.h vms/descrip.mms vms/ext/vmsish.t vms/vms.c
private-msgid: 01IGQW3IP1KK005VFB@hmivax.humgen.upenn.edu
Subject: Win32 update (four patches)
From: Gurusamy Sarathy <gsar@engin.umich.edu>
Files: MANIFEST README.win32 lib/AutoSplit.pm lib/Cwd.pm lib/ExtUtils/Command.pm lib/ExtUtils/Install.pm lib/ExtUtils/MM_OS2.pm lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_Win32.pm lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm lib/File/Basename.pm lib/File/Path.pm mg.c t/comp/cpp.t t/comp/script.t t/harness t/io/argv.t t/io/dup.t t/io/fs.t t/io/inplace.t t/lib/filehand.t t/lib/io_dup.t t/lib/io_sel.t t/lib/io_taint.t t/op/closure.t t/op/exec.t t/op/glob.t t/op/goto.t t/op/magic.t t/op/misc.t t/op/rand.t t/op/split.t t/op/stat.t t/op/sysio.t t/op/taint.t t/pragma/strict.t t/pragma/subs.t t/pragma/warning.t util.c win32/*
DOCUMENTATION
Subject: perlfaq.pod
Date: Mon, 17 Mar 1997 16:01:40 -0700
From: Tom Christiansen <tchrist@jhereg.perl.com>
Files: MANIFEST pod/Makefile pod/buildtoc pod/perl.pod pod/perlfaq*.pod pod/roffitall
private-msgid: 199703172301.QAA12566@jhereg.perl.com
Subject: *.pod changes based on the FAQ
Date: Mon, 17 Mar 1997 09:50:14 -0700 (MST)
From: Nat Torkington <gnat@frii.com>
Files: pod/perldata.pod pod/perlfunc.pod pod/perlipc.pod pod/perlop.pod pod/perlre.pod pod/perlrun.pod pod/perlsec.pod pod/perlvar.pod
Msg-ID: 199703171650.JAA02655@elara.frii.com
(applied based on p5p patch as commit 3c10ad8e31f7d77e71c048b1746912f41cb540f0)
Subject: Document that $. is not reset on implicit open
From: Chip Salzenberg <chip@perl.com>
Files: pod/perldelta.pod
Subject: Re: Embedding success with _93
Date: Tue, 11 Mar 1997 17:55:05 -0500
From: Doug MacEachern <dougm@opengroup.org>
Files: pod/perldelta.pod
Msg-ID: 199703112255.RAA22775@postman.osf.org
(applied based on p5p patch as commit 63a6ff3a1dc8d86edb4d8a7ec1548205e32a7114)
Subject: Patch to document illegal characters
Date: Fri, 14 Mar 1997 09:08:10 -0800 (PST)
From: Tom Phoenix <rootbeer@teleport.com>
Files: pod/perldiag.pod pod/perltrap.pod
private-msgid: Pine.GSO.3.96.970314090558.15346J-100000@kelly.teleport.com
Subject: Document trap with //o and closures
Date: Mon, 10 Mar 1997 18:08:08 -0500 (EST)
From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
Files: pod/perltrap.pod
Msg-ID: 01IGCHWRNSEU00661G@hmivax.humgen.upenn.edu
(applied based on p5p patch as commit a54cb1465fdb400848f23705a6f130bb5c34ab70)
Subject: Illegal character in input
Date: Mon, 10 Mar 1997 15:21:21 -0800 (PST)
From: Tom Phoenix <rootbeer@teleport.com>
Files: pod/perldiag.pod
private-msgid: Pine.GSO.3.95q.970310151512.22489a-100000@kelly.teleport.com
Subject: Patch for docs Re: Lost backslash
Date: Wed, 19 Mar 1997 07:28:57 -0800 (PST)
From: Tom Phoenix <rootbeer@teleport.com>
Files: pod/perlop.pod
private-msgid: Pine.GSO.3.96.970319071438.24834G-100000@kelly.teleport.com
Subject: XSUB's doc fix
Date: Mon, 10 Mar 1997 11:42:06 -0500
From: Roderick Schertler <roderick@argon.org>
Files: pod/perlcall.pod pod/perlguts.pod pod/perlxstut.pod
Msg-ID: 28804.858012126@eeyore.ibcinc.com
(applied based on p5p patch as commit 5f43237038ea7a4151d3bf65aeeecd56ceb78a6a)
Subject: Document return from do FILE
Date: Tue, 18 Mar 1997 14:50:10 +0000
From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
Files: pod/perlfunc.pod
Msg-ID: E0w70DK-0001yJ-00@ursa.cus.cam.ac.uk
(applied based on p5p patch as commit ba8d5fb439878113de8abc9b52d2af237d30fb3c)
Subject: Document $^M in perlvar
Date: Thu, 20 Mar 97 21:08:33 GMT
From: Robin Barker <rmb1@cise.npl.co.uk>
Files: pod/perlvar.pod
private-msgid: 6153.9703202108@tempest.cise.npl.co.uk
Subject: typos in pods of 5.003_93
Date: 19 Mar 1997 10:39:38 -0600
From: Jim Meyering <meyering@asic.sc.ti.com>
Files: pod/perlfunc.pod pod/perlguts.pod pod/perlre.pod pod/perltoot.pod pod/perlxs.pod
Msg-ID: wpgendbzvhx.fsf@asic.sc.ti.com
(applied based on p5p patch as commit 76a9873e006cf8f48f57062b2a0dd40b5ed45a95)
Subject: Re: Updates to pod punctuations
Date: Fri, 14 Mar 1997 17:00:12 -0500
From: Larry W. Virden <lvirden@cas.org>
Files: pod/*.pod
private-msgid: 9703141700.AA22911@cas.org
Subject: clarify example in perlfunc
Date: Thu, 20 Mar 1997 19:46:01 +0200 (EET)
From: Jarkko Hietaniemi <jhi@iki.fi>
Files: pod/perlfunc.pod
private-msgid: 199703201746.TAA25195@alpha.hut.fi
Subject: Regularize headings in DB_File documentation
From: Chip Salzenberg <chip@perl.com>
Files: ext/DB_File/DB_File.pm
LIBRARY AND EXTENSIONS
Subject: New module: autouse.pm
Date: Thu, 20 Mar 1997 19:34:30 -0500 (EST)
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
Files: MANIFEST lib/autouse.pm
Msg-ID: 199703210034.TAA13469@monk.mps.ohio-state.edu
(applied based on p5p patch as commit 6757905eccb6dd0440ef65e8128a277a20f7d943)
Subject: Refresh DB_File to 1.12
Date: Wed, 12 Mar 97 15:51:14 GMT
From: Paul Marquess <pmarquess@bfsec.bt.co.uk>
Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs
Msg-ID: 9703121551.AA07435@claudius.bfsec.bt.co.uk
(applied based on p5p patch as commit b3deed9189f963e9994815307931f9084f60d1d9)
Subject: In File::Path, some systems can't remove read-only files
From: Chip Salzenberg <chip@perl.com>
Files: lib/File/Path.pm
Subject: Fix bugs revealed by prototype warnings
From: Chip Salzenberg <chip@perl.com>
Files: ext/Opcode/Opcode.pm lib/ExtUtils/MakeMaker.pm lib/Getopt/Long.pm
Subject: Problems with SKIP in makemaker
Date: Thu, 20 Mar 1997 23:13:31 -0500 (EST)
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
Files: lib/ExtUtils/MM_Unix.pm
Msg-ID: 199703210413.XAA21601@monk.mps.ohio-state.edu
(applied based on p5p patch as commit 970322a2e8024294ada6e8d1a027cb98f1f48ee3)
Subject: In Exporter, don't C<require Carp> at file scope
From: Chip Salzenberg <chip@perl.com>
Files: lib/Exporter.pm
Subject: fix for Exporter's $SIG{__WARN__} handler
Date: Thu, 13 Mar 1997 18:40:51 -0500
From: Roderick Schertler <roderick@argon.org>
Files: lib/Exporter.pm
Msg-ID: 2282.858296451@eeyore.ibcinc.com
(applied based on p5p patch as commit 2768ea1aeef34f42d096f198fbe629c8374ca429)
Subject: Don't try to substr() refs in Carp
From: Chip Salzenberg <chip@perl.com>
Files: lib/Carp.pm
Subject: Re: NUL in die and other messages
Date: Fri, 21 Mar 1997 09:58:17 +0000
From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
Files: lib/Carp.pm
Msg-ID: E0w815V-0005xs-00@ursa.cus.cam.ac.uk
(applied based on p5p patch as commit 52a267c574cb66c4bc35601dcf148a1d7a3bc557)
OTHER CORE CHANGES
Subject: Guard against buffer overflow in yyerror() and related funcs
From: Chip Salzenberg <chip@perl.com>
Files: toke.c
Subject: For bin compat, rename calllist() and he_{,delay}free
From: Chip Salzenberg <chip@perl.com>
Files: global.sym hv.c op.c perl.c pod/perlguts.pod proto.h
Subject: Fix C<print> on tied default handle
From: Chip Salzenberg <chip@perl.com>
Files: pp_hot.c
Subject: Fix C<local($a, undef, $b) = (1,2,3)>
From: Chip Salzenberg <chip@perl.com>
Files: op.c
Subject: Improve diagnostic on C<@a++>, C<--%a>, @a =~ s/a/b/
From: Chip Salzenberg <chip@perl.com>
Files: pp.c pp_hot.c
Subject: Don't warn on C<$x{y} .= "z"> when %x is tied
From: Chip Salzenberg <chip@perl.com>
Files: pp_hot.c
Subject: Eliminate 'unreachable code' warnings
From: Chip Salzenberg <chip@perl.com>
Files: ext/POSIX/POSIX.xs mg.c pp_ctl.c toke.c
Subject: printf format corrections for -DDEBUGGING
Date: Wed, 19 Mar 1997 12:42:50 -0500
From: Roderick Schertler <roderick@argon.org>
Files: doop.c malloc.c op.c pp_ctl.c regexec.c sv.c x2p/str.c x2p/util.c
Msg-ID: 26592.858793370@eeyore.ibcinc.com
(applied based on p5p patch as commit e125f273e351a19a92b69d6244af55abbbf0a26d)
Subject: Warn about missing -DMULTIPLICITY if likely a problem
Date: Wed, 19 Mar 1997 18:45:53 -0500
From: Doug MacEachern <dougm@opengroup.org>
Files: perl.c
Msg-ID: 199703192345.SAA15070@postman.osf.org
(applied based on p5p patch as commit 71aeea1753924e6e19c2461e241e3f7d8a570e90)
173 files changed, 17117 insertions, 2774 deletions
@@ -9,6 +9,396 @@ releases.) ---------------- +Version 5.003_94 +---------------- + + CORE LANGUAGE CHANGES + + Title: "Defer creation of array and hash elements as parameters" + From: Chip Salzenberg + Files: dump.c global.sym mg.c op.c op.h perl.h pp.c pp_hot.c proto.h + sv.c + + Title: "New special literal: __PACKAGE__" + From: Chip Salzenberg + Files: keywords.pl pod/perldata.pod toke.c + + Title: "Ignore whitespace before +*? in //x" + From: Chip Salzenberg + Files: regcomp.c + + Title: "Abort compilation at C<BEGIN{}> or C<use> after errors" + From: Chip Salzenberg + Files: op.c pod/perldiag.pod t/pragma/subs.t + + Title: "allow C<substr 'hello', -10>" + From: David Dyck <dcd@tc.fluke.com> + Msg-ID: <97Mar10.155517pst.35716-2@gateway.fluke.com> + Date: Mon, 10 Mar 1997 15:55:44 -0800 + Files: pp.c + + Title: "Regularize C<x % y>, esp. when y is negative" + From: Chip Salzenberg + Files: pp.c + + Title: "Flush before C<flock(FOO, LOCK_UN)>" + From: Chip Salzenberg + Files: pod/perldelta.pod pod/perlfunc.pod pp_sys.c + + Title: "Close loopholes in prototype mismatch warning" + From: Chip Salzenberg + Files: op.c sv.c toke.c + + Title: "Warn on C<while ($x = each %y) {}>" + From: Chip Salzenberg + Files: op.c pod/perldiag.pod + + Title: "Don't warn on C<print $fh func()>" + From: Chip Salzenberg + Files: toke.c + + CORE PORTABILITY + + Title: "Don't say 'static var = 1'" + From: Jarkko Hietaniemi <jhi@iki.fi> + Msg-ID: <199703091319.PAA24714@alpha.hut.fi> + Date: Sun, 9 Mar 1997 15:19:57 +0200 (EET) + Files: malloc.c + + Title: "BSD/OS 3.0 hints" + From: Christopher Davis <ckd@loiosh.kei.com> + Msg-ID: <w47mjakw5t.fsf@loiosh.kei.com> + Date: 14 Mar 1997 16:20:46 -0500 + Files: hints/bsdos.sh + + Title: "More MachTen hints" + From: Tom Phoenix <rootbeer@teleport.com> + Msg-ID: <Pine.GSO.3.95q.970316133852.27997A-100000@kelly.teleport.com + Date: Sun, 16 Mar 1997 13:40:35 -0800 (PST) + Files: hints/machten_2.sh + + Title: "HP/UX hint comments" + From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + Msg-ID: <Pine.SOL.3.95q.970321153918.28770B-100000@fractal.lafayette. + Date: Fri, 21 Mar 1997 15:43:07 -0500 (EST) + Files: hints/hpux.sh + + Title: "VMS update" + From: bailey@hmivax.humgen.upenn.edu (Charles Bailey) + Msg-ID: <1997Mar11.220056.1873182@hmivax.humgen.upenn.edu> + Date: Tue, 11 Mar 1997 22:00:55 -0500 (EST) + Files: lib/ExtUtils/MM_VMS.pm lib/Test/Harness.pm t/op/taint.t + utils/perlbug.PL vms/descrip.mms + + Title: "vmsish.t and related patches" + From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + Msg-ID: <01IGQW3IP1KK005VFB@hmivax.humgen.upenn.edu> + Date: Fri, 21 Mar 1997 01:32:47 -0500 (EST) + Files: MANIFEST perl.h vms/descrip.mms vms/ext/vmsish.t vms/vms.c + + Title: "Win32 update (four patches)" + From: Gurusamy Sarathy <gsar@engin.umich.edu> and + Nick Ing-Simmons <nik@tiuk.ti.com> + Files: MANIFEST README.win32 lib/AutoSplit.pm lib/Cwd.pm + lib/ExtUtils/Command.pm lib/ExtUtils/Install.pm + lib/ExtUtils/MM_OS2.pm lib/ExtUtils/MM_Unix.pm + lib/ExtUtils/MM_Win32.pm lib/ExtUtils/MakeMaker.pm + lib/ExtUtils/Mksymlists.pm lib/File/Basename.pm + lib/File/Path.pm mg.c t/comp/cpp.t t/comp/script.t t/harness + t/io/argv.t t/io/dup.t t/io/fs.t t/io/inplace.t + t/lib/filehand.t t/lib/io_dup.t t/lib/io_sel.t + t/lib/io_taint.t t/op/closure.t t/op/exec.t t/op/glob.t + t/op/goto.t t/op/magic.t t/op/misc.t t/op/rand.t + t/op/split.t t/op/stat.t t/op/sysio.t t/op/taint.t + t/pragma/strict.t t/pragma/subs.t t/pragma/warning.t util.c + win32/* + + OTHER CORE CHANGES + + Title: "Guard against buffer overflow in yyerror() and related funcs" + From: Chip Salzenberg + Files: toke.c + + Title: "For bin compat, rename calllist() and he_{,delay}free" + From: Chip Salzenberg + Files: global.sym hv.c op.c perl.c pod/perlguts.pod proto.h + + Title: "Fix C<print> on tied default handle" + From: Chip Salzenberg + Files: pp_hot.c + + Title: "Fix C<local($a, undef, $b) = (1,2,3)>" + From: Chip Salzenberg + Files: op.c + + Title: "Improve diagnostic on C<@a++>, C<--%a>, @a =~ s/a/b/" + From: Chip Salzenberg + Files: pp.c pp_hot.c + + Title: "Don't warn on C<$x{y} .= "z"> when %x is tied" + From: Chip Salzenberg + Files: pp_hot.c + + Title: "Eliminate 'unreachable code' warnings" + From: Chip Salzenberg + Files: ext/POSIX/POSIX.xs mg.c pp_ctl.c toke.c + + Title: "printf format corrections for -DDEBUGGING" + From: Roderick Schertler <roderick@argon.org> + Msg-ID: <26592.858793370@eeyore.ibcinc.com> + Date: Wed, 19 Mar 1997 12:42:50 -0500 + Files: doop.c malloc.c op.c pp_ctl.c regexec.c sv.c x2p/str.c + x2p/util.c + + Title: "Warn about missing -DMULTIPLICITY if likely a problem" + From: Doug MacEachern <dougm@opengroup.org> + Msg-ID: <199703192345.SAA15070@postman.osf.org> + Date: Wed, 19 Mar 1997 18:45:53 -0500 + Files: perl.c + + BUILD PROCESS + + Title: "Don't use $(LIBS) when creating shared libperl" + From: Chip Salzenberg + Files: Makefile.SH + + Title: "Don't use db 2.x, we're not yet ready for it" + From: Paul Marquess and Andy Dougherty + Files: Configure + + Title: "Warn if #! command is longer than 32 chars" + From: Chip Salzenberg + Files: Configure + + Title: "patches re perl -wc install{perl,man}" + From: Robin Barker <rmb1@cise.npl.co.uk> + Msg-ID: <21544.9703111313@tempest.cise.npl.co.uk> + Date: Tue, 11 Mar 97 13:13:16 GMT + Files: installman installperl + + Title: "3_93 doesn't install pods" + From: Spider Boardman <spider@orb.nashua.nh.us> + Msg-ID: <199703160721.CAA08339@Orb.Nashua.NH.US> + Date: Sun, 16 Mar 1997 02:21:35 -0500 + Files: installperl + + Title: "When installing, use File::Copy instead of `cp`" + From: Chip Salzenberg + Files: installperl + + Title: "Make hint files' warnings more visible" + From: Hallvard B Furuseth <h.b.furuseth@usit.uio.no> + Msg-ID: <199703202218.XAA09041@bombur2.uio.no> + Date: Thu, 20 Mar 1997 23:18:03 +0100 (MET) + Files: hints/3b1.sh hints/apollo.sh hints/cxux.sh hints/dcosx.sh + hints/dgux.sh hints/esix4.sh hints/freebsd.sh hints/hpux.sh + hints/irix_4.sh hints/mips.sh hints/next_3_0.sh hints/os2.sh + hints/qnx.sh hints/sco_2_3_3.sh hints/sco_2_3_4.sh + hints/solaris_2.sh hints/ultrix_4.sh hints/utekv.sh + + LIBRARY AND EXTENSIONS + + Title: "New module: autouse.pm" + From: Ilya Zakharevich <ilya@math.ohio-state.edu> + Msg-ID: <199703210034.TAA13469@monk.mps.ohio-state.edu> + Date: Thu, 20 Mar 1997 19:34:30 -0500 (EST) + Files: MANIFEST lib/autouse.pm + + Title: "Math::Complex update" + From: Jarkko Hietaniemi + Files: lib/Math/Complex.pm t/lib/complex.t + + Title: "Refresh DB_File to 1.12" + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Msg-ID: <9703121551.AA07435@claudius.bfsec.bt.co.uk> + Date: Wed, 12 Mar 97 15:51:14 GMT + Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs + + Title: "New subroutine Symbol::qualify_to_ref()" + From: Roderick Schertler <roderick@argon.org> + Msg-ID: <pzlo7ut03b.fsf@eeyore.ibcinc.com> + Date: 11 Mar 1997 19:39:36 -0500 + Files: lib/Symbol.pm + + Title: "In debugger, don't reference %{$f{$g}} if $f{$g} doesn't exist" + From: Chip Salzenberg + Files: lib/perl5db.pl + + Title: "In File::Path, some systems can't remove read-only files" + From: Chip Salzenberg + Files: lib/File/Path.pm + + Title: "Fix typo in -l*perl* pattern" + From: Doug MacEachern <dougm@opengroup.org> + Msg-ID: <199703110414.XAA12884@berlin.atlantic.net> + Date: Mon, 10 Mar 1997 22:58:38 -0500 + Files: lib/ExtUtils/Embed.pm + + Title: "Fix bugs revealed by prototype warnings" + From: Chip Salzenberg + Files: ext/Opcode/Opcode.pm lib/ExtUtils/MakeMaker.pm + lib/Getopt/Long.pm + + Title: "Problems with SKIP in makemaker" + From: Ilya Zakharevich <ilya@math.ohio-state.edu> + Msg-ID: <199703210413.XAA21601@monk.mps.ohio-state.edu> + Date: Thu, 20 Mar 1997 23:13:31 -0500 (EST) + Files: lib/ExtUtils/MM_Unix.pm + + Title: "In Exporter, don't C<require Carp> at file scope" + From: Chip Salzenberg + Files: lib/Exporter.pm + + Title: "fix for Exporter's $SIG{__WARN__} handler" + From: Roderick Schertler <roderick@argon.org> + Msg-ID: <2282.858296451@eeyore.ibcinc.com> + Date: Thu, 13 Mar 1997 18:40:51 -0500 + Files: lib/Exporter.pm + + Title: "Don't try to substr() refs in Carp" + From: Chip Salzenberg + Files: lib/Carp.pm + + Title: "Re: NUL in die and other messages" + From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk> + Msg-ID: <E0w815V-0005xs-00@ursa.cus.cam.ac.uk> + Date: Fri, 21 Mar 1997 09:58:17 +0000 + Files: lib/Carp.pm + + Title: "Add entry for prototype() in Pod::Functions" + From: Chip Salzenberg + Files: lib/Pod/Functions.pm + + Title: "Fix typos in IO::Socket documentation" + From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk> + Msg-ID: <E0w75po-0003yh-00@taurus.cus.cam.ac.uk> + Date: Tue, 18 Mar 1997 20:50:16 +0000 + Files: ext/IO/lib/IO/Socket.pm + + TESTS + + (no changes) + + UTILITIES + + Title: "Re: bug in pod2man (5.00326): section=3 for .pm modules" + From: Roderick Schertler <roderick@argon.org> + Msg-ID: <pzn2sat1hg.fsf@eeyore.ibcinc.com> + Date: 11 Mar 1997 19:09:31 -0500 + Files: pod/pod2man.PL + + DOCUMENTATION + + Title: "perlfaq.pod" + From: Tom Christiansen <tchrist@jhereg.perl.com> + Msg-ID: <199703172301.QAA12566@jhereg.perl.com> + Date: Mon, 17 Mar 1997 16:01:40 -0700 + Files: MANIFEST pod/Makefile pod/buildtoc pod/perl.pod + pod/perlfaq*.pod pod/roffitall + + Title: "*.pod changes based on the FAQ" + From: gnat@frii.com + Msg-ID: <199703171650.JAA02655@elara.frii.com> + Date: Mon, 17 Mar 1997 09:50:14 -0700 (MST) + Files: pod/perldata.pod pod/perlfunc.pod pod/perlipc.pod + pod/perlop.pod pod/perlre.pod pod/perlrun.pod + pod/perlsec.pod pod/perlvar.pod + + Title: "INSTALL: How to enable debugging" + From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + Msg-ID: <Pine.SOL.3.95q.970321112326.1414A-100000@fractal.lafayette.e + Date: Fri, 21 Mar 1997 11:25:32 -0500 (EST) + Files: INSTALL + + Title: "Document that $. is not reset on implicit open" + From: Chip Salzenberg + Files: pod/perldelta.pod + + Title: "Re: Embedding success with _93 " + From: Doug MacEachern <dougm@opengroup.org> + Msg-ID: <199703112255.RAA22775@postman.osf.org> + Date: Tue, 11 Mar 1997 17:55:05 -0500 + Files: pod/perldelta.pod + + Title: "Update site list" + From: lvirden@cas.org (Larry W. Virden, x2487) + Msg-ID: <9703111053.AA20051@cas.org> + Date: Tue, 11 Mar 1997 10:53:49 -0500 + Files: pod/perlmod.pod + + Title: "Patch to document illegal characters" + From: Tom Phoenix <rootbeer@teleport.com> + Msg-ID: <Pine.GSO.3.96.970314090558.15346J-100000@kelly.teleport.com> + Date: Fri, 14 Mar 1997 09:08:10 -0800 (PST) + Files: pod/perldiag.pod pod/perltrap.pod + + Title: "Document trap with //o and closures" + From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> + Msg-ID: <01IGCHWRNSEU00661G@hmivax.humgen.upenn.edu> + Date: Mon, 10 Mar 1997 18:08:08 -0500 (EST) + Files: pod/perltrap.pod + + Title: "Re: Inline PI function" + From: Tom Phoenix <rootbeer@teleport.com> + Msg-ID: <Pine.GSO.3.95q.970310143125.22489V-100000@kelly.teleport.com + Date: Mon, 10 Mar 1997 14:33:20 -0800 (PST) + Files: pod/perlsub.pod + + Title: "Illegal character in input" + From: Tom Phoenix <rootbeer@teleport.com> + Msg-ID: <Pine.GSO.3.95q.970310151512.22489a-100000@kelly.teleport.com + Date: Mon, 10 Mar 1997 15:21:21 -0800 (PST) + Files: pod/perldiag.pod + + Title: "Patch for docs Re: Lost backslash" + From: Tom Phoenix <rootbeer@teleport.com> + Msg-ID: <Pine.GSO.3.96.970319071438.24834G-100000@kelly.teleport.com> + Date: Wed, 19 Mar 1997 07:28:57 -0800 (PST) + Files: pod/perlop.pod + + Title: "XSUB's doc fix" + From: Roderick Schertler <roderick@argon.org> + Msg-ID: <28804.858012126@eeyore.ibcinc.com> + Date: Mon, 10 Mar 1997 11:42:06 -0500 + Files: pod/perlcall.pod pod/perlguts.pod pod/perlxstut.pod + + Title: "Document return from do FILE" + From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk> + Msg-ID: <E0w70DK-0001yJ-00@ursa.cus.cam.ac.uk> + Date: Tue, 18 Mar 1997 14:50:10 +0000 + Files: pod/perlfunc.pod + + Title: "Document $^M in perlvar" + From: Robin Barker <rmb1@cise.npl.co.uk> + Msg-ID: <6153.9703202108@tempest.cise.npl.co.uk> + Date: Thu, 20 Mar 97 21:08:33 GMT + Files: pod/perlvar.pod + + Title: "typos in pods of 5.003_93" + From: Jim Meyering <meyering@asic.sc.ti.com> + Msg-ID: <wpgendbzvhx.fsf@asic.sc.ti.com> + Date: 19 Mar 1997 10:39:38 -0600 + Files: pod/perlfunc.pod pod/perlguts.pod pod/perlre.pod + pod/perltoot.pod pod/perlxs.pod + + Title: "Re: Updates to pod punctuations" + From: lvirden@cas.org (Larry W. Virden, x2487) + Msg-ID: <9703141700.AA22911@cas.org> + Date: Fri, 14 Mar 1997 17:00:12 -0500 + Files: pod/*.pod + + Title: "clarify example in perlfunc" + From: Jarkko Hietaniemi <jhi@iki.fi> + Msg-ID: <199703201746.TAA25195@alpha.hut.fi> + Date: Thu, 20 Mar 1997 19:46:01 +0200 (EET) + Files: pod/perlfunc.pod + + Title: "Regularize headings in DB_File documentation" + From: Chip Salzenberg + Files: ext/DB_File/DB_File.pm + + +---------------- Version 5.003_93 ---------------- @@ -5324,8 +5324,17 @@ EOH rp='What shall I put after the #! to start up perl ("none" to not use #!)?' . ./myread case "$ans" in - none) startperl=": # use perl";; - *) startperl="#!$ans";; + none) startperl=": # use perl";; + *) startperl="#!$ans" + if $test 33 -lt `echo "$ans" | wc -c`; then + $cat >&4 <<EOM + +WARNING: Some systems limit the #! command to 32 characters. +If you experience difficulty running Perl scripts with #!, try +installing Perl in a directory with a shorter pathname. + +EOM + fi ;; esac ;; *) startperl=": # use perl" @@ -8222,6 +8231,51 @@ set db.h i_db eval $inhdr case "$i_db" in +$define) + : Check db version. We can not use version 2. + echo " " + echo "Checking Berkeley DB version ..." >&4 + $cat >try.c <<EOCP +#$d_const HASCONST +#ifndef HASCONST +#define const +#endif +#include <sys/types.h> +#include <stdio.h> +#include <db.h> +main() +{ +#ifdef DB_VERSION_MAJOR + printf("You have Berkeley DB Version %d.%d\n", + DB_VERSION_MAJOR, DB_VERSION_MINOR); + printf("Perl currently only supports up to version 1.86.\n"); + exit(1); +#else + exit(0); +#endif +} +EOCP + if $cc $optimize $ccflags $ldflags -o try try.c $libs && ./try; then + echo 'Looks OK. (Perl supports up to version 1.86).' >&4 + else + echo "I can't use your Berkeley DB. I'll disable it." >&4 + i_db=$undef + case " $libs " in + *"-ldb "*) + : Remove db from list of libraries to use + echo "Removing unusable -ldb from library list" >&4 + set `echo X $libs | $sed -e 's/-ldb / /' -e 's/-ldb$//'` + shift + libs="$*" + echo "libs = $libs" >&4 + ;; + esac + fi + $rm -f try.* + ;; +esac + +case "$i_db" in define) : Check the return type needed for hash echo " " @@ -8251,13 +8305,15 @@ EOCP db_hashtype='u_int32_t' fi else - echo "I can't seem to compile the test program." >&4 - db_hashtype=int + : XXX Maybe we should just give up here. + db_hashtype=u_int32_t + echo "Help: I can't seem to compile the db test program." >&4 + echo "Something's wrong, but I'll assume you use $db_hashtype." >&4 fi $rm -f try.* echo "Your version of Berkeley DB uses $db_hashtype for hash." ;; -*) db_hashtype=int +*) db_hashtype=u_int32_t ;; esac @@ -8291,13 +8347,15 @@ EOCP db_prefixtype='size_t' fi else - echo "I can't seem to compile the test program." >&4 - db_prefixtype='int' + db_prefixtype='size_t' + : XXX Maybe we should just give up here. + echo "Help: I can't seem to compile the db test program." >&4 + echo "Something's wrong, but I'll assume you use $db_prefixtype." >&4 fi $rm -f try.* echo "Your version of Berkeley DB uses $db_prefixtype for prefix." ;; -*) db_prefixtype='int' +*) db_prefixtype='size_t' ;; esac @@ -21,6 +21,7 @@ README.os2 Notes about OS/2 port README.plan9 Notes about Plan9 port README.qnx Notes about QNX port README.vms Notes about VMS port +README.win32 Notes about Win32 port Todo The Wishlist XSUB.h Include file for extension subroutines av.c Array value code @@ -292,12 +293,14 @@ lib/DirHandle.pm like FileHandle only for directories lib/English.pm Readable aliases for short variables lib/Env.pm Map environment into ordinary variables lib/Exporter.pm Exporter base class +lib/ExtUtils/Command.pm Utilities for Make on non-UNIX platforms lib/ExtUtils/Embed.pm Utilities for embedding Perl in C programs lib/ExtUtils/Install.pm Handles 'make install' on extensions lib/ExtUtils/Liblist.pm Locates libraries lib/ExtUtils/MM_OS2.pm MakeMaker methods for OS/2 lib/ExtUtils/MM_Unix.pm MakeMaker base class for Unix lib/ExtUtils/MM_VMS.pm MakeMaker methods for VMS +lib/ExtUtils/MM_Win32.pm MakeMaker methods for Win32 lib/ExtUtils/MakeMaker.pm Write Makefiles for extensions lib/ExtUtils/Manifest.pm Utilities to write MANIFEST files lib/ExtUtils/Mkbootstrap.pm Writes a bootstrap file (see MakeMaker) @@ -359,6 +362,7 @@ lib/User/grent.pm By-name interface to Perl's built-in getgr* lib/User/pwent.pm By-name interface to Perl's built-in getpw* lib/abbrev.pl An abbreviation table builder lib/assert.pl assertion and panic with stack trace +lib/autouse.pm Load and call a function only when it's used lib/bigfloat.pl An arbitrary precision floating point package lib/bigint.pl An arbitrary precision integer arithmetic package lib/bigrat.pl An arbitrary precision rational arithmetic package @@ -504,6 +508,16 @@ pod/perldelta.pod Changes since last version pod/perldiag.pod Diagnostic info pod/perldsc.pod Data Structures Cookbook pod/perlembed.pod Embedding info +pod/perlfaq.pod Frequently Asked Questions, Top Level +pod/perlfaq1.pod Frequently Asked Questions, Part 1 +pod/perlfaq2.pod Frequently Asked Questions, Part 2 +pod/perlfaq3.pod Frequently Asked Questions, Part 3 +pod/perlfaq4.pod Frequently Asked Questions, Part 4 +pod/perlfaq5.pod Frequently Asked Questions, Part 5 +pod/perlfaq6.pod Frequently Asked Questions, Part 6 +pod/perlfaq7.pod Frequently Asked Questions, Part 7 +pod/perlfaq8.pod Frequently Asked Questions, Part 8 +pod/perlfaq9.pod Frequently Asked Questions, Part 9 pod/perlform.pod Format info pod/perlfunc.pod Function info pod/perlguts.pod Internals info @@ -741,6 +755,7 @@ vms/ext/Stdio/test.pl regression tests for VMS::Stdio vms/ext/XSSymSet.pm manage linker symbols when building extensions vms/ext/filespec.t See if VMS::Filespec funtions work vms/ext/vmsish.pm Control VMS-specific behavior of Perl core +vms/ext/vmsish.t Tests for vmsish.pm vms/fndvers.com parse Perl version from patchlevel.h vms/gen_shrfls.pl generate options files and glue for shareable image vms/genconfig.pl retcon config.sh from config.h @@ -763,10 +778,17 @@ win32/Fcntl.mak Win32 port win32/IO.mak Win32 port win32/Makefile Win32 port win32/Opcode.mak Win32 port -win32/README Win32 port win32/SDBM_File.mak Win32 port win32/Socket.mak Win32 port win32/TEST Win32 port +win32/VC-2.0/SDBM_File.mak Win32 port +win32/VC-2.0/Socket.mak Win32 port +win32/VC-2.0/libperl.mak Win32 port +win32/VC-2.0/miniperl.mak Win32 port +win32/VC-2.0/modules.mak Win32 port +win32/VC-2.0/perl.mak Win32 port +win32/VC-2.0/perldll.mak Win32 port +win32/VC-2.0/vc2.patch Win32 port win32/autosplit.pl Win32 port win32/bin/PL2BAT.BAT Win32 port win32/bin/network.pl Win32 port @@ -800,8 +822,8 @@ win32/runperl.c Win32 port win32/splittree.pl Win32 port win32/win32.c Win32 port win32/win32.h Win32 port -win32/win32aux.cpp Win32 port -win32/win32io.cpp Win32 port +win32/win32aux.c Win32 port +win32/win32io.c Win32 port win32/win32io.h Win32 port win32/win32iop.h Win32 port win32/win32sck.c Win32 port diff --git a/README.win32 b/README.win32 new file mode 100644 index 0000000000..36953ec0da --- /dev/null +++ b/README.win32 @@ -0,0 +1,275 @@ +If you read this file _as_is_, just ignore the funny characters you +see. It is written in the POD format (see pod/perlpod.pod) which is +specially designed to be readable as is. + +=head1 NAME + +perlwin32 - Perl under WindowsNT [XXX and perhaps under Windows95] + +=head1 SYNOPSIS + +These are instructions for building Perl under WindowsNT (versions +3.51 or 4.0), using Visual C++. + +=head1 DESCRIPTION + +Before you start, you should glance through the README file found +found in the top-level directory where the Perl distribution +was extracted. Make sure you read and understand the terms under +which this software is being distributed. + +Make sure you read the L<BUGS AND CAVEATS> section below for the +known limitations of this port. + +The INSTALL file in the perl top-level has much information that is +only relevant to people building Perl on Unix-like systems. In +particular, you can safely ignore any information that talks about +"Configure". + +You should probably also read the README.os2 file, which gives a +different set of rules to build a Perl that will work on Win32 +platforms. That method will probably enable you to build a more +Unix-compatible perl, but you will also need to download and use +various other support software described in that file. + +This set of instructions is meant to describe a so-called "native" +port of Perl to Win32 platforms. The resulting Perl requires no +additional software to run (other than what came with your operating +system). Currently, this port is only capable of using Microsoft's +Visual C++ compiler. The ultimate goal is to support the other major +compilers that can be used on the platforms. + +=head2 Setting Up + +=over 4 + +=item * + +Use the default "cmd" shell that comes with NT. In particular, do +*not* use the 4DOS/NT shell. The Makefile has commands that are not +compatible with that shell. + +=item * + +Run the VCVARS32.BAT file usually found somewhere like C:\MSDEV4.2\BIN. +This will set your build environment. + +=item * + +Depending on how you extracted the distribution, you have to make sure +all the files are writable by you. The easiest way to make sure of +this is to execute: + + attrib -R *.* /S + +from the perl toplevel directory. You don't I<have> to do this if you +used the right tools to extract the files in the standard distribution, +but it doesn't hurt to do so. + +=back + +=head2 Building and Installation + +=over 4 + +=item * + +The "win32" directory contains *.mak files for use with the NMAKE that +comes with Visual C++ ver. 4.0 and above. If you wish to build perl +using Visual C++ versions between 2.0 and 4.0, do the following three +additional steps (these three steps are not required if you are +using Visual C++ versions 4.0 and above): + +=over 8 + +=item 1. + +Overwrite the *.mak files in the win32 subdirectory with the versions +in the win32\VC-2.0 directory. (The only difference in those makefiles +is in how the $(INCLUDE) variable is handled--VC 2.0 NMAKE does not +grok a path list in $(INCLUDE)). + +=item 2. + +Reset your INCLUDE environment variable to the MSVC include directory. +For example: + + set INCLUDE=E:\MSVC20\INCLUDE + +This must have only one directory (a list of directories will not work). +VCVARS32.BAT may put multiple locations in there, which is why this step +is required. + +=item 3. + +Apply the patch found in win32\VC-2.0\vc2.patch, like so: + + cd win32 + patch -p2 -N < VC-2.0\vc2.patch + +You may have to edit win32\win32.c manually if you don't have GNU patch. + +=back + +=item * + +Make sure you are in the "win32" subdirectory under the perl toplevel. + +=item * + +Type "nmake" while in the "win32" subdirectory. This should build +everything. Specifically, it will create perl.exe, perl.dll, and +perlglob.exe at the perl toplevel, and various other extension dll's +under the lib\auto directory. If the make fails for any reason, make +sure you have done the previous steps correctly. + +=item * + +Type "nmake install". This will put the newly built perl and the +libraries under C:\PERL. If you want to alter this location, to say, +D:\FOO\PERL, you will have to say: + + nmake install INST_TOP=D:\FOO\PERL + +instead. To use the Perl you just installed, make sure you set your +PATH environment variable to C:\PERL\BIN (or D:\FOO\PERL\BIN). + +=back + +=head2 Testing + +Type "nmake test". This will run most of the tests from the +testsuite (many tests will be skipped, and some tests will fail). +Most failures are due to UNIXisms in the standard perl testsuite. + +To get a more detailed breakdown of the tests that failed, say: + + cd ..\t + .\perl harness + +This should produce a summary very similar to the following: + + Failed Test Status Wstat Total Fail Failed List of failed + ------------------------------------------------------------------------------ + io/fs.t 26 16 61.54% 1-5, 7-11, 16-18, 23-25 + io/tell.t 13 1 7.69% 10 + lib/anydbm.t 12 1 8.33% 2 + lib/findbin.t 1 1 100.00% 1 + lib/sdbm.t 12 1 8.33% 2 + op/mkdir.t 7 2 28.57% 3, 7 + op/runlevel.t 8 1 12.50% 4 + op/stat.t 56 3 5.36% 3-4, 20 + op/taint.t 98 20 20.41% 1-6, 14, 16, 19-21, 24, 26, 35-3 + pragma/locale.t 98 40 40.82% 1, 13-14, 21-27, 33, 39, 45-53, + Failed 10/149 test scripts, 93.29% okay. 86/3506 subtests failed, 97.55% okay. + +Check if any additional tests other than the ones shown here +failed. The standard testsuite will ultimately be modified so +that the testsuite avoids running irrelevant tests on Win32. + +=head1 BUGS AND CAVEATS + +This is still very much an experimental port, and should be considered +alpha quality software. You can expect changes in virtually all of +these areas: build process, installation structure, supported +utilities/modules, and supported perl functionality. Specifically, +functionality that supports the Win32 environment may be ultimately +be supported as either core modules or extensions. + +Many tests from the standard testsuite either fail or produce different +results under this port. Most of the problems fall under one of these +categories + +=over 8 + +=item * + +C<stat()> and C<lstat()> functions may not behave as documented. They +may return values that bear no resemblance to those reported on Unix +platforms, and some fields may be completely bogus. + +=item * + +The following functions are currently unavailable: C<fork()>, C<exec()>, +C<dump()>, C<kill()>, C<chown()>, C<link()>, C<symlink()>, C<chroot()>, +C<setpgrp()>, C<getpgrp()>, C<setpriority()>, C<getpriority()>, +C<syscall()>, C<fcntl()>, C<flock()>. This list is possibly incomplete. + +=item * + +Various C<socket()> related calls are supported, but they may not +behave as on Unix platforms. + +=item * + +The four-argument C<select()> call is only supported on sockets. + +=item * + +The behavior of C<system()> or the C<qx[]> operator (a.k.a. "backticks"), +when used to call interactive commands, is ill-defined. + +=item * + +C<$!> doesn't work reliably yet. + +=item * + +Building modules available on CPAN is mostly supported, but this +hasn't been tested much yet. Expect strange problems, and be +prepared to deal with the consequences. + +=item * + +C<utime()>, C<times()> and process-related functions may not +behave as described in the documentation, and some of the +returned values or effects may be bogus. + +=item * + +Signal handling may not behave as on Unix platforms. + +=item * + +File globbing may not behave as on Unix platforms. + +=item * + +Not all of the utilities that come with the Perl distribution +are supported yet. + +=back + +Please send detailed descriptions of any problems and solutions that +you may find to <F<perlbug@perl.com>>, along with the output produced +by C<perl -V>. + +=head1 AUTHORS + +=over 4 + +=item Gary Ng <F<71564.1743@CompuServe.COM>> + +=item Gurusamy Sarathy <F<gsar@umich.edu>> + +=item Nick Ing-Simmons <F<nick@ni-s.u-net.com>> + +=back + +=head1 SEE ALSO + +L<perl> + +=head1 HISTORY + +This port was originally contributed by Gary Ng around 5.003_24, +and borrowed from the Hip Communications port that was available +at the time. + +Nick Ing-Simmons and Gurusamy Sarathy have made numerous and +sundry hacks since then. + +Last updated: 19 March 1997 + +=cut + @@ -712,8 +712,10 @@ dARGS sv_setsv(tmpstr,hv_iterval(hv,entry)); SPAGAIN; DEBUG_H( { - sprintf(buf,"%d%%%d=%d\n", HeHASH(entry), - HvMAX(hv)+1, HeHASH(entry) & HvMAX(hv)); + sprintf(buf,"%lu%%%d=%lu\n", + (unsigned long)HeHASH(entry), + HvMAX(hv)+1, + (unsigned long)(HeHASH(entry) & HvMAX(hv))); sv_setpv(tmpstr,buf); } ) XPUSHs(sv_2mortal(tmpstr)); @@ -185,10 +185,12 @@ register OP *op; op->op_type == OP_AELEM || op->op_type == OP_HELEM ) { - if (op->op_private & OPpENTERSUB_AMPER) - (void)strcat(buf,"AMPER,"); - if (op->op_private & OPpENTERSUB_DB) - (void)strcat(buf,"DB,"); + if (op->op_type == OP_ENTERSUB) { + if (op->op_private & OPpENTERSUB_AMPER) + (void)strcat(buf,"AMPER,"); + if (op->op_private & OPpENTERSUB_DB) + (void)strcat(buf,"DB,"); + } switch (op->op_private & OPpDEREF) { case OPpDEREF_SV: (void)strcat(buf, "SV,"); @@ -200,8 +202,14 @@ register OP *op; (void)strcat(buf, "HV,"); break; } - if (op->op_private & HINT_STRICT_REFS) - (void)strcat(buf,"STRICT_REFS,"); + if (op->op_type == OP_AELEM || op->op_type == OP_HELEM) { + if (op->op_private & OPpLVAL_DEFER) + (void)strcat(buf,"LVAL_DEFER,"); + } + else { + if (op->op_private & HINT_STRICT_REFS) + (void)strcat(buf,"STRICT_REFS,"); + } } else if (op->op_type == OP_CONST) { if (op->op_private & OPpCONST_BARE) @@ -60,7 +60,7 @@ #define bufend Perl_bufend #define bufptr Perl_bufptr #define bxor_amg Perl_bxor_amg -#define calllist Perl_calllist +#define call_list Perl_call_list #define cando Perl_cando #define cast_ulong Perl_cast_ulong #define check Perl_check @@ -232,19 +232,19 @@ #define gv_stashpv Perl_gv_stashpv #define gv_stashpvn Perl_gv_stashpvn #define gv_stashsv Perl_gv_stashsv -#define he_delayfree Perl_he_delayfree -#define he_free Perl_he_free #define he_root Perl_he_root #define hexdigit Perl_hexdigit #define hints Perl_hints #define hoistmust Perl_hoistmust #define hv_clear Perl_hv_clear +#define hv_delayfree_ent Perl_hv_delayfree_ent #define hv_delete Perl_hv_delete #define hv_delete_ent Perl_hv_delete_ent #define hv_exists Perl_hv_exists #define hv_exists_ent Perl_hv_exists_ent #define hv_fetch Perl_hv_fetch #define hv_fetch_ent Perl_hv_fetch_ent +#define hv_free_ent Perl_hv_free_ent #define hv_iterinit Perl_hv_iterinit #define hv_iterkey Perl_hv_iterkey #define hv_iterkeysv Perl_hv_iterkeysv @@ -307,11 +307,11 @@ #define magic_clearpack Perl_magic_clearpack #define magic_clearsig Perl_magic_clearsig #define magic_existspack Perl_magic_existspack -#define magic_freeitervar Perl_magic_freeitervar +#define magic_freedefelem Perl_magic_freedefelem #define magic_get Perl_magic_get #define magic_getarylen Perl_magic_getarylen +#define magic_getdefelem Perl_magic_getdefelem #define magic_getglob Perl_magic_getglob -#define magic_getitervar Perl_magic_getitervar #define magic_getpack Perl_magic_getpack #define magic_getpos Perl_magic_getpos #define magic_getsig Perl_magic_getsig @@ -325,11 +325,11 @@ #define magic_setbm Perl_magic_setbm #define magic_setcollxfrm Perl_magic_setcollxfrm #define magic_setdbline Perl_magic_setdbline +#define magic_setdefelem Perl_magic_setdefelem #define magic_setenv Perl_magic_setenv #define magic_setfm Perl_magic_setfm #define magic_setglob Perl_magic_setglob #define magic_setisa Perl_magic_setisa -#define magic_setitervar Perl_magic_setitervar #define magic_setmglob Perl_magic_setmglob #define magic_setnkeys Perl_magic_setnkeys #define magic_setpack Perl_magic_setpack @@ -845,7 +845,6 @@ #define pregfree Perl_pregfree #define prepend_elem Perl_prepend_elem #define profiledata Perl_profiledata -#define provide_ref Perl_provide_ref #define psig_name Perl_psig_name #define psig_ptr Perl_psig_ptr #define push_return Perl_push_return @@ -1064,20 +1063,21 @@ #define utilize Perl_utilize #define varies Perl_varies #define vert Perl_vert -#define vivify_itervar Perl_vivify_itervar +#define vivify_defelem Perl_vivify_defelem +#define vivify_ref Perl_vivify_ref #define vtbl_amagic Perl_vtbl_amagic #define vtbl_amagicelem Perl_vtbl_amagicelem #define vtbl_arylen Perl_vtbl_arylen #define vtbl_bm Perl_vtbl_bm #define vtbl_collxfrm Perl_vtbl_collxfrm #define vtbl_dbline Perl_vtbl_dbline +#define vtbl_defelem Perl_vtbl_defelem #define vtbl_env Perl_vtbl_env #define vtbl_envelem Perl_vtbl_envelem #define vtbl_fm Perl_vtbl_fm #define vtbl_glob Perl_vtbl_glob #define vtbl_isa Perl_vtbl_isa #define vtbl_isaelem Perl_vtbl_isaelem -#define vtbl_itervar Perl_vtbl_itervar #define vtbl_mglob Perl_vtbl_mglob #define vtbl_nkeys Perl_vtbl_nkeys #define vtbl_pack Perl_vtbl_pack diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm index d962b88b2e..c2609a074b 100644 --- a/ext/DB_File/DB_File.pm +++ b/ext/DB_File/DB_File.pm @@ -1,8 +1,8 @@ # DB_File.pm -- Perl 5 interface to Berkeley DB # # written by Paul Marquess (pmarquess@bfsec.bt.co.uk) -# last modified 6th Feb 1997 -# version 1.11 +# last modified 12th Mar 1997 +# version 1.12 # # Copyright (c) 1995, 1996, 1997 Paul Marquess. All rights reserved. # This program is free software; you can redistribute it and/or @@ -146,7 +146,7 @@ use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO) ; use Carp; -$VERSION = "1.11" ; +$VERSION = "1.12" ; #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE; $DB_BTREE = new DB_File::BTREEINFO ; @@ -326,6 +326,10 @@ module you should really have a copy of the Berkeley DB manual pages at hand. The interface defined here mirrors the Berkeley DB interface closely. +Please note that this module will only work with version 1.x of +Berkeley DB. Once Berkeley DB version 2 is released, B<DB_File> will be +upgraded to work with it. + Berkeley DB is a C library which provides a consistent interface to a number of database formats. B<DB_File> provides an interface to all three of the database types currently supported by Berkeley DB. @@ -365,7 +369,7 @@ number. =back -=head2 How does DB_File interface to Berkeley DB? +=head2 Interface to Berkeley DB B<DB_File> allows access to Berkeley DB files using the tie() mechanism in Perl 5 (for full details, see L<perlfunc/tie()>). This facility @@ -533,7 +537,7 @@ The DB_HASH file format is probably the most commonly used of the three file formats that B<DB_File> supports. It is also very straightforward to use. -=head2 A Simple Example. +=head2 A Simple Example This example shows how to create a database, add key/value pairs to the database, delete keys/value pairs and finally how to enumerate the @@ -645,7 +649,7 @@ database. =back -=head2 Handling duplicate keys +=head2 Handling Duplicate Keys The BTREE file type optionally allows a single key to be associated with an arbitrary number of values. This option is enabled by setting @@ -752,7 +756,7 @@ that prints: This time we have got all the key/value pairs, including the multiple values associated with the key C<Wall>. -=head2 The get_dup method. +=head2 The get_dup() Method B<DB_File> comes with a utility method, called C<get_dup>, to assist in reading duplicate values from BTREE databases. The method can take the @@ -893,7 +897,7 @@ negative indexes. The index -1 refers to the last element of the array, -2 the second last, and so on. Attempting to access an element before the start of the array will raise a fatal run-time error. -=head2 The bval option +=head2 The 'bval' Option The operation of the bval option warrants some discussion. Here is the definition of bval from the Berkeley DB 1.85 recno manual page: @@ -1144,7 +1148,7 @@ destroyed. undef $db ; untie %hash ; -See L<The untie Gotcha> for more details. +See L<The untie gotcha> for more details. All the functions defined in L<dbopen> are available except for close() and dbopen() itself. The B<DB_File> method interface to the @@ -1333,7 +1337,7 @@ in the background to watch the locks granted in proper order. close(DB_FH); print "$$: Updated db to $key=$value\n"; -=head2 Sharing databases with C applications +=head2 Sharing Databases With C Applications There is no technical reason why a Berkeley DB database cannot be shared by both a Perl and a C application. @@ -1391,10 +1395,10 @@ F<authors/id/TOMC/scripts/nshist.gz>). untie %hist_db ; -=head2 The untie gotcha +=head2 The untie() Gotcha If you make use of the Berkeley DB API, it is is I<very> strongly -recommended that you read L<perltie/The untie gotcha>. +recommended that you read L<perltie/The untie Gotcha>. Even if you don't currently make use of the API interface, it is still worth reading it. @@ -1642,6 +1646,10 @@ Fixed fd method so that it still returns -1 for in-memory files when db Documented the untie gotcha. +=item 1.12 + +Documented the incompatibility with version 2 of Berkeley DB. + =back =head1 BUGS @@ -1658,7 +1666,10 @@ suggest any enhancements, I would welcome your comments. B<DB_File> comes with the standard Perl source distribution. Look in the directory F<ext/DB_File>. -Berkeley DB is available at your nearest CPAN archive (see +This version of B<DB_File> will only work with version 1.x of Berkeley +DB. It is I<not> yet compatible with version 2. + +Version 1 of Berkeley DB is available at your nearest CPAN archive (see L<perlmod/"CPAN"> for a list) in F<src/misc/db.1.85.tar.gz>, or via the host F<ftp.cs.berkeley.edu> in F</ucb/4bsd/db.tar.gz>. Alternatively, check out the Berkeley DB home page at F<http://www.bostic.com/db>. It diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs index 796c5c669c..93cf44aa3a 100644 --- a/ext/DB_File/DB_File.xs +++ b/ext/DB_File/DB_File.xs @@ -3,8 +3,8 @@ DB_File.xs -- Perl 5 interface to Berkeley DB written by Paul Marquess (pmarquess@bfsec.bt.co.uk) - last modified 6th Feb 1997 - version 1.11 + last modified 12th Mar 1997 + version 1.12 All comments/suggestions/problems are welcome @@ -38,6 +38,7 @@ 1.10 - Fixed fd method so that it still returns -1 for in-memory files when db 1.86 is used. 1.11 - No change to DB_File.xs + 1.12 - No change to DB_File.xs */ diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm index 1675d469b1..5db658d601 100644 --- a/ext/Opcode/Opcode.pm +++ b/ext/Opcode/Opcode.pm @@ -22,15 +22,16 @@ BEGIN { ); } +sub opset (;@); +sub opset_to_hex ($); +sub opdump (;$); use subs @EXPORT_OK; bootstrap Opcode $VERSION; _init_optags(); - -*ops_to_opset = \&opset; # alias for old name - +sub ops_to_opset { opset @_ } # alias for old name sub opset_to_hex ($) { return "(invalid opset)" unless verify_opset($_[0]); diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 2575ca19cb..f723db796a 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -1731,13 +1731,13 @@ int arg; goto not_there; #endif #ifdef SIG_DFL - if (strEQ(name, "SIG_DFL")) return (int)SIG_DFL; + if (strEQ(name, "SIG_DFL")) return (IV)SIG_DFL; #endif #ifdef SIG_ERR - if (strEQ(name, "SIG_ERR")) return (int)SIG_ERR; + if (strEQ(name, "SIG_ERR")) return (IV)SIG_ERR; #endif #ifdef SIG_IGN - if (strEQ(name, "SIG_IGN")) return (int)SIG_IGN; + if (strEQ(name, "SIG_IGN")) return (IV)SIG_IGN; #endif if (strEQ(name, "SIG_SETMASK")) #ifdef SIG_SETMASK diff --git a/global.sym b/global.sym index f1d0573b22..ddfe93130c 100644 --- a/global.sym +++ b/global.sym @@ -163,7 +163,6 @@ pow_amg pow_ass_amg ppaddr profiledata -provide_ref psig_name psig_ptr rcsid @@ -241,20 +240,21 @@ tokenbuf uid varies vert -vivify_itervar +vivify_defelem +vivify_ref vtbl_amagic vtbl_amagicelem vtbl_arylen vtbl_bm vtbl_collxfrm vtbl_dbline +vtbl_defelem vtbl_env vtbl_envelem vtbl_fm vtbl_glob vtbl_isa vtbl_isaelem -vtbl_itervar vtbl_mglob vtbl_nkeys vtbl_pack @@ -320,7 +320,7 @@ bind_match block_end block_start boot_core_UNIVERSAL -calllist +call_list cando cast_ulong check_uni @@ -449,17 +449,17 @@ gv_init gv_stashpv gv_stashpvn gv_stashsv -he_delayfree -he_free he_root hoistmust hv_clear +hv_delayfree_ent hv_delete hv_delete_ent hv_exists hv_exists_ent hv_fetch hv_fetch_ent +hv_free_ent hv_iterinit hv_iterkey hv_iterkeysv @@ -493,11 +493,11 @@ magic_clearenv magic_clearpack magic_clearsig magic_existspack -magic_freeitervar +magic_freedefelem magic_get magic_getarylen +magic_getdefelem magic_getglob -magic_getitervar magic_getpack magic_getpos magic_getsig @@ -511,11 +511,11 @@ magic_setarylen magic_setbm magic_setcollxfrm magic_setdbline +magic_setdefelem magic_setenv magic_setfm magic_setglob magic_setisa -magic_setitervar magic_setmglob magic_setnkeys magic_setpack diff --git a/hints/3b1.sh b/hints/3b1.sh index 2ed65c591b..991348af3e 100644 --- a/hints/3b1.sh +++ b/hints/3b1.sh @@ -10,6 +10,6 @@ do rm -f $i/3b1cc ln ../hints/3b1cc $i done -echo "\nIf you want to use the 3b1 shared libraries, complete this script then" -echo "read the header in 3b1cc. [Type carriage return to continue]\c" +echo "\nIf you want to use the 3b1 shared libraries, complete this script then" >&4 +echo "read the header in 3b1cc. [Type carriage return to continue]\c" >&4 read vch diff --git a/hints/apollo.sh b/hints/apollo.sh index 2618039634..8c361aa051 100644 --- a/hints/apollo.sh +++ b/hints/apollo.sh @@ -15,7 +15,7 @@ i_malloc='undef' malloctype='void *' # This info is left over from perl4. -cat <<'EOF' +cat <<'EOF' >&4 Some tests may fail unless you use 'chacl -B'. Also, op/stat test 2 may fail occasionally because Apollo doesn't guarantee that mtime will be equal to ctime on a newly created unmodified diff --git a/hints/cxux.sh b/hints/cxux.sh index f2e8c17c10..42bfe5d579 100644 --- a/hints/cxux.sh +++ b/hints/cxux.sh @@ -1,3 +1,4 @@ +#! /local/gnu/bin/bash # Hints for the CX/UX 7.1 operating system running on Concurrent (formerly # Harris) NightHawk machines. written by Tom.Horsley@mail.ccur.com # @@ -7,27 +8,27 @@ # case ${SDE_TARGET:-ELF} in [Cc][Oo][Ff][Ff]|[Oo][Cc][Ss]) echo '' - echo '' - echo WARNING: Do not build perl 5 with the SDE_TARGET set to - echo generate coff object - perl 5 must be built in the ELF - echo environment. - echo '' + echo '' >&2 + echo WARNING: Do not build perl 5 with the SDE_TARGET set to >&2 + echo generate coff object - perl 5 must be built in the ELF >&2 + echo environment. >&2 + echo '' >&2 echo '';; [Ee][Ll][Ff]) : ;; - *) echo '' - echo 'Unknown SDE_TARGET value: '$SDE_TARGET - echo '';; + *) echo '' >&2 + echo 'Unknown SDE_TARGET value: '$SDE_TARGET >&2 + echo '' >&2 ;; esac case `uname -r` in [789]*) : ;; *) echo '' - echo '' - echo WARNING: Perl 5 requires shared library support, it cannot - echo be built on releases of CX/UX prior to 7.0 with this hints - echo file. You\'ll have to do a separate port for the statically - echo linked COFF environment. - echo '' + echo '' >&2 + echo WARNING: Perl 5 requires shared library support, it cannot >&2 + echo be built on releases of CX/UX prior to 7.0 with this hints >&2 + echo file. You\'ll have to do a separate port for the statically >&2 + echo linked COFF environment. >&2 + echo '' >&2 echo '';; esac @@ -91,7 +92,7 @@ i_ndbm='undef' d_mymalloc='undef' usemymalloc='n' -cat <<'EOM' +cat <<'EOM' >&4 WARNING: If you are using ksh to run the Configure script, you may find it failing in mysterious ways (such as failing to find library routines which diff --git a/hints/dcosx.sh b/hints/dcosx.sh index 36afd3b921..c1b0d0ac42 100644 --- a/hints/dcosx.sh +++ b/hints/dcosx.sh @@ -21,7 +21,7 @@ libswanted="$*" # Here's another draft of the perl5/solaris/gcc sanity-checker. case $PATH in -*/usr/ucb*:/usr/bin:*|*/usr/ucb*:/usr/bin) cat <<END +*/usr/ucb*:/usr/bin:*|*/usr/ucb*:/usr/bin) cat <<END >&2 NOTE: /usr/ucb/cc does not function properly. Remove /usr/ucb from your PATH. @@ -37,7 +37,7 @@ esac case $? in 0) ;; *) - cat <<END + cat <<END >&4 NOTE: Your system does not have /dev/fd mounted. If you want to be able to use set-uid scripts you must ask your system administrator @@ -53,7 +53,7 @@ esac /usr/bin/ls /usr/lib/libucb* >/dev/null 2>&1 case $? in 0) - cat <<END + cat <<END >&4 NOTE: libucb has been found in /usr/lib. libucb should reside in /usr/ucblib. You may have trouble while building Perl extensions. @@ -70,7 +70,7 @@ if grep GNU make.vers > /dev/null 2>&1; then tmp=`/usr/bin/ksh -c "whence make"` case "`/usr/bin/ls -l $tmp`" in ??????s*) - cat <<END + cat <<END >&2 NOTE: Your PATH points to GNU make, and your GNU make has the set-group-id bit set. You must either rearrange your PATH to put /usr/ccs/bin before the @@ -112,7 +112,7 @@ case "`${cc:-cc} -v 2>&1`" in case $verbose in */usr/ccs/bin/as*) ;; *) - cat <<END + cat <<END >&2 NOTE: You are using GNU as(1). GNU as(1) will not build Perl. You must arrange to use /usr/ccs/bin/as, perhaps by setting @@ -126,7 +126,7 @@ END case $verbose in */usr/ccs/bin/ld*) ;; *) - cat <<END + cat <<END >&2 NOTE: You are using GNU ld(1). GNU ld(1) will not build Perl. You must arrange to use /usr/ccs/bin/ld, perhaps by setting @@ -147,7 +147,7 @@ END # See if as(1) is GNU as(1). GNU as(1) won't work for this job. case `as --version < /dev/null 2>&1` in *GNU*) - cat <<END + cat <<END >&2 NOTE: You are using GNU as(1). GNU as(1) will not build Perl. You must arrange to use /usr/ccs/bin, perhaps by adding it to the @@ -160,7 +160,7 @@ END # See if ld(1) is GNU ld(1). GNU ld(1) won't work for this job. case `ld --version < /dev/null 2>&1` in *GNU*) - cat <<END + cat <<END >&2 NOTE: You are using GNU ld(1). GNU ld(1) will not build Perl. You must arrange to use /usr/ccs/bin, perhaps by adding it to the diff --git a/hints/dgux.sh b/hints/dgux.sh index 0b9dd11766..d751e63a64 100644 --- a/hints/dgux.sh +++ b/hints/dgux.sh @@ -104,7 +104,7 @@ do do [ -d "$sde_path/$sde" ] && break 2 done - cat <<END + cat <<END >&2 NOTE: I can't figure out what SDE is used by default on this machine (I didn't find a likely directory under $sde_path). This is bad news. If diff --git a/hints/esix4.sh b/hints/esix4.sh index c8dec8a8b8..3d3145d255 100644 --- a/hints/esix4.sh +++ b/hints/esix4.sh @@ -19,7 +19,7 @@ if test "$osvers" = "3.0"; then d_gconvert='undef' grep 'define[ ]*AF_OSI[ ]' /usr/include/sys/socket.h | grep '/\*[^*]*$' >/tmp/esix$$ if test -s /tmp/esix$$; then - cat <<EOM + cat <<EOM >&2 WARNING: You are likely to have problems compiling the Socket extension unless you fix the unterminated comment for AF_OSI in the file @@ -30,7 +30,7 @@ EOM rm -f /tmp/esix$$ fi -cat <<'EOM' +cat <<'EOM' >&4 If you wish to use dynamic linking, you must use LD_LIBRARY_PATH=`pwd`; export LD_LIBRARY_PATH diff --git a/hints/freebsd.sh b/hints/freebsd.sh index 4d2ba22b10..4b7653a784 100644 --- a/hints/freebsd.sh +++ b/hints/freebsd.sh @@ -97,7 +97,7 @@ esac # Configure should test for this. Volunteers? pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"' -cat <<'EOM' +cat <<'EOM' >&4 Some users have reported that Configure halts when testing for the O_NONBLOCK symbol with a syntax error. This is apparently a diff --git a/hints/hpux.sh b/hints/hpux.sh index 695ae6e08f..2e8b16cd21 100644 --- a/hints/hpux.sh +++ b/hints/hpux.sh @@ -1,3 +1,4 @@ +#! /local/gnu/bin/bash # hints/hpux.sh # Perl Configure hints file for Hewlett Packard HP-UX 9.x and 10.x # This file is based on @@ -8,14 +9,19 @@ # hints/hpux_10.sh, Perl Configure hints file for Hewlett Packard HP-UX 10.x # From: Giles Lean <giles@nemeton.com.au> -# This version: December 27, 1996 +# This version: March 21, 1997 # Current maintainer: Jeff Okamoto <okamoto@corp.hp.com> +#-------------------------------------------------------------------- # Use Configure -Dcc=gcc to use gcc. # Use Configure -Dprefix=/usr/local to install in /usr/local. - +# # Some users have reported problems with dynamic loading if the # environment variable LDOPTS='-a archive' . +# +# If you get a message about "too much defining", you might have to +# add the following to your ccflags: '-Wp,-H256000' +#-------------------------------------------------------------------- # Turn on the _HPUX_SOURCE flag to get many of the HP add-ons ccflags="$ccflags -D_HPUX_SOURCE" @@ -32,7 +38,7 @@ case "$cc" in then case "$usedl" in '') usedl="$undef" - cat <<'EOM' + cat <<'EOM' >&4 The bundled C compiler can not produce shared libraries, so you will not be able to use dynamic loading. @@ -66,7 +72,7 @@ then then archname='PA-RISC2' else - echo "This 10.0 system is of a PA-RISC type I don't recognize." + echo "This 10.0 system is of a PA-RISC type I don't recognize." >&2 echo "Debugging output: $xxcontext" archname='' fi @@ -83,7 +89,7 @@ else then archname='HP-MC68K' else - echo "I cannot recognize what chip set this system is using." + echo "I cannot recognize what chip set this system is using." >&2 echo "Debugging output: $xxcontext" archname='' fi diff --git a/hints/irix_4.sh b/hints/irix_4.sh index a5d08e05b6..f5883f38cb 100644 --- a/hints/irix_4.sh +++ b/hints/irix_4.sh @@ -17,7 +17,7 @@ esac # I don't know if they affect versions of perl other than 5.000 or # versions of IRIX other than 4.0.4. # -cat <<'EOM' +cat <<'EOM' >&4 If you have problems, you might have try including -DSTANDARD_C -cckr in ccflags. diff --git a/hints/mips.sh b/hints/mips.sh index 7ed058e4ad..bc0b7e8073 100644 --- a/hints/mips.sh +++ b/hints/mips.sh @@ -6,7 +6,7 @@ glibpth="/usr/lib/cmplrs/cc $glibpth" groupstype=int nm_opt='-B' case $PATH in -*bsd*:/bin:*) cat <<END +*bsd*:/bin:*) cat <<END >&4 NOTE: Some people have reported having much better luck with Mips CC than with the BSD cc. Put /bin first in your PATH if you have difficulties. END diff --git a/hints/next_3_0.sh b/hints/next_3_0.sh index 080829bd27..b8cc2c2d90 100644 --- a/hints/next_3_0.sh +++ b/hints/next_3_0.sh @@ -6,15 +6,15 @@ # <klwhite@magnus.acs.ohio-state.edu>, based on suggestions by Andreas # Koenig and Andy Dougherty. -echo With NS 3.0 you won\'t be able to use the POSIX module. -echo Be aware that some of the tests that are run during "make test" -echo will fail due to the lack of POSIX support on this system. -echo -echo Also, if you have the GDBM installed, make sure the header file -echo is located at a place on the system where the C compiler will -echo find it. By default, it is placed in /usr/local/include/gdbm.h. -echo It will not be found there. Try moving it to -echo /NextDeveloper/Headers/bsd/gdbm.h. +echo With NS 3.0 you won\'t be able to use the POSIX module. >&4 +echo Be aware that some of the tests that are run during \"make test\" >&4 +echo will fail due to the lack of POSIX support on this system. >&4 +echo >&4 +echo Also, if you have the GDBM installed, make sure the header file >&4 +echo is located at a place on the system where the C compiler will >&4 +echo find it. By default, it is placed in /usr/local/include/gdbm.h. >&4 +echo It will not be found there. Try moving it to >&4 +echo /NextDeveloper/Headers/bsd/gdbm.h. >&4 ccflags='-DUSE_NEXT_CTYPE -DNEXT30_NO_ATTRIBUTE' POSIX_cflags='ccflags="-posix $ccflags"' diff --git a/hints/os2.sh b/hints/os2.sh index 70e478b96f..c442a08086 100644 --- a/hints/os2.sh +++ b/hints/os2.sh @@ -30,7 +30,7 @@ cc='gcc' usrinc='/emx/include' libemx="`../UU/loc . X c:/emx/lib d:/emx/lib e:/emx/lib f:/emx/lib g:/emx/lib h:/emx/lib /emx/lib`" -if test "$libemx" = "X"; then echo "Cannot find C library!"; fi +if test "$libemx" = "X"; then echo "Cannot find C library!" >&2; fi # Acute backslashitis: libpth="`echo \"$LIBRARY_PATH\" | tr ';\\\' ' /'`" diff --git a/hints/qnx.sh b/hints/qnx.sh index e0ce55c249..9334c94339 100644 --- a/hints/qnx.sh +++ b/hints/qnx.sh @@ -120,7 +120,7 @@ selecttype='fd_set *' libswanted="$libswanted unix" if [ -z "`which ar 2>/dev/null`" ]; then - cat <<-'EOF' + cat <<-'EOF' >&4 I don't see an 'ar', so I'm guessing you are running Watcom 9.5 or earlier. You may want to install the ar cover found in the qnx subdirectory of this distribution. @@ -158,7 +158,7 @@ fi cppstdin=`which cpp 2>/dev/null` if [ -n "$cppstdin" ]; then - cat <<-EOF + cat <<-EOF >&4 I found a cpp at $cppstdin and will assume it is a good thing to use. If this proves to be false, there is a thin cover for cpp in the qnx subdirectory of this @@ -166,7 +166,7 @@ if [ -n "$cppstdin" ]; then EOF cpprun="$cppstdin" else - cat <<-EOF + cat <<-EOF >&4 There is a cpp cover in the qnx subdirectory of this distribution which works a little better than the diff --git a/hints/sco_2_3_3.sh b/hints/sco_2_3_3.sh index 10baafd6a3..6d398fccf2 100644 --- a/hints/sco_2_3_3.sh +++ b/hints/sco_2_3_3.sh @@ -1,3 +1,3 @@ yacc='/usr/bin/yacc -Sm25000' -echo "NOTE: you may have problems due to a spurious semicolon on the strerror()" -echo "macro definition in /usr/include/string.h. If so, delete the semicolon." +echo "NOTE: you may have problems due to a spurious semicolon on the strerror()" >&4 +echo "macro definition in /usr/include/string.h. If so, delete the semicolon." >&4 diff --git a/hints/sco_2_3_4.sh b/hints/sco_2_3_4.sh index 84f58172b3..34bcadae5f 100644 --- a/hints/sco_2_3_4.sh +++ b/hints/sco_2_3_4.sh @@ -1,5 +1,5 @@ yacc='/usr/bin/yacc -Sm25000' ccflags="$ccflags -UM_I86" usemymalloc='y' -echo "NOTE: you may have problems due to a spurious semicolon on the strerror()" -echo "macro definition in /usr/include/string.h. If so, delete the semicolon." +echo "NOTE: you may have problems due to a spurious semicolon on the strerror()" >&4 +echo "macro definition in /usr/include/string.h. If so, delete the semicolon." >&4 diff --git a/hints/solaris_2.sh b/hints/solaris_2.sh index 255811f2a6..89dde018de 100644 --- a/hints/solaris_2.sh +++ b/hints/solaris_2.sh @@ -47,7 +47,7 @@ esac # Here's another draft of the perl5/solaris/gcc sanity-checker. case $PATH in -*/usr/ucb*:/usr/bin:*|*/usr/ucb*:/usr/bin) cat <<END +*/usr/ucb*:/usr/bin:*|*/usr/ucb*:/usr/bin) cat <<END >&4 NOTE: Some people have reported problems with /usr/ucb/cc. Remove /usr/ucb from your PATH if you have difficulties. @@ -63,7 +63,7 @@ esac case $? in 0) ;; *) - cat <<END + cat <<END >&4 NOTE: Your system does not have /dev/fd mounted. If you want to be able to use set-uid scripts you must ask your system administrator @@ -79,7 +79,7 @@ esac /usr/bin/ls /usr/lib/libucb* >/dev/null 2>&1 case $? in 0) - cat <<END + cat <<END >&4 NOTE: libucb has been found in /usr/lib. libucb should reside in /usr/ucblib. You may have trouble while building Perl extensions. @@ -96,7 +96,7 @@ if grep GNU make.vers > /dev/null 2>&1; then tmp=`/usr/bin/which make` case "`/usr/bin/ls -l $tmp`" in ??????s*) - cat <<END + cat <<END >&2 NOTE: Your PATH points to GNU make, and your GNU make has the set-group-id bit set. You must either rearrange your PATH to put /usr/ccs/bin before the @@ -137,7 +137,7 @@ case "`${cc:-cc} -v 2>&1`" in case $verbose in */usr/ccs/bin/as*) ;; *) - cat <<END + cat <<END >&2 NOTE: You are using GNU as(1). GNU as(1) will not build Perl. You must arrange to use /usr/ccs/bin/as, perhaps by setting @@ -152,7 +152,7 @@ END case $verbose in */usr/ccs/bin/ld*) ;; *) - cat <<END + cat <<END >&2 NOTE: You are using GNU ld(1). GNU ld(1) will not build Perl. You must arrange to use /usr/ccs/bin/ld, perhaps by setting @@ -172,7 +172,7 @@ END # See if as(1) is GNU as(1). GNU as(1) won't work for this job. case `as --version < /dev/null 2>&1` in *GNU*) - cat <<END + cat <<END >&2 NOTE: You are using GNU as(1). GNU as(1) will not build Perl. You must arrange to use /usr/ccs/bin, perhaps by adding it to the @@ -201,7 +201,7 @@ END esac fi if $gnu_ld ; then - cat <<END + cat <<END >&2 NOTE: You are using GNU ld(1). GNU ld(1) will not build Perl. You must arrange to use /usr/ccs/bin, perhaps by adding it to the diff --git a/hints/ultrix_4.sh b/hints/ultrix_4.sh index d3c4a39880..d8d2063b22 100644 --- a/hints/ultrix_4.sh +++ b/hints/ultrix_4.sh @@ -22,7 +22,7 @@ esac # Then run "sh5 Configure.sh5 [your options]" case "$myuname" in -*risc*) cat <<EOF +*risc*) cat <<EOF >&4 Note that there is a bug in some versions of NFS on the DECStation that may cause utime() to work incorrectly. If so, regression test io/fs may fail if run under NFS. Ignore the failure. diff --git a/hints/utekv.sh b/hints/utekv.sh index ebc7809c60..95a31fdedf 100644 --- a/hints/utekv.sh +++ b/hints/utekv.sh @@ -6,7 +6,7 @@ ccflags="$ccflags -X18" usemymalloc='y' -echo " " -echo "NOTE: You may have to take out makefile dependencies on the files in" -echo "/usr/include (i.e. /usr/include/ctype.h) or the make will fail. A" -echo "simple 'grep -v /usr/include/ makefile' should suffice." +echo " " >&4 +echo "NOTE: You may have to take out makefile dependencies on the files in" >&4 +echo "/usr/include (i.e. /usr/include/ctype.h) or the make will fail. A" >&4 +echo "simple 'grep -v /usr/include/ makefile' should suffice." >&4 @@ -426,7 +426,7 @@ I32 flags; if (entry == xhv->xhv_eiter) HvLAZYDEL_on(hv); else - he_free(hv, entry); + hv_free_ent(hv, entry); --xhv->xhv_keys; return sv; } @@ -488,7 +488,7 @@ U32 hash; if (entry == xhv->xhv_eiter) HvLAZYDEL_on(hv); else - he_free(hv, entry); + hv_free_ent(hv, entry); --xhv->xhv_keys; return sv; } @@ -749,45 +749,45 @@ newHV() } void -he_free(hv, hent) +hv_free_ent(hv, entry) HV *hv; -register HE *hent; +register HE *entry; { - if (!hent) + if (!entry) return; - if (isGV(HeVAL(hent)) && GvCVu(HeVAL(hent)) && HvNAME(hv)) + if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv)) sub_generation++; /* may be deletion of method from stash */ - SvREFCNT_dec(HeVAL(hent)); - if (HeKLEN(hent) == HEf_SVKEY) { - SvREFCNT_dec(HeKEY_sv(hent)); - Safefree(HeKEY_hek(hent)); + SvREFCNT_dec(HeVAL(entry)); + if (HeKLEN(entry) == HEf_SVKEY) { + SvREFCNT_dec(HeKEY_sv(entry)); + Safefree(HeKEY_hek(entry)); } else if (HvSHAREKEYS(hv)) - unshare_hek(HeKEY_hek(hent)); + unshare_hek(HeKEY_hek(entry)); else - Safefree(HeKEY_hek(hent)); - del_he(hent); + Safefree(HeKEY_hek(entry)); + del_he(entry); } void -he_delayfree(hv, hent) +hv_delayfree_ent(hv, entry) HV *hv; -register HE *hent; +register HE *entry; { - if (!hent) + if (!entry) return; - if (isGV(HeVAL(hent)) && GvCVu(HeVAL(hent)) && HvNAME(hv)) + if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv)) sub_generation++; /* may be deletion of method from stash */ - sv_2mortal(HeVAL(hent)); /* free between statements */ - if (HeKLEN(hent) == HEf_SVKEY) { - sv_2mortal(HeKEY_sv(hent)); - Safefree(HeKEY_hek(hent)); + sv_2mortal(HeVAL(entry)); /* free between statements */ + if (HeKLEN(entry) == HEf_SVKEY) { + sv_2mortal(HeKEY_sv(entry)); + Safefree(HeKEY_hek(entry)); } else if (HvSHAREKEYS(hv)) - unshare_hek(HeKEY_hek(hent)); + unshare_hek(HeKEY_hek(entry)); else - Safefree(HeKEY_hek(hent)); - del_he(hent); + Safefree(HeKEY_hek(entry)); + del_he(entry); } void @@ -813,8 +813,8 @@ hfreeentries(hv) HV *hv; { register HE **array; - register HE *hent; - register HE *ohent = Null(HE*); + register HE *entry; + register HE *oentry = Null(HE*); I32 riter; I32 max; @@ -826,17 +826,17 @@ HV *hv; riter = 0; max = HvMAX(hv); array = HvARRAY(hv); - hent = array[0]; + entry = array[0]; for (;;) { - if (hent) { - ohent = hent; - hent = HeNEXT(hent); - he_free(hv, ohent); + if (entry) { + oentry = entry; + entry = HeNEXT(entry); + hv_free_ent(hv, oentry); } - if (!hent) { + if (!entry) { if (++riter > max) break; - hent = array[riter]; + entry = array[riter]; } } (void)hv_iterinit(hv); @@ -882,7 +882,7 @@ HV *hv; #endif if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */ HvLAZYDEL_off(hv); - he_free(hv, entry); + hv_free_ent(hv, entry); } xhv->xhv_riter = -1; xhv->xhv_eiter = Null(HE*); @@ -949,7 +949,7 @@ HV *hv; if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */ HvLAZYDEL_off(hv); - he_free(hv, oldentry); + hv_free_ent(hv, oldentry); } xhv->xhv_eiter = entry; diff --git a/installman b/installman index 600a68180e..c97febac2a 100755 --- a/installman +++ b/installman @@ -186,7 +186,7 @@ next unless -e $name; chmod 0777, $name if $^O eq 'os2'; print STDERR " unlink $name\n"; ( CORE::unlink($name) and ++$cnt - or warn "Couldn't unlink $name: $!\n" ) unless $nonono; + or warn "Couldn't unlink $name: $!\n" ) unless $notify; } return $cnt; } diff --git a/installperl b/installperl index 1267f49efc..764a6f917b 100755 --- a/installperl +++ b/installperl @@ -1,15 +1,21 @@ #!./perl -BEGIN { @INC=('./lib', '../lib') } + +BEGIN { + require 5.003_90; + @INC = 'lib'; + $ENV{PERL5LIB} = 'lib'; +} + use File::Find; use File::Compare; +use File::Copy (); use File::Path (); use Config; use subs qw(unlink rename link chmod); # override the ones in the rest of the script -sub mkpath -{ - File::Path::mkpath(@_) unless $nonono; +sub mkpath { + File::Path::mkpath(@_) unless $nonono; } $mainperldir = "/usr/bin"; @@ -80,14 +86,14 @@ if ($d_dosuid && $>) { die "You must run as root to install suidperl\n"; } # First we install the version-numbered executables. -&safe_unlink("$installbin/perl$ver$exe_ext"); -&cmd("cp perl$exe_ext $installbin/perl$ver$exe_ext"); -&chmod(0755, "$installbin/perl$ver$exe_ext"); +safe_unlink("$installbin/perl$ver$exe_ext"); +copy("perl$exe_ext", "$installbin/perl$ver$exe_ext"); +chmod(0755, "$installbin/perl$ver$exe_ext"); -&safe_unlink("$installbin/sperl$ver$exe_ext"); +safe_unlink("$installbin/sperl$ver$exe_ext"); if ($d_dosuid) { - &cmd("cp suidperl$exe_ext $installbin/sperl$ver$exe_ext"); - &chmod(04711, "$installbin/sperl$ver$exe_ext"); + copy("suidperl$exe_ext", "$installbin/sperl$ver$exe_ext"); + chmod(04711, "$installbin/sperl$ver$exe_ext"); } # Install library files. @@ -100,8 +106,8 @@ mkpath($installsitelib, 1, 0777) if ($installsitelib); mkpath($installsitearch, 1, 0777) if ($installsitearch); if (chdir "lib") { - $do_installarchlib = ! &samepath($installarchlib, '.'); - $do_installprivlib = ! &samepath($installprivlib, '.'); + $do_installarchlib = ! samepath($installarchlib, '.'); + $do_installprivlib = ! samepath($installprivlib, '.'); $do_installprivlib = 0 if $versiononly && !($installprivlib =~ m/\Q$]/); if ($do_installarchlib || $do_installprivlib) { @@ -123,8 +129,8 @@ push(@corefiles,'sperl.o') if -f 'sperl.o'; foreach $file (@corefiles) { # HP-UX (at least) needs to maintain execute permissions # on dynamically-loaded libraries. - cp_if_diff($file,"$installarchlib/CORE/$file") - and &chmod($file =~ /^\.(so|$dlext)$/ ? 0555 : 0444, + copy_if_diff($file,"$installarchlib/CORE/$file") + and chmod($file =~ /^\.(so|$dlext)$/ ? 0555 : 0444, "$installarchlib/CORE/$file"); } @@ -133,7 +139,7 @@ foreach $file (@corefiles) { $mainperl_is_instperl = 0; if (!$versiononly && !$nonono && -t STDIN && -t STDERR - && -w $mainperldir && ! &samepath($mainperldir, $installbin)) { + && -w $mainperldir && ! samepath($mainperldir, $installbin)) { local($usrbinperl) = "$mainperldir/perl$exe_ext"; local($instperl) = "$installbin/perl$exe_ext"; local($expinstperl) = "$binexp/perl$exe_ext"; @@ -144,48 +150,48 @@ if (!$versiononly && !$nonono && -t STDIN && -t STDERR # Try to be clever about mainperl being a symbolic link # to binexp/perl if binexp and installbin are different. $mainperl_is_instperl = - &samepath($usrbinperl, $instperl) || - &samepath($usrbinperl, $expinstperl) || + samepath($usrbinperl, $instperl) || + samepath($usrbinperl, $expinstperl) || (($binexp ne $installbin) && (-l $usrbinperl) && ((readlink $usrbinperl) eq $expinstperl)); } if ((! $mainperl_is_instperl) && - (&yn("Many scripts expect perl to be installed as $usrbinperl.\n" . + (yn("Many scripts expect perl to be installed as $usrbinperl.\n" . "Do you wish to have $usrbinperl be the same as\n" . "$expinstperl? [y] "))) { unlink($usrbinperl); eval { CORE::link $instperl, $usrbinperl } || eval { symlink $expinstperl, $usrbinperl } || - cmd("cp $instperl $usrbinperl"); + copy($instperl, $usrbinperl); $mainperl_is_instperl = 1; } } # Make links to ordinary names if installbin directory isn't current directory. -if (! $versiononly && ! &samepath($installbin, '.')) { - &safe_unlink("$installbin/perl$exe_ext", "$installbin/suidperl$exe_ext"); - &link("$installbin/perl$ver$exe_ext", "$installbin/perl$exe_ext"); - &link("$installbin/sperl$ver$exe_ext", "$installbin/suidperl$exe_ext") +if (! $versiononly && ! samepath($installbin, '.')) { + safe_unlink("$installbin/perl$exe_ext", "$installbin/suidperl$exe_ext"); + link("$installbin/perl$ver$exe_ext", "$installbin/perl$exe_ext"); + link("$installbin/sperl$ver$exe_ext", "$installbin/suidperl$exe_ext") if $d_dosuid; } -if (!$versiononly && ! &samepath($installbin, 'x2p')) { - &safe_unlink("$installbin/a2p$exe_ext"); - &cmd("cp x2p/a2p$exe_ext $installbin/a2p$exe_ext"); - &chmod(0755, "$installbin/a2p$exe_ext"); +if (!$versiononly && ! samepath($installbin, 'x2p')) { + safe_unlink("$installbin/a2p$exe_ext"); + copy("x2p/a2p$exe_ext", "$installbin/a2p$exe_ext"); + chmod(0755, "$installbin/a2p$exe_ext"); } # cppstdin is just a script, but it is architecture-dependent, so # it can't safely be shared. Place it in $installbin. # Note that Configure doesn't build cppstin if it isn't needed, so # we skip this if cppstdin doesn't exist. -if (! $versiononly && (-f cppstdin) && (! &samepath($installbin, '.'))) { - &safe_unlink("$installbin/cppstdin"); - &cmd("cp cppstdin $installbin/cppstdin"); - &chmod(0755, "$installbin/cppstdin"); +if (! $versiononly && (-f 'cppstdin') && (! samepath($installbin, '.'))) { + safe_unlink("$installbin/cppstdin"); + copy("cppstdin", "$installbin/cppstdin"); + chmod(0755, "$installbin/cppstdin"); } # Install scripts. @@ -194,25 +200,26 @@ mkpath($installscript, 1, 0777); if (! $versiononly) { for (@scripts) { - &cmd("cp $_ $installscript"); - s#.*/##; &chmod(0755, "$installscript/$_"); + (my $base = $_) =~ s#.*/##; + copy($_, "$installscript/$base"); + chmod(0755, "$installscript/$base"); } } # pstruct should be a link to c2ph if (! $versiononly) { - &safe_unlink("$installscript/pstruct"); - &link("$installscript/c2ph","$installscript/pstruct"); + safe_unlink("$installscript/pstruct"); + link("$installscript/c2ph","$installscript/pstruct"); } # Install pod pages. Where? I guess in $installprivlib/pod. -if (! $versiononly && !($installprivlib =~ m/\Q$]/)) { +if (! $versiononly || !($installprivlib =~ m/\Q$]/)) { mkpath("${installprivlib}/pod", 1, 0777); foreach $file (@pods) { # $file is a name like pod/perl.pod - cp_if_diff($file, "${installprivlib}/${file}"); + copy_if_diff($file, "${installprivlib}/${file}"); } } @@ -232,8 +239,8 @@ if (!$versiononly) { next unless m,^/,; # Use &samepath here because some systems have other dirs linked # to $mainperldir (like SunOS) - next if &samepath($_, $binexp); - next if ($mainperl_is_instperl && &samepath($_, $mainperldir)); + next if samepath($_, $binexp); + next if ($mainperl_is_instperl && samepath($_, $mainperldir)); push(@otherperls, "$_/perl$exe_ext") if (-x "$_/perl$exe_ext" && ! -d "$_/perl$exe_ext"); } @@ -279,32 +286,23 @@ sub unlink { } sub safe_unlink { - local(@names) = @_; - + return if $nonono; + local @names = @_; foreach $name (@names) { next unless -e $name; - next if $nonono; chmod 0777, $name if $^O eq 'os2'; print STDERR " unlink $name\n"; next if CORE::unlink($name); warn "Couldn't unlink $name: $!\n"; if ($! =~ /busy/i) { print STDERR " mv $name $name.old\n"; - &rename($name, "$name.old") || warn "Couldn't rename $name: $!\n"; + safe_rename($name, "$name.old") + or warn "Couldn't rename $name: $!\n"; } } } -sub cmd { - local($cmd) = @_; - print STDERR " $cmd\n"; - unless ($nonono) { - system $cmd; - warn "Command failed!!!\n" if $?; - } -} - -sub rename { +sub safe_rename { local($from,$to) = @_; if (-f $to and not unlink($to)) { my($i); @@ -324,11 +322,16 @@ sub link { print STDERR " ln $from $to\n"; eval { - CORE::link($from,$to) ? $success++ : warn "Couldn't link $from to $to: $!\n" unless $nonono; + CORE::link($from, $to) + ? $success++ + : warn "Couldn't link $from to $to: $!\n" + unless $nonono; }; if ($@) { - system( $cp, $from, $to )==0 ? $success++ : - warn "Couldn't copy $from to $to: $!\n" unless $nonono; + File::Copy::copy($from, $to) + ? $success++ + : warn "Couldn't copy $from to $to: $!\n" + unless $nonono; } $success; } @@ -337,8 +340,18 @@ sub chmod { local($mode,$name) = @_; printf STDERR " chmod %o %s\n", $mode, $name; - CORE::chmod($mode,$name) || warn sprintf("Couldn't chmod %o %s: $!\n",$mode,$name) - unless $nonono; + CORE::chmod($mode,$name) + || warn sprintf("Couldn't chmod %o %s: $!\n", $mode, $name) + unless $nonono; +} + +sub copy { + my($from,$to) = @_; + + print STDERR " cp $from $to\n"; + File::Copy::copy($from, $to) + || warn "Couldn't copy $from to $to: $!\n" + unless $nonono; } sub samepath { @@ -383,15 +396,15 @@ sub installlib { #but we have to delete old *.al and *.ix files from the 5.000 #distribution: #This might not work because $archname might have changed. - &unlink("$installarchlib/$name"); + unlink("$installarchlib/$name"); } if (compare($_, "$installlib/$name") || $nonono) { - &unlink("$installlib/$name"); + unlink("$installlib/$name"); mkpath("$installlib/$dir", 1, 0777); # HP-UX (at least) needs to maintain execute permissions # on dynamically-loaded libraries. - cp_if_diff($_, "$installlib/$name") - and &chmod($name =~ /\.(so|$dlext)$/o ? 0555 : 0444, + copy_if_diff($_, "$installlib/$name") + and chmod($name =~ /\.(so|$dlext)$/o ? 0555 : 0444, "$installlib/$name"); } } elsif (-d $_) { @@ -408,19 +421,19 @@ sub installlib { # get an error message to the effect that the symbol table is older # than the library. # Return true if copying occurred. -sub cp_if_diff { + +sub copy_if_diff { my($from,$to)=@_; -f $from || die "$0: $from not found"; if (compare($from, $to) || $nonono) { - my ($atime, $mtime); - unlink($to); # In case we don't have write permissions. + safe_unlink($to); # In case we don't have write permissions. if ($nonono) { $from = $depth . "/" . $from if $depth; } - cmd("cp $from $to"); - # Restore timestamps if it's a .a library. - if ($to =~ /\.a$/ or $^O eq 'os2') { # For binary install - ($atime, $mtime) = (stat $from)[8,9]; + copy($from, $to); + # Restore timestamps if it's a .a library or for OS/2. + if (!$nonono && ($^O eq 'os2' || $to =~ /\.a$/)) { + my ($atime, $mtime) = (stat $from)[8,9]; utime $atime, $mtime, $to; } 1; diff --git a/keywords.h b/keywords.h index 8cb2748d75..cd08665563 100644 --- a/keywords.h +++ b/keywords.h @@ -1,245 +1,246 @@ #define KEY_NULL 0 -#define KEY___LINE__ 1 -#define KEY___FILE__ 2 -#define KEY___DATA__ 3 -#define KEY___END__ 4 -#define KEY_AUTOLOAD 5 -#define KEY_BEGIN 6 -#define KEY_CORE 7 -#define KEY_DESTROY 8 -#define KEY_END 9 -#define KEY_EQ 10 -#define KEY_GE 11 -#define KEY_GT 12 -#define KEY_LE 13 -#define KEY_LT 14 -#define KEY_NE 15 -#define KEY_abs 16 -#define KEY_accept 17 -#define KEY_alarm 18 -#define KEY_and 19 -#define KEY_atan2 20 -#define KEY_bind 21 -#define KEY_binmode 22 -#define KEY_bless 23 -#define KEY_caller 24 -#define KEY_chdir 25 -#define KEY_chmod 26 -#define KEY_chomp 27 -#define KEY_chop 28 -#define KEY_chown 29 -#define KEY_chr 30 -#define KEY_chroot 31 -#define KEY_close 32 -#define KEY_closedir 33 -#define KEY_cmp 34 -#define KEY_connect 35 -#define KEY_continue 36 -#define KEY_cos 37 -#define KEY_crypt 38 -#define KEY_dbmclose 39 -#define KEY_dbmopen 40 -#define KEY_defined 41 -#define KEY_delete 42 -#define KEY_die 43 -#define KEY_do 44 -#define KEY_dump 45 -#define KEY_each 46 -#define KEY_else 47 -#define KEY_elsif 48 -#define KEY_endgrent 49 -#define KEY_endhostent 50 -#define KEY_endnetent 51 -#define KEY_endprotoent 52 -#define KEY_endpwent 53 -#define KEY_endservent 54 -#define KEY_eof 55 -#define KEY_eq 56 -#define KEY_eval 57 -#define KEY_exec 58 -#define KEY_exists 59 -#define KEY_exit 60 -#define KEY_exp 61 -#define KEY_fcntl 62 -#define KEY_fileno 63 -#define KEY_flock 64 -#define KEY_for 65 -#define KEY_foreach 66 -#define KEY_fork 67 -#define KEY_format 68 -#define KEY_formline 69 -#define KEY_ge 70 -#define KEY_getc 71 -#define KEY_getgrent 72 -#define KEY_getgrgid 73 -#define KEY_getgrnam 74 -#define KEY_gethostbyaddr 75 -#define KEY_gethostbyname 76 -#define KEY_gethostent 77 -#define KEY_getlogin 78 -#define KEY_getnetbyaddr 79 -#define KEY_getnetbyname 80 -#define KEY_getnetent 81 -#define KEY_getpeername 82 -#define KEY_getpgrp 83 -#define KEY_getppid 84 -#define KEY_getpriority 85 -#define KEY_getprotobyname 86 -#define KEY_getprotobynumber 87 -#define KEY_getprotoent 88 -#define KEY_getpwent 89 -#define KEY_getpwnam 90 -#define KEY_getpwuid 91 -#define KEY_getservbyname 92 -#define KEY_getservbyport 93 -#define KEY_getservent 94 -#define KEY_getsockname 95 -#define KEY_getsockopt 96 -#define KEY_glob 97 -#define KEY_gmtime 98 -#define KEY_goto 99 -#define KEY_grep 100 -#define KEY_gt 101 -#define KEY_hex 102 -#define KEY_if 103 -#define KEY_index 104 -#define KEY_int 105 -#define KEY_ioctl 106 -#define KEY_join 107 -#define KEY_keys 108 -#define KEY_kill 109 -#define KEY_last 110 -#define KEY_lc 111 -#define KEY_lcfirst 112 -#define KEY_le 113 -#define KEY_length 114 -#define KEY_link 115 -#define KEY_listen 116 -#define KEY_local 117 -#define KEY_localtime 118 -#define KEY_log 119 -#define KEY_lstat 120 -#define KEY_lt 121 -#define KEY_m 122 -#define KEY_map 123 -#define KEY_mkdir 124 -#define KEY_msgctl 125 -#define KEY_msgget 126 -#define KEY_msgrcv 127 -#define KEY_msgsnd 128 -#define KEY_my 129 -#define KEY_ne 130 -#define KEY_next 131 -#define KEY_no 132 -#define KEY_not 133 -#define KEY_oct 134 -#define KEY_open 135 -#define KEY_opendir 136 -#define KEY_or 137 -#define KEY_ord 138 -#define KEY_pack 139 -#define KEY_package 140 -#define KEY_pipe 141 -#define KEY_pop 142 -#define KEY_pos 143 -#define KEY_print 144 -#define KEY_printf 145 -#define KEY_prototype 146 -#define KEY_push 147 -#define KEY_q 148 -#define KEY_qq 149 -#define KEY_quotemeta 150 -#define KEY_qw 151 -#define KEY_qx 152 -#define KEY_rand 153 -#define KEY_read 154 -#define KEY_readdir 155 -#define KEY_readline 156 -#define KEY_readlink 157 -#define KEY_readpipe 158 -#define KEY_recv 159 -#define KEY_redo 160 -#define KEY_ref 161 -#define KEY_rename 162 -#define KEY_require 163 -#define KEY_reset 164 -#define KEY_return 165 -#define KEY_reverse 166 -#define KEY_rewinddir 167 -#define KEY_rindex 168 -#define KEY_rmdir 169 -#define KEY_s 170 -#define KEY_scalar 171 -#define KEY_seek 172 -#define KEY_seekdir 173 -#define KEY_select 174 -#define KEY_semctl 175 -#define KEY_semget 176 -#define KEY_semop 177 -#define KEY_send 178 -#define KEY_setgrent 179 -#define KEY_sethostent 180 -#define KEY_setnetent 181 -#define KEY_setpgrp 182 -#define KEY_setpriority 183 -#define KEY_setprotoent 184 -#define KEY_setpwent 185 -#define KEY_setservent 186 -#define KEY_setsockopt 187 -#define KEY_shift 188 -#define KEY_shmctl 189 -#define KEY_shmget 190 -#define KEY_shmread 191 -#define KEY_shmwrite 192 -#define KEY_shutdown 193 -#define KEY_sin 194 -#define KEY_sleep 195 -#define KEY_socket 196 -#define KEY_socketpair 197 -#define KEY_sort 198 -#define KEY_splice 199 -#define KEY_split 200 -#define KEY_sprintf 201 -#define KEY_sqrt 202 -#define KEY_srand 203 -#define KEY_stat 204 -#define KEY_study 205 -#define KEY_sub 206 -#define KEY_substr 207 -#define KEY_symlink 208 -#define KEY_syscall 209 -#define KEY_sysopen 210 -#define KEY_sysread 211 -#define KEY_system 212 -#define KEY_syswrite 213 -#define KEY_tell 214 -#define KEY_telldir 215 -#define KEY_tie 216 -#define KEY_tied 217 -#define KEY_time 218 -#define KEY_times 219 -#define KEY_tr 220 -#define KEY_truncate 221 -#define KEY_uc 222 -#define KEY_ucfirst 223 -#define KEY_umask 224 -#define KEY_undef 225 -#define KEY_unless 226 -#define KEY_unlink 227 -#define KEY_unpack 228 -#define KEY_unshift 229 -#define KEY_untie 230 -#define KEY_until 231 -#define KEY_use 232 -#define KEY_utime 233 -#define KEY_values 234 -#define KEY_vec 235 -#define KEY_wait 236 -#define KEY_waitpid 237 -#define KEY_wantarray 238 -#define KEY_warn 239 -#define KEY_while 240 -#define KEY_write 241 -#define KEY_x 242 -#define KEY_xor 243 -#define KEY_y 244 +#define KEY___FILE__ 1 +#define KEY___LINE__ 2 +#define KEY___PACKAGE__ 3 +#define KEY___DATA__ 4 +#define KEY___END__ 5 +#define KEY_AUTOLOAD 6 +#define KEY_BEGIN 7 +#define KEY_CORE 8 +#define KEY_DESTROY 9 +#define KEY_END 10 +#define KEY_EQ 11 +#define KEY_GE 12 +#define KEY_GT 13 +#define KEY_LE 14 +#define KEY_LT 15 +#define KEY_NE 16 +#define KEY_abs 17 +#define KEY_accept 18 +#define KEY_alarm 19 +#define KEY_and 20 +#define KEY_atan2 21 +#define KEY_bind 22 +#define KEY_binmode 23 +#define KEY_bless 24 +#define KEY_caller 25 +#define KEY_chdir 26 +#define KEY_chmod 27 +#define KEY_chomp 28 +#define KEY_chop 29 +#define KEY_chown 30 +#define KEY_chr 31 +#define KEY_chroot 32 +#define KEY_close 33 +#define KEY_closedir 34 +#define KEY_cmp 35 +#define KEY_connect 36 +#define KEY_continue 37 +#define KEY_cos 38 +#define KEY_crypt 39 +#define KEY_dbmclose 40 +#define KEY_dbmopen 41 +#define KEY_defined 42 +#define KEY_delete 43 +#define KEY_die 44 +#define KEY_do 45 +#define KEY_dump 46 +#define KEY_each 47 +#define KEY_else 48 +#define KEY_elsif 49 +#define KEY_endgrent 50 +#define KEY_endhostent 51 +#define KEY_endnetent 52 +#define KEY_endprotoent 53 +#define KEY_endpwent 54 +#define KEY_endservent 55 +#define KEY_eof 56 +#define KEY_eq 57 +#define KEY_eval 58 +#define KEY_exec 59 +#define KEY_exists 60 +#define KEY_exit 61 +#define KEY_exp 62 +#define KEY_fcntl 63 +#define KEY_fileno 64 +#define KEY_flock 65 +#define KEY_for 66 +#define KEY_foreach 67 +#define KEY_fork 68 +#define KEY_format 69 +#define KEY_formline 70 +#define KEY_ge 71 +#define KEY_getc 72 +#define KEY_getgrent 73 +#define KEY_getgrgid 74 +#define KEY_getgrnam 75 +#define KEY_gethostbyaddr 76 +#define KEY_gethostbyname 77 +#define KEY_gethostent 78 +#define KEY_getlogin 79 +#define KEY_getnetbyaddr 80 +#define KEY_getnetbyname 81 +#define KEY_getnetent 82 +#define KEY_getpeername 83 +#define KEY_getpgrp 84 +#define KEY_getppid 85 +#define KEY_getpriority 86 +#define KEY_getprotobyname 87 +#define KEY_getprotobynumber 88 +#define KEY_getprotoent 89 +#define KEY_getpwent 90 +#define KEY_getpwnam 91 +#define KEY_getpwuid 92 +#define KEY_getservbyname 93 +#define KEY_getservbyport 94 +#define KEY_getservent 95 +#define KEY_getsockname 96 +#define KEY_getsockopt 97 +#define KEY_glob 98 +#define KEY_gmtime 99 +#define KEY_goto 100 +#define KEY_grep 101 +#define KEY_gt 102 +#define KEY_hex 103 +#define KEY_if 104 +#define KEY_index 105 +#define KEY_int 106 +#define KEY_ioctl 107 +#define KEY_join 108 +#define KEY_keys 109 +#define KEY_kill 110 +#define KEY_last 111 +#define KEY_lc 112 +#define KEY_lcfirst 113 +#define KEY_le 114 +#define KEY_length 115 +#define KEY_link 116 +#define KEY_listen 117 +#define KEY_local 118 +#define KEY_localtime 119 +#define KEY_log 120 +#define KEY_lstat 121 +#define KEY_lt 122 +#define KEY_m 123 +#define KEY_map 124 +#define KEY_mkdir 125 +#define KEY_msgctl 126 +#define KEY_msgget 127 +#define KEY_msgrcv 128 +#define KEY_msgsnd 129 +#define KEY_my 130 +#define KEY_ne 131 +#define KEY_next 132 +#define KEY_no 133 +#define KEY_not 134 +#define KEY_oct 135 +#define KEY_open 136 +#define KEY_opendir 137 +#define KEY_or 138 +#define KEY_ord 139 +#define KEY_pack 140 +#define KEY_package 141 +#define KEY_pipe 142 +#define KEY_pop 143 +#define KEY_pos 144 +#define KEY_print 145 +#define KEY_printf 146 +#define KEY_prototype 147 +#define KEY_push 148 +#define KEY_q 149 +#define KEY_qq 150 +#define KEY_quotemeta 151 +#define KEY_qw 152 +#define KEY_qx 153 +#define KEY_rand 154 +#define KEY_read 155 +#define KEY_readdir 156 +#define KEY_readline 157 +#define KEY_readlink 158 +#define KEY_readpipe 159 +#define KEY_recv 160 +#define KEY_redo 161 +#define KEY_ref 162 +#define KEY_rename 163 +#define KEY_require 164 +#define KEY_reset 165 +#define KEY_return 166 +#define KEY_reverse 167 +#define KEY_rewinddir 168 +#define KEY_rindex 169 +#define KEY_rmdir 170 +#define KEY_s 171 +#define KEY_scalar 172 +#define KEY_seek 173 +#define KEY_seekdir 174 +#define KEY_select 175 +#define KEY_semctl 176 +#define KEY_semget 177 +#define KEY_semop 178 +#define KEY_send 179 +#define KEY_setgrent 180 +#define KEY_sethostent 181 +#define KEY_setnetent 182 +#define KEY_setpgrp 183 +#define KEY_setpriority 184 +#define KEY_setprotoent 185 +#define KEY_setpwent 186 +#define KEY_setservent 187 +#define KEY_setsockopt 188 +#define KEY_shift 189 +#define KEY_shmctl 190 +#define KEY_shmget 191 +#define KEY_shmread 192 +#define KEY_shmwrite 193 +#define KEY_shutdown 194 +#define KEY_sin 195 +#define KEY_sleep 196 +#define KEY_socket 197 +#define KEY_socketpair 198 +#define KEY_sort 199 +#define KEY_splice 200 +#define KEY_split 201 +#define KEY_sprintf 202 +#define KEY_sqrt 203 +#define KEY_srand 204 +#define KEY_stat 205 +#define KEY_study 206 +#define KEY_sub 207 +#define KEY_substr 208 +#define KEY_symlink 209 +#define KEY_syscall 210 +#define KEY_sysopen 211 +#define KEY_sysread 212 +#define KEY_system 213 +#define KEY_syswrite 214 +#define KEY_tell 215 +#define KEY_telldir 216 +#define KEY_tie 217 +#define KEY_tied 218 +#define KEY_time 219 +#define KEY_times 220 +#define KEY_tr 221 +#define KEY_truncate 222 +#define KEY_uc 223 +#define KEY_ucfirst 224 +#define KEY_umask 225 +#define KEY_undef 226 +#define KEY_unless 227 +#define KEY_unlink 228 +#define KEY_unpack 229 +#define KEY_unshift 230 +#define KEY_untie 231 +#define KEY_until 232 +#define KEY_use 233 +#define KEY_utime 234 +#define KEY_values 235 +#define KEY_vec 236 +#define KEY_wait 237 +#define KEY_waitpid 238 +#define KEY_wantarray 239 +#define KEY_warn 240 +#define KEY_while 241 +#define KEY_write 242 +#define KEY_x 243 +#define KEY_xor 244 +#define KEY_y 245 diff --git a/keywords.pl b/keywords.pl index 595e875bc4..8920a3b5bc 100755 --- a/keywords.pl +++ b/keywords.pl @@ -25,8 +25,9 @@ sub tab { __END__ NULL -__LINE__ __FILE__ +__LINE__ +__PACKAGE__ __DATA__ __END__ AUTOLOAD diff --git a/lib/AutoSplit.pm b/lib/AutoSplit.pm index f7b8eee76d..ab634b2330 100644 --- a/lib/AutoSplit.pm +++ b/lib/AutoSplit.pm @@ -5,6 +5,7 @@ require Exporter; use Config; use Carp; +use File::Path qw(mkpath); @ISA = qw(Exporter); @EXPORT = qw(&autosplit &autosplit_lib_modules); @@ -154,12 +155,7 @@ sub autosplit_file{ $filename = VMS::Filespec::unixify($filename); # may have dirs } unless (-d $autodir){ - local($", @p)="/"; - foreach(split(/\//,$autodir)){ - push(@p, $_); - next if -d "@p/"; - mkdir("@p",0755) or die "AutoSplit unable to mkdir @p: $!"; - } + mkpath($autodir,0,0755); # We should never need to create the auto dir here. installperl # (or similar) should have done it. Expecting it to exist is a valuable # sanity check against autosplitting into some random directory by mistake. @@ -193,14 +189,20 @@ sub autosplit_file{ $package or die "Can't find 'package Name;' in $filename\n"; - my($modpname) = $package; $modpname =~ s#::#/#g; - my($al_idx_file) = "$autodir/$modpname/$IndexFile"; + my($modpname) = $package; + if ($^O eq 'MSWin32') { + $modpname =~ s#::#\\#g; + } else { + $modpname =~ s#::#/#g; + } - die "Package $package does not match filename $filename" - unless ($filename =~ m/$modpname.pm$/ or + die "Package $package ($modpname.pm) does not match filename $filename" + unless ($filename =~ m/\Q$modpname.pm\E$/ or ($^O eq "msdos") or $Is_VMS && $filename =~ m/$modpname.pm/i); + my($al_idx_file) = "$autodir/$modpname/$IndexFile"; + if ($check_mod_time){ my($al_ts_time) = (stat("$al_idx_file"))[9] || 1; if ($al_ts_time >= $pm_mod_time){ @@ -215,12 +217,7 @@ sub autosplit_file{ if $Verbose; unless (-d "$autodir/$modpname"){ - local($", @p)="/"; - foreach(split(/\//,"$autodir/$modpname")){ - push(@p, $_); - next if -d "@p/"; - mkdir("@p",0777) or die "AutoSplit unable to mkdir @p: $!"; - } + mkpath("$autodir/$modpname",0,0777); } # We must try to deal with some SVR3 systems with a limit of 14 diff --git a/lib/Carp.pm b/lib/Carp.pm index ec08d30c19..c0cfe08d44 100644 --- a/lib/Carp.pm +++ b/lib/Carp.pm @@ -68,9 +68,16 @@ sub longmess { } for (@a) { $_ = "undef", next unless defined $_; - s/'/\\'/g; - substr($_,$MaxArgLen) = '...' if $MaxArgLen and $MaxArgLen < length; - s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/; + if (ref $_) { + $_ .= ''; + s/'/\\'/g; + } + else { + s/'/\\'/g; + substr($_,$MaxArgLen) = '...' + if $MaxArgLen and $MaxArgLen < length; + } + $_ = "'$_'" unless /^-?[\d.]+$/; s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg; s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg; } @@ -81,7 +88,10 @@ sub longmess { } $error = "called"; } - $mess || $error; + # this kludge circumvents die's incorrect handling of NUL + my $msg = \($mess || $error); + $$msg =~ tr/\0//d; + $$msg; } sub shortmess { # Short-circuit &longmess if called via multiple packages @@ -113,7 +123,9 @@ sub shortmess { # Short-circuit &longmess if called via multiple packages if(defined @{$pack . "::ISA"}); } else { - return "$error at $file line $line\n"; + # this kludge circumvents die's incorrect handling of NUL + (my $msg = "$error at $file line $line\n") =~ tr/\0//d; + return $msg; } } continue { diff --git a/lib/Cwd.pm b/lib/Cwd.pm index e93cf1a0a9..f924a59647 100644 --- a/lib/Cwd.pm +++ b/lib/Cwd.pm @@ -230,6 +230,7 @@ sub chdir { sub _vms_cwd { return $ENV{'DEFAULT'} } + sub _os2_cwd { $ENV{'PWD'} = `cmd /c cd`; chop $ENV{'PWD'}; @@ -237,6 +238,8 @@ sub _os2_cwd { return $ENV{'PWD'}; } +*_NT_cwd = \&_os2_cwd unless defined &_NT_cwd; + sub _msdos_cwd { $ENV{'PWD'} = `command /c cd`; chop $ENV{'PWD'}; @@ -255,6 +258,7 @@ sub _msdos_cwd { } elsif ($^O eq 'NT' or $^O eq 'MSWin32') { # We assume that &_NT_cwd is defined as an XSUB or in the core. + *cwd = \&_NT_cwd; *getcwd = \&_NT_cwd; *fastcwd = \&_NT_cwd; *fastgetcwd = \&_NT_cwd; diff --git a/lib/Exporter.pm b/lib/Exporter.pm index abdb1e788b..7b03732790 100644 --- a/lib/Exporter.pm +++ b/lib/Exporter.pm @@ -2,21 +2,31 @@ package Exporter; require 5.001; +# +# We go to a lot of trouble not to 'require Carp' at file scope, +# because Carp requires Exporter, and something has to give. +# + $ExportLevel = 0; $Verbose = 0 unless $Verbose; -require Carp; - sub export { # First make import warnings look like they're coming from the "use". local $SIG{__WARN__} = sub { my $text = shift; - $text =~ s/ at \S*Exporter.pm line \d+.*\n//; - local $Carp::CarpLevel = 1; # ignore package calling us too. - Carp::carp($text); + if ($text =~ s/ at \S*Exporter.pm line \d+.*\n//) { + require Carp; + local $Carp::CarpLevel = 1; # ignore package calling us too. + Carp::carp($text); + } + else { + warn $text; + } }; local $SIG{__DIE__} = sub { + require Carp; + local $Carp::CarpLevel = 1; # ignore package calling us too. Carp::croak("$_[0]Illegal null symbol in \@${1}::EXPORT") if $_[0] =~ /^Unable to create sub named "(.*?)::"/; }; @@ -103,7 +113,10 @@ sub export { } } } - Carp::croak("Can't continue after import errors") if $oops; + if ($oops) { + require Carp; + Carp::croak("Can't continue after import errors"); + } } else { @imports = @exports; @@ -127,7 +140,10 @@ sub export { warn qq["$sym" is not implemented by the $pkg module ], "on this architecture"; } - Carp::croak("Can't continue after import errors") if @failed; + if (@failed) { + require Carp; + Carp::croak("Can't continue after import errors"); + } } } @@ -145,7 +161,7 @@ sub export { $type eq '@' ? \@{"${pkg}::$sym"} : $type eq '%' ? \%{"${pkg}::$sym"} : $type eq '*' ? *{"${pkg}::$sym"} : - Carp::croak("Can't export symbol: $type$sym"); + do { require Carp; Carp::croak("Can't export symbol: $type$sym") }; } } @@ -165,8 +181,11 @@ sub _push_tags { push(@{"${pkg}::$var"}, map { $export_tags{$_} ? @{$export_tags{$_}} : scalar(++$nontag,$_) } (@$syms) ? @$syms : keys %export_tags); - # This may change to a die one day - Carp::carp("Some names are not tags") if $nontag and $^W; + if ($nontag and $^W) { + # This may change to a die one day + require Carp; + Carp::carp("Some names are not tags"); + } } sub export_tags { _push_tags((caller)[0], "EXPORT", \@_) } @@ -188,6 +207,7 @@ sub require_version { $version ||= "(undef)"; my $file = $INC{"$pkg.pm"}; $file &&= " ($file)"; + require Carp; Carp::croak("$pkg $wanted required--this is only version $version$file") } $version; @@ -246,7 +266,7 @@ In other files which wish to use ModuleName: =head1 DESCRIPTION The Exporter module implements a default C<import> method which -many modules choose inherit rather than implement their own. +many modules choose to inherit rather than implement their own. Perl automatically calls the C<import> method when processing a C<use> statement for a module. Modules and C<use> are documented diff --git a/lib/ExtUtils/Command.pm b/lib/ExtUtils/Command.pm new file mode 100644 index 0000000000..8c4fd7a916 --- /dev/null +++ b/lib/ExtUtils/Command.pm @@ -0,0 +1,212 @@ +package ExtUtils::Command; +use strict; +# use AutoLoader; +use File::Copy; +use File::Compare; +use File::Basename; +use File::Path qw(rmtree); +require Exporter; +use vars qw(@ISA @EXPORT $VERSION); +@ISA = qw(Exporter); +@EXPORT = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f); +$VERSION = '1.00'; + +=head1 NAME + +ExtUtils::Command - utilities to replace common UNIX commands in Makefiles etc. + +=head1 SYNOPSYS + + perl -MExtUtils::command -e cat files... > destination + perl -MExtUtils::command -e mv source... destination + perl -MExtUtils::command -e cp source... destination + perl -MExtUtils::command -e touch files... + perl -MExtUtils::command -e rm_f file... + perl -MExtUtils::command -e rm_rf directories... + perl -MExtUtils::command -e mkpath directories... + perl -MExtUtils::command -e eqtime source destination + perl -MExtUtils::command -e chmod mode files... + perl -MExtUtils::command -e test_f file + +=head1 DESCRIPTION + +The module is used in Win32 port to replace common UNIX commands. +Most commands are wrapers on generic modules File::Path and File::Basename. + +=over 4 + +=item cat + +Concatenates all files menthion on command line to STDOUT. + +=cut + +sub cat () +{ + print while (<>); +} + +=item eqtime src dst + +Sets modified time of dst to that of src + +=cut + +sub eqtime +{ + my ($src,$dst) = @ARGV; + open(F,">$dst"); + close(F); + utime((stat($src))[8,9],$dst); +} + +=item rm_f files.... + +Removes directories - recursively (even if readonly) + +=cut + +sub rm_rf +{ + rmtree([@ARGV],0,0); +} + +=item rm_f files.... + +Removes files (even if readonly) + +=cut + +sub rm_f +{ + foreach (@ARGV) + { + next unless -e $_; + chmod(0777,$_); + next if (-f $_ and unlink($_)); + die "Cannot delete $_:$!"; + } +} + +=item touch files ... + +Makes files exist, with current timestamp + +=cut + +sub touch +{ + while (@ARGV) + { + my $file = shift(@ARGV); + open(FILE,">>$file") || die "Cannot write $file:$!"; + close(FILE); + } +} + +=item mv source... destination + +Moves source to destination. +Multiple sources are allowed if destination is an existing directory. + +=cut + +sub mv +{ + my $dst = pop(@ARGV); + if (-d $dst) + { + while (@ARGV) + { + my $src = shift(@ARGV); + my $leaf = basename($src); + move($src,"$dst/$leaf"); # fixme + } + } + else + { + my $src = shift(@ARGV); + move($src,$dst) || die "Cannot move $src $dst:$!"; + } +} + +=item cp source... destination + +Copies source to destination. +Multiple sources are allowed if destination is an existing directory. + +=cut + +sub cp +{ + my $dst = pop(@ARGV); + if (-d $dst) + { + while (@ARGV) + { + my $src = shift(@ARGV); + my $leaf = basename($src); + copy($src,"$dst/$leaf"); # fixme + } + } + else + { + copy(shift,$dst); + } +} + +=item chmod mode files... + +Sets UNIX like permissions 'mode' on all the files. + +=cut + +sub chmod +{ + chmod(@ARGV) || die "Cannot chmod ".join(' ',@ARGV).":$!"; +} + +=item mkpath directory... + +Creates directory, including any parent directories. + +=cut + +sub mkpath +{ + File::Path::mkpath([@ARGV],1,0777); +} + +=item test_f file + +Tests if a file exists + +=cut + +sub test_f +{ + exit !-f shift(@ARGV); +} + +1; +__END__ + +=back + +=head1 BUGS + +eqtime does not work right on Win32 due to problems with utime() built-in +command. + +Should probably be Auto/Self loaded. + +=head1 SEE ALSO + +ExtUtils::MakeMaker, ExtUtils::MM_Unix, ExtUtils::MM_Win32 + +=head1 AUTHOR + +Nick Ing-Simmons <F<nick@ni-s.u-net.com>>. + +=cut + diff --git a/lib/ExtUtils/Install.pm b/lib/ExtUtils/Install.pm index a88bd9975e..71f553bcbf 100644 --- a/lib/ExtUtils/Install.pm +++ b/lib/ExtUtils/Install.pm @@ -233,6 +233,17 @@ sub pm_to_blib { # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al)); # require $my_req; # Hairy, but for the first + if (!ref($fromto) && -r $fromto) + { + # Win32 has severe command line length limitations, but + # can generate temporary files on-the-fly + # so we pass name of file here - eval it to get hash + open(FROMTO,"<$fromto") or die "Cannot open $fromto:$!"; + my $str = '$fromto = {qw{'.join('',<FROMTO>).'}}'; + eval $str; + close(FROMTO); + } + my $umask = umask 0022 unless $Is_VMS; mkpath($autodir,0,0755); foreach (keys %$fromto) { diff --git a/lib/ExtUtils/MM_OS2.pm b/lib/ExtUtils/MM_OS2.pm index 1a1f8b16a0..65abfc2d99 100644 --- a/lib/ExtUtils/MM_OS2.pm +++ b/lib/ExtUtils/MM_OS2.pm @@ -54,6 +54,17 @@ sub file_name_is_absolute { $file =~ m{^([a-z]:)?[\\/]}i ; } +sub perl_archive +{ + return "\$(PERL_INC)/libperl\$(LIB_EXT)"; +} + +sub export_list +{ + my ($self) = @_; + return "$self->{BASEEXT}.def"; +} + 1; __END__ diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm index 465a075132..f4ee44f4b9 100644 --- a/lib/ExtUtils/MM_Unix.pm +++ b/lib/ExtUtils/MM_Unix.pm @@ -8,7 +8,7 @@ use strict; use vars qw($VERSION $Is_Mac $Is_OS2 $Is_VMS $Verbose %pm %static $Xsubpp_Version); -$VERSION = substr q$Revision: 1.113 $, 10; +$VERSION = substr q$Revision: 1.114 $, 10; # $Id: MM_Unix.pm,v 1.113 1997/02/11 21:54:09 k Exp $ Exporter::import('ExtUtils::MakeMaker', @@ -176,6 +176,7 @@ sub ExtUtils::MM_Unix::dynamic ; sub ExtUtils::MM_Unix::dynamic_bs ; sub ExtUtils::MM_Unix::dynamic_lib ; sub ExtUtils::MM_Unix::exescan ; +sub ExtUtils::MM_Unix::export_list ; sub ExtUtils::MM_Unix::extliblist ; sub ExtUtils::MM_Unix::file_name_is_absolute ; sub ExtUtils::MM_Unix::find_perl ; @@ -201,6 +202,7 @@ sub ExtUtils::MM_Unix::nicetext ; sub ExtUtils::MM_Unix::parse_version ; sub ExtUtils::MM_Unix::pasthru ; sub ExtUtils::MM_Unix::path ; +sub ExtUtils::MM_Unix::perl_archive; sub ExtUtils::MM_Unix::perl_script ; sub ExtUtils::MM_Unix::perldepend ; sub ExtUtils::MM_Unix::pm_to_blib ; @@ -395,7 +397,7 @@ clean :: '); # clean subdirectories first for $dir (@{$self->{DIR}}) { - push @m, "\t-cd $dir && test -f $self->{MAKEFILE} && \$(MAKE) clean\n"; + push @m, "\t-cd $dir && \$(TEST_F) $self->{MAKEFILE} && \$(MAKE) clean\n"; } my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files @@ -409,7 +411,7 @@ clean :: push @m, "\t-$self->{RM_RF} @otherfiles\n"; # See realclean and ext/utils/make_ext for usage of Makefile.old push(@m, - "\t-$self->{MV} $self->{MAKEFILE} $self->{MAKEFILE}.old 2>/dev/null\n"); + "\t-$self->{MV} $self->{MAKEFILE} $self->{MAKEFILE}.old \$(DEV_NULL)\n"); push(@m, "\t$attribs{POSTOP}\n") if $attribs{POSTOP}; join("", @m); @@ -600,20 +602,11 @@ INST_BOOT = '; } - if ($Is_OS2) { - $tmp = "$self->{BASEEXT}.def"; - } else { - $tmp = ""; - } + $tmp = $self->export_list; push @m, " EXPORT_LIST = $tmp "; - - if ($Is_OS2) { - $tmp = "\$(PERL_INC)/libperl\$(LIB_EXT)"; - } else { - $tmp = ""; - } + $tmp = $self->perl_archive; push @m, " PERL_ARCHIVE = $tmp "; @@ -673,8 +666,7 @@ sub dir_target { foreach $dir (@dirs) { my($src) = $self->catfile($self->{PERL_INC},'perl.h'); my($targ) = $self->catfile($dir,'.exists'); - my($targdir) = $targ; # Necessary because catfile may have - $targdir =~ s:/?.exists$::; # adapted syntax of $dir to target OS + my($targdir) = dirname($targ); # Necessary because catfile may have adapted syntax of $dir to target OS next if $self->{DIR_TARGET}{$self}{$targdir}++; push @m, qq{ $targ :: $src @@ -713,7 +705,7 @@ sub dist { my($to_unix) = $attribs{TO_UNIX} || ($Is_OS2 ? "$self->{NOECHO}" - . 'test -f tmp.zip && $(RM) tmp.zip;' + . '$(TEST_F) tmp.zip && $(RM) tmp.zip;' . ' $(ZIP) -ll -mr tmp.zip $(DISTVNAME) && unzip -o tmp.zip && $(RM) tmp.zip' : "$self->{NOECHO}\$(NOOP)"); @@ -757,20 +749,20 @@ distclean :: realclean distcheck push @m, q{ distcheck : - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&fullcheck";' \\ - -e 'fullcheck();' + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=fullcheck \\ + -e fullcheck }; push @m, q{ skipcheck : - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&skipcheck";' \\ - -e 'skipcheck();' + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=skipcheck \\ + -e skipcheck }; push @m, q{ manifest : - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&mkmanifest";' \\ - -e 'mkmanifest();' + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=mkmanifest \\ + -e mkmanifest }; join "", @m; } @@ -786,8 +778,8 @@ sub dist_ci { my @m; push @m, q{ ci : - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&maniread";' \\ - -e '@all = keys %{ maniread() };' \\ + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=maniread \\ + -e "@all = keys %{ maniread() };" \\ -e 'print("Executing $(CI) @all\n"); system("$(CI) @all");' \\ -e 'print("Executing $(RCS_LABEL) ...\n"); system("$(RCS_LABEL) @all");' }; @@ -854,7 +846,7 @@ sub dist_dir { distdir : $(RM_RF) $(DISTVNAME) $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=manicopy,maniread \\ - -e 'manicopy(maniread(),"$(DISTVNAME)", "$(DIST_CP)");' + -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');" }; join "", @m; } @@ -955,8 +947,8 @@ BOOTSTRAP = '."$self->{BASEEXT}.bs".' $(BOOTSTRAP): '."$self->{MAKEFILE} $self->{BOOTDEP}".' $(INST_ARCHAUTODIR)/.exists '.$self->{NOECHO}.'echo "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))" '.$self->{NOECHO}.'$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \ - -e \'use ExtUtils::Mkbootstrap;\' \ - -e \'Mkbootstrap("$(BASEEXT)","$(BSLOADLIBS)");\' + -MExtUtils::Mkbootstrap \ + -e "Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');" '.$self->{NOECHO}.'$(TOUCH) $(BOOTSTRAP) $(CHMOD) 644 $@ @@ -1718,7 +1710,7 @@ usually solves this kind of problem. Initializes EXTRALIBS, BSLOADLIBS, LDLOADLIBS, LIBS, LD_RUN_PATH, OBJECT, BOOTDEP, PERLMAINCC, LDFROM, LINKTYPE, NOOP, FIRST_MAKEFILE, -MAKEFILE, NOECHO, RM_F, RM_RF, TOUCH, CP, MV, CHMOD, UMASK_NULL +MAKEFILE, NOECHO, RM_F, RM_RF, TEST_F, TOUCH, CP, MV, CHMOD, UMASK_NULL =cut @@ -1776,10 +1768,12 @@ sub init_others { # --- Initialize Other Attributes $self->{RM_F} ||= "rm -f"; $self->{RM_RF} ||= "rm -rf"; $self->{TOUCH} ||= "touch"; + $self->{TEST_F} ||= "test -f"; $self->{CP} ||= "cp"; $self->{MV} ||= "mv"; $self->{CHMOD} ||= "chmod"; $self->{UMASK_NULL} ||= "umask 0"; + $self->{DEV_NULL} ||= "> /dev/null 2>&1"; } =item install (o) @@ -2196,8 +2190,8 @@ $tmp/perlmain\$(OBJ_EXT): $tmp/perlmain.c push @m, qq{ $tmp/perlmain.c: $makefilename}, q{ }.$self->{NOECHO}.q{echo Writing $@ - }.$self->{NOECHO}.q{$(PERL) $(MAP_PERLINC) -e 'use ExtUtils::Miniperl; \\ - writemain(grep s#.*/auto/##, qw|$(MAP_STATIC)|)' > $@t && mv $@t $@ + }.$self->{NOECHO}.q{$(PERL) $(MAP_PERLINC) -MExtUtils::Miniperl \\ + -e "writemain(grep s#.*/auto/##, qw|$(MAP_STATIC)|)" > $@t && $(MV) $@t $@ }; @@ -2250,11 +2244,12 @@ $(OBJECT) : $(FIRST_MAKEFILE) }.$self->{MAKEFILE}.q{ : Makefile.PL $(CONFIGDEP) }.$self->{NOECHO}.q{echo "Makefile out-of-date with respect to $?" }.$self->{NOECHO}.q{echo "Cleaning current config before rebuilding Makefile..." - -}.$self->{NOECHO}.q{mv }."$self->{MAKEFILE} $self->{MAKEFILE}.old".q{ - -$(MAKE) -f }.$self->{MAKEFILE}.q{.old clean >/dev/null 2>&1 || true + -}.$self->{NOECHO}.q{$(MV) }."$self->{MAKEFILE} $self->{MAKEFILE}.old".q{ + -$(MAKE) -f }.$self->{MAKEFILE}.q{.old clean $(DEV_NULL) || $(NOOP) $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL }.join(" ",map(qq["$_"],@ARGV)).q{ - }.$self->{NOECHO}.q{echo ">>> Your Makefile has been rebuilt. <<<" - }.$self->{NOECHO}.q{echo ">>> Please rerun the make command. <<<"; false + }.$self->{NOECHO}.q{echo "==> Your Makefile has been rebuilt. <==" + }.$self->{NOECHO}.q{echo "==> Please rerun the make command. <==" + false # To change behavior to :: would be nice, but would break Tk b9.02 # so you find such a warning below the dist target. @@ -2554,7 +2549,7 @@ sub pm_to_blib { pm_to_blib: $(TO_INST_PM) }.$self->{NOECHO}.q{$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \ "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \ - -e 'pm_to_blib({qw{$(PM_TO_BLIB)}},"}.$autodir.q{")' + -e "pm_to_blib({qw{$(PM_TO_BLIB)}},'}.$autodir.q{')" }.$self->{NOECHO}.q{$(TOUCH) $@ }; } @@ -2647,7 +2642,7 @@ sub realclean { realclean purge :: clean '); # realclean subdirectories first (already cleaned) - my $sub = "\t-cd %s && test -f %s && \$(MAKE) %s realclean\n"; + my $sub = "\t-cd %s && \$(TEST_F) %s && \$(MAKE) %s realclean\n"; foreach(@{$self->{DIR}}){ push(@m, sprintf($sub,$_,"$self->{MAKEFILE}.old","-f $self->{MAKEFILE}.old")); push(@m, sprintf($sub,$_,"$self->{MAKEFILE}",'')); @@ -2845,7 +2840,7 @@ testdb :: testdb_\$(LINKTYPE) test :: \$(TEST_TYPE) "); - push(@m, map("\t$self->{NOECHO}cd $_ && test -f $self->{MAKEFILE} && \$(MAKE) test \$(PASTHRU)\n", + push(@m, map("\t$self->{NOECHO}cd $_ && \$(TEST_F) $self->{MAKEFILE} && \$(MAKE) test \$(PASTHRU)\n", @{$self->{DIR}})); push(@m, "\t$self->{NOECHO}echo 'No tests defined for \$(NAME) extension.'\n") unless $tests or -f "test.pl" or @{$self->{DIR}}; @@ -2936,27 +2931,23 @@ sub tools_other { SHELL = $bin_sh }; - for (qw/ CHMOD CP LD MV NOOP RM_F RM_RF TOUCH UMASK_NULL / ) { + for (qw/ CHMOD CP LD MV NOOP RM_F RM_RF TEST_F TOUCH UMASK_NULL DEV_NULL/ ) { push @m, "$_ = $self->{$_}\n"; } - push @m, q{ # The following is a portable way to say mkdir -p # To see which directories are created, change the if 0 to if 1 -MKPATH = $(PERL) -wle '$$"="/"; foreach $$p (@ARGV){' \\ --e 'next if -d $$p; my(@p); foreach(split(/\//,$$p)){' \\ --e 'push(@p,$$_); next if -d "@p/"; print "mkdir @p" if 0;' \\ --e 'mkdir("@p",0777)||die $$! } } exit 0;' +MKPATH = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mkpath # This helps us to minimize the effect of the .exists files A yet # better solution would be to have a stable file in the perl # distribution with a timestamp of zero. But this solution doesn't # need any changes to the core distribution and works with older perls -EQUALIZE_TIMESTAMP = $(PERL) -we 'open F, ">$$ARGV[1]"; close F;' \\ --e 'utime ((stat("$$ARGV[0]"))[8,9], $$ARGV[1])' +EQUALIZE_TIMESTAMP = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e eqtime }; + return join "", @m if $self->{PARENT}; push @m, q{ @@ -2971,7 +2962,7 @@ UNINST=0 VERBINST=1 MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \ --e 'install({@ARGV},"$(VERBINST)",0,"$(UNINST)");' +-e "install({@ARGV},'$(VERBINST)',0,'$(UNINST)');" DOC_INSTALL = $(PERL) -e '$$\="\n\n";' \ -e 'print "=head2 ", scalar(localtime), ": C<", shift, ">", " L<", shift, ">";' \ @@ -3110,10 +3101,15 @@ sub top_targets { my(@m); push @m, ' #all :: config $(INST_PM) subdirs linkext manifypods +'; + push @m, ' all :: pure_all manifypods '.$self->{NOECHO}.'$(NOOP) - +' + unless $self->{SKIPHASH}{'all'}; + + push @m, ' pure_all :: config pm_to_blib subdirs linkext '.$self->{NOECHO}.'$(NOOP) @@ -3168,7 +3164,7 @@ help: Version_check: }.$self->{NOECHO}.q{$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \ -MExtUtils::MakeMaker=Version_check \ - -e 'Version_check("$(MM_VERSION)")' + -e "Version_check('$(MM_VERSION)')" }; join('',@m); @@ -3200,7 +3196,7 @@ sub xs_c { return '' unless $self->needs_linking(); ' .xs.c: - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >$*.tc && mv $*.tc $@ + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >$*.tc && $(MV) $*.tc $@ '; } @@ -3216,11 +3212,38 @@ sub xs_o { # many makes are too dumb to use xs_c then c_o return '' unless $self->needs_linking(); ' .xs$(OBJ_EXT): - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >xstmp.c && mv xstmp.c $*.c + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >xstmp.c && $(MV) xstmp.c $*.c $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c '; } +=item perl_archive + +This is internal method that returns path to libperl.a equivalent +to be linked to dynamic extensions. UNIX does not have one but OS2 +and Win32 do. + +=cut + +sub perl_archive +{ + return ""; +} + +=item export_list + +This is internal method that returns name of a file that is +passed to linker to define symbols to be exported. +UNIX does not have one but OS2 and Win32 do. + +=cut + +sub export_list +{ + return ""; +} + + 1; =back diff --git a/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm index 0e2897c1ad..23e8fdbe7d 100644 --- a/lib/ExtUtils/MM_VMS.pm +++ b/lib/ExtUtils/MM_VMS.pm @@ -1051,7 +1051,10 @@ EOM $command = "$self->{PERL} $xsubpp $file"; print "Running: $command\n" if $Verbose; my $text = `$command` ; - warn "Running '$command' exits with status " . $? unless ($? & 1); + if ($?) { + use vmsish 'status'; + warn "Running '$command' exits with status $?"; + } unlink $file ; # gets 1.2 -> 1.92 and 2.000a1 diff --git a/lib/ExtUtils/MM_Win32.pm b/lib/ExtUtils/MM_Win32.pm new file mode 100644 index 0000000000..d001901f37 --- /dev/null +++ b/lib/ExtUtils/MM_Win32.pm @@ -0,0 +1,493 @@ +package ExtUtils::MM_Win32; + +=head1 NAME + +ExtUtils::MM_Win32 - methods to override UN*X behaviour in ExtUtils::MakeMaker + +=head1 SYNOPSIS + + use ExtUtils::MM_Win32; # Done internally by ExtUtils::MakeMaker if needed + +=head1 DESCRIPTION + +See ExtUtils::MM_Unix for a documentation of the methods provided +there. This package overrides the implementation of these methods, not +the semantics. + +=over + +=cut + +#use Config; +#use Cwd; +use File::Basename; +require Exporter; + +Exporter::import('ExtUtils::MakeMaker', + qw( $Verbose &neatvalue)); + +$ENV{EMXSHELL} = 'sh'; # to run `commands` +unshift @MM::ISA, 'ExtUtils::MM_Win32'; + +sub dlsyms { + my($self,%attribs) = @_; + + my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; + my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; + my($imports) = $attribs{IMPORTS} || $self->{IMPORTS} || {}; + my(@m); + (my $boot = $self->{NAME}) =~ s/:/_/g; + + if (not $self->{SKIPHASH}{'dynamic'}) { + push(@m," +$self->{BASEEXT}.def: Makefile.PL +", + q! $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Mksymlists \\ + -e "Mksymlists('NAME' => '!, $self->{NAME}, + q!', 'DLBASE' => '!,$self->{DLBASE}, + q!', 'DL_FUNCS' => !,neatvalue($funcs), + q!, 'IMPORTS' => !,neatvalue($imports), + q!, 'DL_VARS' => !, neatvalue($vars), q!);" +!); + } + join('',@m); +} + +sub replace_manpage_separator { + my($self,$man) = @_; + $man =~ s,/+,.,g; + $man; +} + +sub maybe_command { + my($self,$file) = @_; + return "$file.exe" if -e "$file.exe"; + return; +} + +sub file_name_is_absolute { + my($self,$file) = @_; + $file =~ m{^([a-z]:)?[\\/]}i ; +} + +sub find_perl { + my($self, $ver, $names, $dirs, $trace) = @_; + my($name, $dir); + if ($trace >= 2){ + print "Looking for perl $ver by these names: +@$names +in these dirs: +@$dirs +"; + } + foreach $dir (@$dirs){ + next unless defined $dir; # $self->{PERL_SRC} may be undefined + foreach $name (@$names){ + my ($abs, $val); + if ($self->file_name_is_absolute($name)) { # /foo/bar + $abs = $name; + } elsif ($self->canonpath($name) eq $self->canonpath(basename($name))) { # foo + $abs = $self->catfile($dir, $name); + } else { # foo/bar + $abs = $self->canonpath($self->catfile($self->curdir, $name)); + } + print "Checking $abs\n" if ($trace >= 2); + next unless $self->maybe_command($abs); + print "Executing $abs\n" if ($trace >= 2); + $val = `$abs -e "require $ver;" 2>&1`; + if ($? == 0) { + print "Using PERL=$abs\n" if $trace; + return $abs; + } elsif ($trace >= 2) { + print "Result: `$val'\n"; + } + } + } + print STDOUT "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n"; + 0; # false and not empty +} + +sub catdir { + my $self = shift; + my @args = @_; + for (@args) { + # append a slash to each argument unless it has one there + $_ .= "\\" if $_ eq '' or substr($_,-1) ne "\\"; + } + my $result = $self->canonpath(join('', @args)); + $result; +} + +=item catfile + +Concatenate one or more directory names and a filename to form a +complete path ending with a filename + +=cut + +sub catfile { + my $self = shift @_; + my $file = pop @_; + return $file unless @_; + my $dir = $self->catdir(@_); + for ($dir) { + $_ .= "\\" unless substr($_,length($_)-1,1) eq "\\"; + } + return $dir.$file; +} + +sub init_others +{ + my ($self) = @_; + &ExtUtils::MM_Unix::init_others; + $self->{'TOUCH'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e touch'; + $self->{'CHMOD'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e chmod'; + $self->{'CP'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e cp'; + $self->{'RM_F'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e rm_f'; + $self->{'RM_RF'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e rm_rf'; + $self->{'MV'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mv'; + $self->{'NOOP'} = 'rem'; + $self->{'TEST_F'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e test_f'; + $self->{'LD'} = 'link'; + $self->{'DEV_NULL'} = '> NUL'; + # $self->{'NOECHO'} = ''; # till we have it working +} + +sub path { + local $^W = 1; + my($self) = @_; + my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'}; + my @path = split(';',$path); + foreach(@path) { $_ = '.' if $_ eq '' } + @path; +} + +=item static_lib (o) + +Defines how to produce the *.a (or equivalent) files. + +=cut + +sub static_lib { + my($self) = @_; +# Come to think of it, if there are subdirs with linkcode, we still have no INST_STATIC +# return '' unless $self->needs_linking(); #might be because of a subdir + + return '' unless $self->has_link_code; + + my(@m); + push(@m, <<'END'); +$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)/.exists + $(RM_RF) $@ +END + # If this extension has it's own library (eg SDBM_File) + # then copy that to $(INST_STATIC) and add $(OBJECT) into it. + push(@m, "\t$self->{CP} \$(MYEXTLIB) \$\@\n") if $self->{MYEXTLIB}; + + push @m, +q{ lib -nologo -out:$@ $(OBJECT) + }.$self->{NOECHO}.q{echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld + $(CHMOD) 755 $@ +}; + +# Old mechanism - still available: + + push @m, "\t$self->{NOECHO}".q{echo "$(EXTRALIBS)" >> $(PERL_SRC)/ext.libs}."\n\n" + if $self->{PERL_SRC}; + + push @m, $self->dir_target('$(INST_ARCHAUTODIR)'); + join('', "\n",@m); +} + + + +=item dynamic_lib (o) + +Defines how to produce the *.so (or equivalent) files. + +=cut + +sub dynamic_lib { + my($self, %attribs) = @_; + return '' unless $self->needs_linking(); #might be because of a subdir + + return '' unless $self->has_link_code; + + my($otherldflags) = $attribs{OTHERLDFLAGS} || ""; + my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || ""; + my($ldfrom) = '$(LDFROM)'; + my(@m); + push(@m,' +# This section creates the dynamically loadable $(INST_DYNAMIC) +# from $(OBJECT) and possibly $(MYEXTLIB). +OTHERLDFLAGS = '.$otherldflags.' +INST_DYNAMIC_DEP = '.$inst_dynamic_dep.' + +$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) +'); + + push(@m,' $(LD) -out:$@ $(LDDLFLAGS) '.$ldfrom. + ' $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)'); + push @m, ' + $(CHMOD) 755 $@ +'; + + push @m, $self->dir_target('$(INST_ARCHAUTODIR)'); + join('',@m); +} + +sub perl_archive +{ + return '$(PERL_INC)\perl$(LIB_EXT)'; +} + +sub export_list +{ + my ($self) = @_; + return "$self->{BASEEXT}.def"; +} + +=item canonpath + +No physical check on the filesystem, but a logical cleanup of a +path. On UNIX eliminated successive slashes and successive "/.". + +=cut + +sub canonpath { + my($self,$path) = @_; + $path =~ s|/|\\|g; + $path =~ s|\\+|\\|g ; # xx////xx -> xx/xx + $path =~ s|(\\\.)+\\|\\|g ; # xx/././xx -> xx/xx + $path =~ s|^(\.\\)+|| unless $path eq ".\\"; # ./xx -> xx + $path =~ s|\\$|| + unless $path =~ m#^([a-z]:)?\\#; # xx/ -> xx + $path .= '.' if $path =~ m#\\$#; + $path; +} + +=item perl_script + +Takes one argument, a file name, and returns the file name, if the +argument is likely to be a perl script. On MM_Unix this is true for +any ordinary, readable file. + +=cut + +sub perl_script { + my($self,$file) = @_; + return "$file.pl" if -r "$file.pl" && -f _; + return; +} + +=item pm_to_blib + +Defines target that copies all files in the hash PM to their +destination and autosplits them. See L<ExtUtils::Install/DESCRIPTION> + +=cut + +sub pm_to_blib { + my $self = shift; + my($autodir) = $self->catdir('$(INST_LIB)','auto'); + return q{ +pm_to_blib: $(TO_INST_PM) + }.$self->{NOECHO}.q{$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \ + "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \ + -e "pm_to_blib(qw{ <<pmfiles.dat },'}.$autodir.q{')" + }.q{ +$(PM_TO_BLIB) +<< + }.$self->{NOECHO}.q{$(TOUCH) $@ +}; +} + +=item test_via_harness (o) + +Helper method to write the test targets + +=cut + +sub test_via_harness { + my($self, $perl, $tests) = @_; + "\t$perl".q! -Mblib -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e "use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;" !."$tests\n"; +} + +=item tool_autosplit (override) + +Use Win32 quoting on command line. + +=cut + +sub tool_autosplit{ + my($self, %attribs) = @_; + my($asl) = ""; + $asl = "\$AutoSplit::Maxlen=$attribs{MAXLEN};" if $attribs{MAXLEN}; + q{ +# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto +AUTOSPLITFILE = $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MAutoSplit }.$asl.q{ -e "autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1);" +}; +} + +=item tools_other (o) + +Win32 overrides. + +Defines SHELL, LD, TOUCH, CP, MV, RM_F, RM_RF, CHMOD, UMASK_NULL in +the Makefile. Also defines the perl programs MKPATH, +WARN_IF_OLD_PACKLIST, MOD_INSTALL. DOC_INSTALL, and UNINSTALL. + +=cut + +sub tools_other { + my($self) = shift; + my @m; + my $bin_sh = $Config{sh} || 'cmd /c'; + push @m, qq{ +SHELL = $bin_sh +}; + + for (qw/ CHMOD CP LD MV NOOP RM_F RM_RF TEST_F TOUCH UMASK_NULL DEV_NULL/ ) { + push @m, "$_ = $self->{$_}\n"; + } + + push @m, q{ +# The following is a portable way to say mkdir -p +# To see which directories are created, change the if 0 to if 1 +MKPATH = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mkpath + +# This helps us to minimize the effect of the .exists files A yet +# better solution would be to have a stable file in the perl +# distribution with a timestamp of zero. But this solution doesn't +# need any changes to the core distribution and works with older perls +EQUALIZE_TIMESTAMP = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e eqtime +}; + + + return join "", @m if $self->{PARENT}; + + push @m, q{ +# Here we warn users that an old packlist file was found somewhere, +# and that they should call some uninstall routine +WARN_IF_OLD_PACKLIST = $(PERL) -lwe "exit unless -f $$ARGV[0];" \\ +-e "print 'WARNING: I have found an old package in';" \\ +-e "print ' ', $$ARGV[0], '.';" \\ +-e "print 'Please make sure the two installations are not conflicting';" + +UNINST=0 +VERBINST=1 + +MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \ +-e "install({@ARGV},'$(VERBINST)',0,'$(UNINST)');" + +DOC_INSTALL = $(PERL) -e "$$\=\"\n\n\";" \ +-e "print '=head2 ', scalar(localtime), ': C<', shift, '>', ' L<', shift, '>';" \ +-e "print '=over 4';" \ +-e "while (defined($$key = shift) and defined($$val = shift)){print '=item *';print 'C<', \"$$key: $$val\", '>';}" \ +-e "print '=back';" + +UNINSTALL = $(PERL) -MExtUtils::Install \ +-e "uninstall($$ARGV[0],1,1); print \"\nUninstall is deprecated. Please check the";" \ +-e "print \" packlist above carefully.\n There may be errors. Remove the\";" \ +-e "print \" appropriate files manually.\n Sorry for the inconveniences.\n\"" +}; + + return join "", @m; +} + +=item manifypods (o) + +We don't want manpage process. XXX add pod2html support later. + +=cut + +sub manifypods { + return "\nmanifypods :\n\t$self->{NOECHO}\$(NOOP)\n"; +} + +=item dist_ci (o) + +Same as MM_Unix version (changes command-line quoting). + +=cut + +sub dist_ci { + my($self) = shift; + my @m; + push @m, q{ +ci : + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=maniread \\ + -e "@all = keys %{ maniread() };" \\ + -e "print(\"Executing $(CI) @all\n\"); system(\"$(CI) @all\");" \\ + -e "print(\"Executing $(RCS_LABEL) ...\n\"); system(\"$(RCS_LABEL) @all\");" +}; + join "", @m; +} + +=item dist_core (o) + +Same as MM_Unix version (changes command-line quoting). + +=cut + +sub dist_core { + my($self) = shift; + my @m; + push @m, q{ +dist : $(DIST_DEFAULT) + }.$self->{NOECHO}.q{$(PERL) -le "print \"Warning: Makefile possibly out of date with $$vf\" if " \ + -e "-e ($$vf=\"$(VERSION_FROM)\") and -M $$vf < -M \"}.$self->{MAKEFILE}.q{\";" + +tardist : $(DISTVNAME).tar$(SUFFIX) + +zipdist : $(DISTVNAME).zip + +$(DISTVNAME).tar$(SUFFIX) : distdir + $(PREOP) + $(TO_UNIX) + $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME) + $(RM_RF) $(DISTVNAME) + $(COMPRESS) $(DISTVNAME).tar + $(POSTOP) + +$(DISTVNAME).zip : distdir + $(PREOP) + $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME) + $(RM_RF) $(DISTVNAME) + $(POSTOP) + +uutardist : $(DISTVNAME).tar$(SUFFIX) + uuencode $(DISTVNAME).tar$(SUFFIX) \\ + $(DISTVNAME).tar$(SUFFIX) > \\ + $(DISTVNAME).tar$(SUFFIX)_uu + +shdist : distdir + $(PREOP) + $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar + $(RM_RF) $(DISTVNAME) + $(POSTOP) +}; + join "", @m; +} + +=item pasthru (o) + +Defines the string that is passed to recursive make calls in +subdirectories. + +=cut + +sub pasthru { + my($self) = shift; + return "PASTHRU = /nologo" +} + + + +1; +__END__ + +=back + +=cut + diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm index bf0b0d202e..eb49f3e55f 100644 --- a/lib/ExtUtils/MakeMaker.pm +++ b/lib/ExtUtils/MakeMaker.pm @@ -68,9 +68,10 @@ package ExtUtils::MakeMaker; # # Now we can can pull in the friends # -$Is_VMS = $^O eq 'VMS'; -$Is_OS2 = $^O eq 'os2'; -$Is_Mac = $^O eq 'MacOS'; +$Is_VMS = $^O eq 'VMS'; +$Is_OS2 = $^O eq 'os2'; +$Is_Mac = $^O eq 'MacOS'; +$Is_Win32 = $^O eq 'MSWin32'; require ExtUtils::MM_Unix; @@ -84,6 +85,9 @@ if ($Is_OS2) { if ($Is_Mac) { require ExtUtils::MM_Mac; } +if ($Is_Win32) { + require ExtUtils::MM_Win32; +} # The SelfLoader would bring a lot of overhead for MakeMaker, because # we know for sure we will use most of the autoloaded functions once @@ -150,7 +154,7 @@ sub ExtUtils::MakeMaker::mksymlists ; sub ExtUtils::MakeMaker::neatvalue ; sub ExtUtils::MakeMaker::selfdocument ; sub ExtUtils::MakeMaker::WriteMakefile ; -sub ExtUtils::MakeMaker::prompt ; +sub ExtUtils::MakeMaker::prompt ($;$) ; 1; @@ -449,9 +453,10 @@ sub ExtUtils::MakeMaker::new { $self->init_main(); if (! $self->{PERL_SRC} ) { - my($pthinks) = $INC{'Config.pm'}; + my($pthinks) = $self->canonpath($INC{'Config.pm'}); $pthinks = VMS::Filespec::vmsify($pthinks) if $Is_VMS; if ($pthinks ne $self->catfile($Config{archlibexp},'Config.pm')){ + print "Have $pthinks expected ",$self->catfile($Config{archlibexp},'Config.pm'),"\n"; $pthinks =~ s!/Config\.pm$!!; $pthinks =~ s!.*/!!; print STDOUT <<END; diff --git a/lib/ExtUtils/Mksymlists.pm b/lib/ExtUtils/Mksymlists.pm index 4c6814cbcb..fd609152c3 100644 --- a/lib/ExtUtils/Mksymlists.pm +++ b/lib/ExtUtils/Mksymlists.pm @@ -49,6 +49,7 @@ sub Mksymlists { if ($osname eq 'aix') { _write_aix(\%spec); } elsif ($osname eq 'VMS') { _write_vms(\%spec) } elsif ($osname eq 'os2') { _write_os2(\%spec) } + elsif ($osname eq 'MSWin32') { _write_win32(\%spec) } else { croak("Don't know how to create linker option file for $osname\n"); } } @@ -93,6 +94,33 @@ while (($name, $exp)= each %{$data->{IMPORTS}}) { close DEF; } +sub _write_win32 { + my($data) = @_; + + if (not $data->{DLBASE}) { + ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://; + $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_'; + } + rename "$data->{FILE}.def", "$data->{FILE}_def.old"; + + open(DEF,">$data->{FILE}.def") + or croak("Can't create $data->{FILE}.def: $!\n"); + print DEF "LIBRARY $data->{DLBASE}\n"; + print DEF "CODE LOADONCALL\n"; + print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n"; + print DEF "EXPORTS\n "; + print DEF join("\n ",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}}; + print DEF join("\n ",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}}; + if (%{$data->{IMPORTS}}) { + print DEF "IMPORTS\n"; + my ($name, $exp); + while (($name, $exp)= each %{$data->{IMPORTS}}) { + print DEF " $name=$exp\n"; + } + } + close DEF; +} + sub _write_vms { my($data) = @_; diff --git a/lib/File/Basename.pm b/lib/File/Basename.pm index 6abfcd2cb4..0442aed8c5 100644 --- a/lib/File/Basename.pm +++ b/lib/File/Basename.pm @@ -34,7 +34,7 @@ pieces using the syntax of different operating systems. You select the syntax via the routine fileparse_set_fstype(). If the argument passed to it contains one of the substrings -"VMS", "MSDOS", "MacOS", or "AmigaOS", the file specification +"VMS", "MSDOS", "MacOS", "AmigaOS" or "MSWin32", the file specification syntax of that operating system is used in future calls to fileparse(), basename(), and dirname(). If it contains none of these substrings, UNIX syntax is used. This pattern matching is @@ -44,7 +44,7 @@ they assume you are using UNIX emulation and apply the UNIX syntax rules instead, for that function call only. If the argument passed to it contains one of the substrings "VMS", -"MSDOS", "MacOS", "AmigaOS", "os2", or "RISCOS", then the pattern +"MSDOS", "MacOS", "AmigaOS", "os2", "MSWin32" or "RISCOS", then the pattern matching for suffix removal is performed without regard for case, since those systems are not case-sensitive when opening existing files (though some of them preserve case on file creation). @@ -128,7 +128,7 @@ require Exporter; @EXPORT = qw(fileparse fileparse_set_fstype basename dirname); #use strict; #use vars qw($VERSION $Fileparse_fstype $Fileparse_igncase); -$VERSION = "2.4"; +$VERSION = "2.5"; # fileparse_set_fstype() - specify OS-based rules used in future @@ -141,7 +141,7 @@ sub fileparse_set_fstype { my @old = ($Fileparse_fstype, $Fileparse_igncase); if (@_) { $Fileparse_fstype = $_[0]; - $Fileparse_igncase = ($_[0] =~ /^(?:MacOS|VMS|AmigaOS|os2|RISCOS)/i); + $Fileparse_igncase = ($_[0] =~ /^(?:MacOS|VMS|AmigaOS|os2|RISCOS|MSWin32)/i); } wantarray ? @old : $old[0]; } @@ -173,6 +173,10 @@ sub fileparse { ($dirpath,$basename) = ($fullname =~ /(.*[:\/])?(.*)/); $dirpath = './' unless $dirpath; } + elsif ($fstype =~ /^MSWin32/i) { + ($dirpath,$basename) = ($fullname =~ /^(.*[:\\\/])?(.*)/); + $dirpath .= ".\\" unless $dirpath =~ /[\\\/]$/; + } elsif ($fstype !~ /^VMS/i) { # default to Unix ($dirpath,$basename) = ($fullname =~ m#^(.*/)?(.*)#); $dirpath = './' unless $dirpath; @@ -223,6 +227,13 @@ sub dirname { $dirname =~ s/([^:])[\\\/]*$/$1/; } } + elsif ($fstype =~ /MSWin32/i) { + $dirname =~ s/([^:])[\\\/]*$/$1/; + unless( length($basename) ) { + ($basename,$dirname) = fileparse $dirname; + $dirname =~ s/([^:])[\\\/]*$/$1/; + } + } elsif ($fstype =~ /AmigaOS/i) { if ( $dirname =~ /:$/) { return $dirname } chop $dirname; diff --git a/lib/File/Path.pm b/lib/File/Path.pm index 2e35303bb3..137e7bb1ce 100644 --- a/lib/File/Path.pm +++ b/lib/File/Path.pm @@ -83,20 +83,24 @@ Charles Bailey E<lt>F<bailey@genetics.upenn.edu>E<gt> =head1 REVISION -This module was last revised 14-Feb-1996, for perl 5.002. $VERSION is -1.01. +This module was last revised 14-Feb-1996, for perl 5.002. +$VERSION is 1.0101. =cut -$VERSION = "1.01"; # That's my hobby-horse, A.K. - require 5.000; use Carp; +use File::Basename; require Exporter; + +use vars qw( $VERSION @ISA @EXPORT ); +$VERSION = "1.0101"; @ISA = qw( Exporter ); @EXPORT = qw( mkpath rmtree ); -$Is_VMS = $^O eq 'VMS'; +my $Is_VMS = $^O eq 'VMS'; +my $force_writeable = ($^O eq 'os2' || $^O eq 'msdos' || $^O eq 'MSWin32' + || $^O eq 'amigaos'); sub mkpath { my($paths, $verbose, $mode) = @_; @@ -107,16 +111,13 @@ sub mkpath { $mode = 0777 unless defined($mode); $paths = [$paths] unless ref $paths; my(@created); - foreach $path (@$paths){ + foreach $path (@$paths) { next if -d $path; - my(@p); - foreach(split(/\//, $path)){ - push(@p, $_); - next if -d "@p/"; - print "mkdir @p\n" if $verbose; - mkdir("@p",$mode) || croak "mkdir @p: $!"; - push(@created, "@p"); - } + my $parent = dirname($path); + push(@created,mkpath($parent, $verbose, $mode)) unless (-d $parent); + print "mkdir $path\n" if $verbose; + mkdir($path,$mode) || croak "mkdir $path: $!"; + push(@created, $path); } @created; } @@ -144,6 +145,8 @@ sub rmtree { print "skipped $root\n" if $verbose; next; } + chmod 0777, $root or carp "Can't make directory $root writeable: $!" + if $force_writeable; print "rmdir $root\n" if $verbose; (rmdir $root && ++$count) or carp "Can't remove directory $root: $!"; } @@ -153,6 +156,8 @@ sub rmtree { print "skipped $root\n" if $verbose; next; } + chmod 0666, $root or carp "Can't make file $root writeable: $!" + if $force_writeable; print "unlink $root\n" if $verbose; while (-e $root || -l $root) { # delete all versions under VMS (unlink($root) && ++$count) diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm index ec4ccd98e9..740b83fe54 100644 --- a/lib/Getopt/Long.pm +++ b/lib/Getopt/Long.pm @@ -535,7 +535,7 @@ BEGIN { use vars @EXPORT, @EXPORT_OK; # User visible variables. -use vars qw(&config $error $debug $major_version $minor_version); +use vars qw($error $debug $major_version $minor_version); # Deprecated visible variables. use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order $passthrough); diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index 1bc791be3e..6979a11549 100644 --- a/lib/Test/Harness.pm +++ b/lib/Test/Harness.pm @@ -11,7 +11,7 @@ use vars qw($VERSION $verbose $switches $have_devel_corestack $curtest @ISA @EXPORT @EXPORT_OK); $have_devel_corestack = 0; -$VERSION = "1.1501"; +$VERSION = "1.1502"; @ISA=('Exporter'); @EXPORT= qw(&runtests); @@ -58,12 +58,13 @@ sub runtests { while ($test = shift(@tests)) { $te = $test; chop($te); + if ($^O eq 'VMS') { $te =~ s/^.*\.t\./[.t./; } print "$te" . '.' x (20 - length($te)); my $fh = new FileHandle; $fh->open($test) or print "can't open $test. $!\n"; my $first = <$fh>; my $s = $switches; - $s .= " -T" if $first =~ /^#!.*\bperl.*-\w*T/; + $s .= q[ "-T"] if $first =~ /^#!.*\bperl.*-\w*T/; $fh->close or print "can't close $test. $!\n"; my $cmd = "$^X $s $test|"; $cmd = "MCR $cmd" if $^O eq 'VMS'; @@ -103,10 +104,13 @@ sub runtests { } $fh->close; # must close to reap child resource values my $wstatus = $?; - my $estatus = $^O eq 'VMS' ? $wstatus : $wstatus >> 8; - if ($^O eq 'VMS' ? !($wstatus & 1) : $wstatus) { + my $estatus = ($^O eq 'VMS' + ? eval 'use vmsish "status"; $estatus = $?' + : $wstatus >> 8); + if ($wstatus) { my ($failed, $canon, $percent) = ('??', '??'); print "dubious\n\tTest returned status $estatus (wstat $wstatus)\n"; + print "\t\t(VMS status is $estatus)\n" if $^O eq 'VMS'; if (corestatus($wstatus)) { # until we have a wait module if ($have_devel_corestack) { Devel::CoreStack::stack($^X); diff --git a/lib/autouse.pm b/lib/autouse.pm new file mode 100644 index 0000000000..e2ef580392 --- /dev/null +++ b/lib/autouse.pm @@ -0,0 +1,165 @@ +package autouse; + +#use strict; # debugging only +use 5.003_90; # ->can, for my $var + +$autouse::VERSION = '0.03'; + +my $DEBUG = $ENV{AUTOUSE_DEBUG}; + +sub vet_import ($); + +sub croak { + require Carp; + Carp::croak(@_); +} + +sub import { + shift; + my $module = shift; + + (my $pm = $module) =~ s{::}{/}g; + $pm .= '.pm'; + if (exists $INC{$pm}) { + vet_import $module; + local $Exporter::ExportLevel = $Exporter::ExportLevel + 1; + # $Exporter::Verbose = 1; + return $module->import(map { (my $f = $_) =~ s/\(.*?\)$// } @_); + } + + # It is not loaded: need to do real work. + my $callpkg = caller(0); + print "autouse called from $callpkg\n" if $DEBUG; + + my $index; + for my $f (@_) { + my $proto; + $proto = $1 if (my $func = $f) =~ s/\((.*)\)$//; + + my $closure_import_func = $func; # Full name + my $closure_func = $func; # Name inside package + my $index = index($func, '::'); + if ($index == -1) { + $closure_import_func = "${callpkg}::$func"; + } else { + $closure_func = substr $func, $index + 2; + croak "autouse into different package attempted" + unless substr($func, 0, $index) eq $module; + } + + my $load_sub = sub { + unless ($INC{pm}) { + require $pm; + die $@ if $@; + vet_import $module; + } + *$closure_import_func = \&{"${module}::$closure_func"}; + print "autousing $module; " + ."imported $closure_func as $closure_import_func\n" + if $DEBUG; + goto &$closure_import_func; + }; + + if (defined $proto) { + *$closure_import_func = eval "sub ($proto) { &\$load_sub }"; + } else { + *$closure_import_func = $load_sub; + } + } +} + +sub vet_import ($) { + my $module = shift; + if (my $import = $module->can('import')) { + croak "autoused module has unique import() method" + unless defined(\&Exporter::import) + && $import == \&Exporter::import; + } +} + +1; + +__END__ + +=head1 NAME + +autouse - postpone load of modules until a function is used + +=head1 SYNOPSIS + + use autouse 'Carp' => qw(carp croak); + carp "this carp was predeclared and autoused "; + +=head1 DESCRIPTION + +If the module C<Module> is already loaded, then the declaration + + use autouse 'Module' => qw(func1 func2($;$) Module::func3); + +is equivalent to + + use Module qw(func1 func2); + +if C<Module> defines func2() with prototype C<($;$)>, and func1() and +func3() have no prototypes. (At least if C<Module> uses C<Exporter>'s +C<import>, otherwise it is a fatal error.) + +If the module C<Module> is not loaded yet, then the above declaration +declares functions func1() and func2() in the current package, and +declares a function Module::func3(). When these functions are called, +they load the package C<Module> if needed, and substitute themselves +with the correct definitions. + +=head1 WARNING + +Using C<autouse> will move important steps of your program's execution +from compile time to runtime. This can + +=over + +=item * + +Break the execution of your program if the module you C<autouse>d has +some initialization which it expects to be done early. + +=item * + +hide bugs in your code since important checks (like correctness of +prototypes) is moved from compile time to runtime. In particular, if +the prototype you specified on C<autouse> line is wrong, you will not +find it out until the corresponding function is executed. This will be +very unfortunate for functions which are not always called (note that +for such functions C<autouse>ing gives biggest win, for a workaround +see below). + +=back + +To alleviate the second problem (partially) it is advised to write +your scripts like this: + + use Module; + use autouse Module => qw(carp($) croak(&$)); + carp "this carp was predeclared and autoused "; + +The first line ensures that the errors in your argument specification +are found early. When you ship your application you should comment +out the first line, since it makes the second one useless. + +=head1 BUGS + +If Module::func3() is autoused, and the module is loaded between the +C<autouse> directive and a call to Module::func3(), warnings about +redefinition would appear if warnings are enabled. + +If Module::func3() is autoused, warnings are disabled when loading the +module via autoused functions. + +=head1 AUTHOR + +Ilya Zakharevich (ilya@math.ohio-state.edu) + +=head1 SEE ALSO + +perl(1). + +=cut @@ -328,8 +328,8 @@ malloc(nbytes) } #ifdef PERL_CORE - DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) malloc %ld bytes\n", - (unsigned long)(p+1),an++,(long)size)); + DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05lu) malloc %ld bytes\n", + (unsigned long)(p+1),(unsigned long)(an++),(long)size)); #endif /* PERL_CORE */ /* remove from linked list */ @@ -485,7 +485,7 @@ free(mp) #endif #ifdef PERL_CORE - DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) free\n",(unsigned long)cp,an++)); + DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05lu) free\n",(unsigned long)cp,(unsigned long)(an++))); #endif /* PERL_CORE */ if (cp == NULL) @@ -496,7 +496,7 @@ free(mp) bucket = OV_INDEX(op); #endif if (OV_MAGIC(op, bucket) != MAGIC) { - static bad_free_warn = -1; + static int bad_free_warn = -1; if (bad_free_warn == -1) { char *pbf = getenv("PERL_BADFREE"); bad_free_warn = (pbf) ? atoi(pbf) : 1; @@ -645,9 +645,9 @@ realloc(mp, nbytes) #ifdef PERL_CORE #ifdef DEBUGGING if (debug & 128) { - PerlIO_printf(PerlIO_stderr(), "0x%lx: (%05d) rfree\n",(unsigned long)res,an++); - PerlIO_printf(PerlIO_stderr(), "0x%lx: (%05d) realloc %ld bytes\n", - (unsigned long)res,an++,(long)size); + PerlIO_printf(PerlIO_stderr(), "0x%lx: (%05lu) rfree\n",(unsigned long)res,(unsigned long)(an++)); + PerlIO_printf(PerlIO_stderr(), "0x%lx: (%05lu) realloc %ld bytes\n", + (unsigned long)res,(unsigned long)(an++),(long)size); } #endif #endif /* PERL_CORE */ @@ -286,7 +286,6 @@ MAGIC *mg; } } return 0; - break; case '+': if (curpm && (rx = curpm->op_pmregexp)) { paren = rx->lastparen; @@ -294,7 +293,6 @@ MAGIC *mg; goto getparen; } return 0; - break; case '`': if (curpm && (rx = curpm->op_pmregexp)) { if ((s = rx->subbeg) && rx->startp[0]) { @@ -607,7 +605,7 @@ MAGIC* mg; } #endif -#if !defined(OS2) && !defined(AMIGAOS) +#if !defined(OS2) && !defined(AMIGAOS) && !defined(_WIN32) /* And you'll never guess what the dog had */ /* in its mouth... */ if (tainting) { @@ -653,7 +651,7 @@ MAGIC* mg; } } } -#endif /* neither OS2 nor AMIGAOS */ +#endif /* neither OS2 nor AMIGAOS nor _WIN32 */ return 0; } @@ -1129,15 +1127,32 @@ MAGIC* mg; } int -magic_getitervar(sv,mg) +magic_getdefelem(sv,mg) SV* sv; MAGIC* mg; { SV *targ = Nullsv; if (LvTARGLEN(sv)) { - AV* av = (AV*)LvTARG(sv); - if (LvTARGOFF(sv) <= AvFILL(av)) - targ = AvARRAY(av)[LvTARGOFF(sv)]; + if (mg->mg_obj) { + HV* hv = (HV*)LvTARG(sv); + HE* he = hv_fetch_ent(hv, mg->mg_obj, FALSE, 0); + if (he) + targ = HeVAL(he); + } + else { + AV* av = (AV*)LvTARG(sv); + if ((I32)LvTARGOFF(sv) <= AvFILL(av)) + targ = AvARRAY(av)[LvTARGOFF(sv)]; + } + if (targ && targ != &sv_undef) { + /* somebody else defined it for us */ + SvREFCNT_dec(LvTARG(sv)); + LvTARG(sv) = SvREFCNT_inc(targ); + LvTARGLEN(sv) = 0; + SvREFCNT_dec(mg->mg_obj); + mg->mg_obj = Nullsv; + mg->mg_flags &= ~MGf_REFCOUNTED; + } } else targ = LvTARG(sv); @@ -1146,19 +1161,21 @@ MAGIC* mg; } int -magic_setitervar(sv,mg) +magic_setdefelem(sv,mg) SV* sv; MAGIC* mg; { if (LvTARGLEN(sv)) - vivify_itervar(sv); - if (LvTARG(sv)) + vivify_defelem(sv); + if (LvTARG(sv)) { sv_setsv(LvTARG(sv), sv); + SvSETMAGIC(LvTARG(sv)); + } return 0; } int -magic_freeitervar(sv,mg) +magic_freedefelem(sv,mg) SV* sv; MAGIC* mg; { @@ -1167,24 +1184,37 @@ MAGIC* mg; } void -vivify_itervar(sv) +vivify_defelem(sv) SV* sv; { - AV* av; + MAGIC* mg; + SV* value; - if (!LvTARGLEN(sv)) + if (!LvTARGLEN(sv) || !(mg = mg_find(sv, 'y'))) return; - av = (AV*)LvTARG(sv); - if (LvTARGOFF(sv) <= AvFILL(av)) { - SV** svp = AvARRAY(av) + LvTARGOFF(sv); - LvTARG(sv) = newSVsv(*svp); - SvREFCNT_dec(*svp); - *svp = SvREFCNT_inc(LvTARG(sv)); + if (mg->mg_obj) { + HV* hv = (HV*)LvTARG(sv); + HE* he = hv_fetch_ent(hv, mg->mg_obj, TRUE, 0); + if (!he || (value = HeVAL(he)) == &sv_undef) + croak(no_helem, SvPV(mg->mg_obj, na)); } - else - LvTARG(sv) = Nullsv; - SvREFCNT_dec(av); + else { + AV* av = (AV*)LvTARG(sv); + if (LvTARGLEN(sv) < 0 && (I32)LvTARGOFF(sv) > AvFILL(av)) + LvTARG(sv) = Nullsv; /* array can't be extended */ + else { + SV** svp = av_fetch(av, LvTARGOFF(sv), TRUE); + if (!svp || (value = *svp) == &sv_undef) + croak(no_aelem, (I32)LvTARGOFF(sv)); + } + } + SvREFCNT_inc(value); + SvREFCNT_dec(LvTARG(sv)); + LvTARG(sv) = value; LvTARGLEN(sv) = 0; + SvREFCNT_dec(mg->mg_obj); + mg->mg_obj = Nullsv; + mg->mg_flags &= ~MGf_REFCOUNTED; } int @@ -389,7 +389,7 @@ pad_sv(PADOFFSET po) { if (!po) croak("panic: pad_sv po"); - DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad sv %d\n", po)); + DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad sv %lu\n", (unsigned long)po)); return curpad[po]; /* eventually we'll turn this into a macro */ } @@ -407,7 +407,7 @@ pad_free(PADOFFSET po) croak("panic: pad_free curpad"); if (!po) croak("panic: pad_free po"); - DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad free %d\n", po)); + DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad free %lu\n", (unsigned long)po)); if (curpad[po] && !SvIMMORTAL(curpad[po])) SvPADTMP_off(curpad[po]); if ((I32)po < padix) @@ -426,7 +426,7 @@ pad_swipe(PADOFFSET po) croak("panic: pad_swipe curpad"); if (!po) croak("panic: pad_swipe po"); - DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad swipe %d\n", po)); + DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad swipe %lu\n", (unsigned long)po)); SvPADTMP_off(curpad[po]); curpad[po] = NEWSV(1107,0); SvPADTMP_on(curpad[po]); @@ -950,6 +950,8 @@ I32 type; return op; switch (op->op_type) { + case OP_UNDEF: + return op; case OP_CONST: if (!(op->op_private & (OPpCONST_ARYBASE))) goto nomod; @@ -1045,7 +1047,6 @@ I32 type; croak("Can't localize a reference"); ref(cUNOP->op_first, op->op_type); /* FALL THROUGH */ - case OP_UNDEF: case OP_GV: case OP_AV2ARYLEN: case OP_SASSIGN: @@ -1086,6 +1087,9 @@ I32 type; case OP_AELEM: case OP_HELEM: ref(cBINOP->op_first, op->op_type); + if (type == OP_ENTERSUB && + !(op->op_private & (OPpLVAL_INTRO | OPpDEREF))) + op->op_private |= OPpLVAL_DEFER; modcount++; break; @@ -2510,16 +2514,20 @@ OP* other; break; case OP_SASSIGN: - if (k1->op_type == OP_READDIR || k1->op_type == OP_GLOB) + if (k1->op_type == OP_READDIR + || k1->op_type == OP_GLOB + || k1->op_type == OP_EACH) warnop = k1->op_type; break; } if (warnop) { line_t oldline = curcop->cop_line; curcop->cop_line = copline; - warn("Value of %s construct can be \"0\"; test with defined()", - op_desc[warnop]); - curcop->cop_line = oldline; + warn("Value of %s%s can be \"0\"; test with defined()", + op_desc[warnop], + ((warnop == OP_READLINE || warnop == OP_GLOB) + ? " construct" : "() operator")); + curcop->cop_line = oldline; } } @@ -2951,6 +2959,9 @@ CV* outside; if (outside) CvOUTSIDE(cv) = (CV*)SvREFCNT_inc(outside); + if (SvPOK(proto)) + sv_setpvn((SV*)cv, SvPVX(proto), SvCUR(proto)); + comppad = newAV(); comppadlist = newAV(); @@ -3079,37 +3090,33 @@ OP *block; if (op) SAVEFREEOP(op); - if (cv = (name ? GvCV(gv) : Nullcv)) { - if (GvCVGEN(gv)) { - /* just a cached method */ - SvREFCNT_dec(cv); - cv = 0; + if (!name || GvCVGEN(gv)) + cv = Nullcv; + else if (cv = GvCV(gv)) { + /* prototype mismatch? */ + char *p = proto ? SvPVx(((SVOP*)proto)->op_sv, na) : Nullch; + if ((!proto != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) { + warn("Prototype mismatch: (%s) vs (%s)", + SvPOK(cv) ? SvPVX(cv) : "none", p ? p : "none"); } - else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) { - /* already defined (or promised) */ - - SV* const_sv = cv_const_sv(cv); - char *p = proto ? SvPVx(((SVOP*)proto)->op_sv, na) : Nullch; - - if((!proto != !SvPOK(cv)) || (p && strNE(SvPV((SV*)cv,na), p))) { - warn("Prototype mismatch: (%s) vs (%s)", - SvPOK(cv) ? SvPV((SV*)cv,na) : "none", - p ? p : "none"); - } + /* already defined (or promised)? */ + if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) { + SV* const_sv; if (!block) { /* just a "sub foo;" when &foo is already defined */ SAVEFREESV(compcv); goto done; } + const_sv = cv_const_sv(cv); if (const_sv || dowarn) { line_t oldline = curcop->cop_line; curcop->cop_line = copline; warn(const_sv ? "Constant subroutine %s redefined" - : "Subroutine %s redefined",name); + : "Subroutine %s redefined", name); curcop->cop_line = oldline; } SvREFCNT_dec(cv); - cv = 0; + cv = Nullcv; } } if (cv) { /* must reuse cv if autoloaded */ @@ -3144,6 +3151,12 @@ OP *block; if (error_count) { op_free(block); block = Nullop; + if (name) { + char *s = strrchr(name, ':'); + s = s ? s+1 : name; + if (strEQ(s, "BEGIN")) + croak("BEGIN not safe after errors--compilation aborted"); + } } if (!block) { copline = NOLINE; @@ -3205,7 +3218,7 @@ OP *block; s++; else s = name; - if (strEQ(s, "BEGIN") && !error_count) { + if (strEQ(s, "BEGIN")) { I32 oldscope = scopestack_ix; ENTER; SAVESPTR(compiling.cop_filegv); @@ -3219,7 +3232,7 @@ OP *block; DEBUG_x( dump_sub(gv) ); av_push(beginav, (SV *)cv); GvCV(gv) = 0; - calllist(oldscope, beginav); + call_list(oldscope, beginav); curcop = &compiling; LEAVE; @@ -4414,6 +4427,7 @@ OP *op; } else list(o); + mod(o, OP_ENTERSUB); prev = o; o = o->op_sibling; } @@ -4520,7 +4534,8 @@ register OP* o; if (pop->op_type == OP_CONST && (op = pop->op_next) && pop->op_next->op_type == OP_AELEM && - !(pop->op_next->op_private & (OPpDEREF|OPpLVAL_INTRO)) && + !(pop->op_next->op_private & + (OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF)) && (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase) <= 255 && i >= 0) @@ -83,13 +83,16 @@ typedef U32 PADOFFSET; #define OPpREPEAT_DOLIST 64 /* List replication. */ /* Private for OP_ENTERSUB, OP_RV2?V, OP_?ELEM */ - /* (lower bits carry hints) */ -#define OPpENTERSUB_AMPER 8 /* Used & form to call. */ -#define OPpENTERSUB_DB 16 /* Debug subroutine. */ #define OPpDEREF (32|64) /* Want ref to something: */ #define OPpDEREF_AV 32 /* Want ref to AV. */ #define OPpDEREF_HV 64 /* Want ref to HV. */ #define OPpDEREF_SV (32|64) /* Want ref to SV. */ + /* OP_ENTERSUB only */ +#define OPpENTERSUB_DB 16 /* Debug subroutine. */ +#define OPpENTERSUB_AMPER 8 /* Used & form to call. */ + /* OP_?ELEM only */ +#define OPpLVAL_DEFER 16 /* Defer creation of array/hash elem */ + /* for OP_RV2?V, lower bits carry hints */ /* Private for OP_CONST */ #define OPpCONST_ENTERED 16 /* Has been entered as symbol. */ diff --git a/patchlevel.h b/patchlevel.h index 15e2194ec8..f7cc9dda21 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1,5 +1,5 @@ #define PATCHLEVEL 3 -#define SUBVERSION 93 +#define SUBVERSION 94 /* local_patches -- list of locally applied less-than-subversion patches. @@ -510,7 +510,7 @@ setuid perl scripts securely.\n"); LEAVE; curstash = defstash; if (endav) - calllist(oldscope, endav); + call_list(oldscope, endav); return STATUS_NATIVE_EXPORT; case 3: mustcatch = FALSE; @@ -685,8 +685,12 @@ setuid perl scripts securely.\n"); if (!scriptname) scriptname = argv[0]; if (e_fp) { - if (PerlIO_flush(e_fp) || PerlIO_error(e_fp) || PerlIO_close(e_fp)) + if (PerlIO_flush(e_fp) || PerlIO_error(e_fp) || PerlIO_close(e_fp)) { +#ifndef MULTIPLICITY + warn("Did you forget to compile with -DMULTIPLICITY?"); +#endif croak("Can't write to temp file for -e: %s", Strerror(errno)); + } e_fp = Nullfp; argc++,argv--; scriptname = e_tmpname; @@ -804,7 +808,7 @@ PerlInterpreter *sv_interp; LEAVE; curstash = defstash; if (endav) - calllist(oldscope, endav); + call_list(oldscope, endav); FREETMPS; #ifdef DEBUGGING_MSTATS if (getenv("PERL_DEBUG_MSTATS")) @@ -2437,7 +2441,7 @@ int addsubdirs; } void -calllist(oldscope, list) +call_list(oldscope, list) I32 oldscope; AV* list; { @@ -2481,7 +2485,7 @@ AV* list; LEAVE; curstash = defstash; if (endav) - calllist(oldscope, endav); + call_list(oldscope, endav); FREETMPS; Copy(oldtop, top_env, 1, Sigjmp_buf); curcop = &compiling; @@ -80,7 +80,7 @@ */ /* define this once if either system, instead of cluttering up the src */ -#if defined(MSDOS) || defined(atarist) +#if defined(MSDOS) || defined(atarist) || defined(WIN32) #define DOSISH 1 #endif @@ -88,6 +88,10 @@ # define STANDARD_C 1 #endif +#if defined(__cplusplus) || defined(WIN32) +# define DONT_DECLARE_STD 1 +#endif + #if defined(HASVOLATILE) || defined(STANDARD_C) # ifdef __cplusplus # define VOL // to temporarily suppress warnings @@ -433,7 +437,9 @@ # ifdef VMS char *strerror _((int,...)); # else +#ifndef DONT_DECLARE_STD char *strerror _((int)); +#endif # endif # ifndef Strerror # define Strerror strerror @@ -449,55 +455,6 @@ # endif #endif -#ifdef VMS -# define STATUS_NATIVE statusvalue_vms -# define STATUS_NATIVE_EXPORT \ - ((I32)statusvalue_vms == -1 ? 44 : statusvalue_vms) -# define STATUS_NATIVE_SET(n) \ - STMT_START { \ - statusvalue_vms = (n); \ - if ((I32)statusvalue_vms == -1) \ - statusvalue = -1; \ - else if (statusvalue_vms & STS$M_SUCCESS) \ - statusvalue = 0; \ - else if ((statusvalue_vms & STS$M_SEVERITY) == 0) \ - statusvalue = 1 << 8; \ - else \ - statusvalue = (statusvalue_vms & STS$M_SEVERITY) << 8; \ - } STMT_END -# define STATUS_POSIX statusvalue -# ifdef VMSISH_STATUS -# define STATUS_CURRENT (VMSISH_STATUS ? STATUS_NATIVE : STATUS_POSIX) -# else -# define STATUS_CURRENT STATUS_POSIX -# endif -# define STATUS_POSIX_SET(n) \ - STMT_START { \ - statusvalue = (n); \ - if (statusvalue != -1) { \ - statusvalue &= 0xFFFF; \ - statusvalue_vms = statusvalue ? 44 : 1; \ - } \ - else statusvalue_vms = -1; \ - } STMT_END -# define STATUS_ALL_SUCCESS (statusvalue = 0, statusvalue_vms = 1) -# define STATUS_ALL_FAILURE (statusvalue = 1, statusvalue_vms = 44) -#else -# define STATUS_NATIVE STATUS_POSIX -# define STATUS_NATIVE_EXPORT STATUS_POSIX -# define STATUS_NATIVE_SET STATUS_POSIX_SET -# define STATUS_POSIX statusvalue -# define STATUS_POSIX_SET(n) \ - STMT_START { \ - statusvalue = (n); \ - if (statusvalue != -1) \ - statusvalue &= 0xFFFF; \ - } STMT_END -# define STATUS_CURRENT STATUS_POSIX -# define STATUS_ALL_SUCCESS (statusvalue = 0) -# define STATUS_ALL_FAILURE (statusvalue = 1) -#endif - #ifdef I_SYS_IOCTL # ifndef _IOCTL_ # include <sys/ioctl.h> @@ -955,6 +912,55 @@ typedef I32 (*filter_t) _((int, SV *, int)); # endif #endif +#ifdef VMS +# define STATUS_NATIVE statusvalue_vms +# define STATUS_NATIVE_EXPORT \ + ((I32)statusvalue_vms == -1 ? 44 : statusvalue_vms) +# define STATUS_NATIVE_SET(n) \ + STMT_START { \ + statusvalue_vms = (n); \ + if ((I32)statusvalue_vms == -1) \ + statusvalue = -1; \ + else if (statusvalue_vms & STS$M_SUCCESS) \ + statusvalue = 0; \ + else if ((statusvalue_vms & STS$M_SEVERITY) == 0) \ + statusvalue = 1 << 8; \ + else \ + statusvalue = (statusvalue_vms & STS$M_SEVERITY) << 8; \ + } STMT_END +# define STATUS_POSIX statusvalue +# ifdef VMSISH_STATUS +# define STATUS_CURRENT (VMSISH_STATUS ? STATUS_NATIVE : STATUS_POSIX) +# else +# define STATUS_CURRENT STATUS_POSIX +# endif +# define STATUS_POSIX_SET(n) \ + STMT_START { \ + statusvalue = (n); \ + if (statusvalue != -1) { \ + statusvalue &= 0xFFFF; \ + statusvalue_vms = statusvalue ? 44 : 1; \ + } \ + else statusvalue_vms = -1; \ + } STMT_END +# define STATUS_ALL_SUCCESS (statusvalue = 0, statusvalue_vms = 1) +# define STATUS_ALL_FAILURE (statusvalue = 1, statusvalue_vms = 44) +#else +# define STATUS_NATIVE STATUS_POSIX +# define STATUS_NATIVE_EXPORT STATUS_POSIX +# define STATUS_NATIVE_SET STATUS_POSIX_SET +# define STATUS_POSIX statusvalue +# define STATUS_POSIX_SET(n) \ + STMT_START { \ + statusvalue = (n); \ + if (statusvalue != -1) \ + statusvalue &= 0xFFFF; \ + } STMT_END +# define STATUS_CURRENT STATUS_POSIX +# define STATUS_ALL_SUCCESS (statusvalue = 0) +# define STATUS_ALL_FAILURE (statusvalue = 1) +#endif + /* Some unistd.h's give a prototype for pause() even though HAS_PAUSE ends up undefined. This causes the #define below to be rejected by the compmiler. Sigh. @@ -1178,7 +1184,7 @@ struct ufuncs { }; /* Fix these up for __STDC__ */ -#ifndef __cplusplus +#ifndef DONT_DECLARE_STD char *mktemp _((char*)); double atof _((const char*)); #endif @@ -1217,10 +1223,12 @@ char *crypt (); /* Maybe more hosts will need the unprototyped version */ #else char *crypt _((const char*, const char*)); #endif +#ifndef DONT_DECLARE_STD #ifndef getenv char *getenv _((const char*)); #endif Off_t lseek _((int,Off_t,int)); +#endif char *getlogin _((void)); #endif @@ -1278,7 +1286,9 @@ typedef Sighandler_t Sigsave_t; EXT PerlInterpreter * curinterp; /* currently running interpreter */ /* VMS doesn't use environ array and NeXT has problems with crt0.o globals */ #if !defined(VMS) && !(defined(NeXT) && defined(__DYNAMIC__)) +#ifndef DONT_DECLARE_STD extern char ** environ; /* environment variables supplied via exec */ +#endif #else # if defined(NeXT) && defined(__DYNAMIC__) @@ -1957,8 +1967,8 @@ EXT MGVTBL vtbl_fm = {0, magic_setfm, EXT MGVTBL vtbl_uvar = {magic_getuvar, magic_setuvar, 0, 0, 0}; -EXT MGVTBL vtbl_itervar = {magic_getitervar,magic_setitervar, - 0, 0, magic_freeitervar}; +EXT MGVTBL vtbl_defelem = {magic_getdefelem,magic_setdefelem, + 0, 0, magic_freedefelem}; #ifdef USE_LOCALE_COLLATE EXT MGVTBL vtbl_collxfrm = {0, @@ -1996,7 +2006,7 @@ EXT MGVTBL vtbl_pos; EXT MGVTBL vtbl_bm; EXT MGVTBL vtbl_fm; EXT MGVTBL vtbl_uvar; -EXT MGVTBL vtbl_itervar; +EXT MGVTBL vtbl_defelem; #ifdef USE_LOCALE_COLLATE EXT MGVTBL vtbl_collxfrm; diff --git a/plan9/buildinfo b/plan9/buildinfo index 97d00f43be..49489adae9 100644 --- a/plan9/buildinfo +++ b/plan9/buildinfo @@ -1 +1 @@ -p9pvers = 5.003_93 +p9pvers = 5.003_94 diff --git a/pod/Makefile b/pod/Makefile index cf1e7a49d5..0ec08f992a 100644 --- a/pod/Makefile +++ b/pod/Makefile @@ -38,6 +38,16 @@ POD = \ perlxstut.pod \ perlguts.pod \ perlcall.pod \ + perlfaq.pod \ + perlfaq1.pod \ + perlfaq2.pod \ + perlfaq3.pod \ + perlfaq4.pod \ + perlfaq5.pod \ + perlfaq6.pod \ + perlfaq7.pod \ + perlfaq8.pod \ + perlfaq9.pod \ perltoc.pod MAN = \ @@ -75,6 +85,16 @@ MAN = \ perlxstut.man \ perlguts.man \ perlcall.man \ + perlfaq.man \ + perlfaq1.man \ + perlfaq2.man \ + perlfaq3.man \ + perlfaq4.man \ + perlfaq5.man \ + perlfaq6.man \ + perlfaq7.man \ + perlfaq8.man \ + perlfaq9.man \ perltoc.man HTML = \ @@ -112,6 +132,16 @@ HTML = \ perlxstut.html \ perlguts.html \ perlcall.html \ + perlfaq.html \ + perlfaq1.html \ + perlfaq2.html \ + perlfaq3.html \ + perlfaq4.html \ + perlfaq5.html \ + perlfaq6.html \ + perlfaq7.html \ + perlfaq8.html \ + perlfaq9.html \ perltoc.html TEX = \ @@ -149,6 +179,16 @@ TEX = \ perlxstut.tex \ perlguts.tex \ perlcall.tex \ + perlfaq.tex \ + perlfaq1.tex \ + perlfaq2.tex \ + perlfaq3.tex \ + perlfaq4.tex \ + perlfaq5.tex \ + perlfaq6.tex \ + perlfaq7.tex \ + perlfaq8.tex \ + perlfaq9.tex \ perltoc.tex man: pod2man $(MAN) diff --git a/pod/buildtoc b/pod/buildtoc index e8557c764f..31712e290c 100644 --- a/pod/buildtoc +++ b/pod/buildtoc @@ -5,11 +5,13 @@ use Text::Wrap; sub output ($); @pods = qw( - perl perldelta perldata perlsyn perlop perlre perlrun perlfunc - perlvar perlsub perlmod perlform perllocale perlref perldsc - perllol perltoot perlobj perltie perlbot perlipc perldebug - perldiag perlsec perltrap perlstyle perlpod perlbook perlembed - perlapio perlxs perlxstut perlguts perlcall + perl perlfaq perlfaq1 perlfaq2 perlfaq3 perlfaq4 perlfaq5 + perlfaq6 perlfaq7 perlfaq8 perlfaq9 perldelta perldata + perlsyn perlop perlre perlrun perlfunc perlvar perlsub + perlmod perlform perllocale perlref perldsc perllol perltoot + perlobj perltie perlbot perlipc perldebug perldiag perlsec + perltrap perlstyle perlpod perlbook perlembed perlapio perlxs + perlxstut perlguts perlcall ); for (@pods) { s/$/.pod/ } diff --git a/pod/perl.pod b/pod/perl.pod index f3ddc3c2c7..2c1dde2039 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -20,6 +20,7 @@ of sections: perl Perl overview (this section) perldelta Perl changes since previous version + perlfaq Perl frequently asked questions perldata Perl data structures perlsyn Perl syntax @@ -219,7 +220,7 @@ optimized C code. =back -Ok, that's I<definitely> enough hype. +Okay, that's I<definitely> enough hype. =head1 ENVIRONMENT diff --git a/pod/perlcall.pod b/pod/perlcall.pod index 9a4a886a59..1ff71fc581 100644 --- a/pod/perlcall.pod +++ b/pod/perlcall.pod @@ -565,7 +565,7 @@ Next, we come to XPUSHs. This is where the parameters actually get pushed onto the stack. In this case we are pushing a string and an integer. -See the L<perlguts/"XSUB's and the Argument Stack"> for details +See the L<perlguts/"XSUBs and the Argument Stack"> for details on how the XPUSH macros work. =item 6. @@ -668,7 +668,7 @@ an alternative to using these macros. The purpose of the macro C<SPAGAIN> is to refresh the local copy of the stack pointer. This is necessary because it is possible that the memory -allocated to the Perl stack has been re-allocated whilst in the +allocated to the Perl stack has been reallocated whilst in the I<perl_call_pv> call. If you are making use of the Perl stack pointer in your code you must diff --git a/pod/perldata.pod b/pod/perldata.pod index 1878f4a5fa..f0837b3854 100644 --- a/pod/perldata.pod +++ b/pod/perldata.pod @@ -247,6 +247,11 @@ The usual Unix backslash rules apply for making characters such as newline, tab, etc., as well as some more exotic forms. See L<perlop/Quote and Quotelike Operators> for a list. +Octal or hex representations in string literals (e.g. '0xffff') are not +automatically converted to their integer representation. The hex() and +oct() functions make these conversions for you. See L<perlfunc/hex> and +L<perlfunc/oct> for more details. + You can also embed newlines directly in your strings, i.e., they can end on a different line than they begin. This is nice, but if you forget your trailing quote, the error will not be reported until Perl finds @@ -279,16 +284,19 @@ single-quoted string must be separated from a preceding word by a space, because single quote is a valid (though deprecated) character in a variable name (see L<perlmod/Packages>). -Two special literals are __LINE__ and __FILE__, which represent the -current line number and filename at that point in your program. They -may be used only as separate tokens; they will not be interpolated into -strings. In addition, the token __END__ may be used to indicate the -logical end of the script before the actual end of file. Any following -text is ignored, but may be read via the DATA filehandle. (The DATA -filehandle may read data from only the main script, but not from any -required file or evaluated string.) The two control characters ^D and -^Z are synonyms for __END__ (or __DATA__ in a module; see L<SelfLoader> for -details on __DATA__). +Three special literals are __FILE__, __LINE__, and __PACKAGE__, which +represent the current filename, line number, and package name at that +point in your program. They may be used only as separate tokens; they +will not be interpolated into strings. If there is no current package +(due to a C<package;> directive), __PACKAGE__ is the undefined value. + +The tokens __END__ and __DATA__ may be used to indicate the logical end +of the script before the actual end of file. Any following text is +ignored, but may be read via a DATA filehandle: main::DATA for __END__, +or PACKNAME::DATA (where PACKNAME is the current package) for __DATA__. +The two control characters ^D and ^Z are synonyms for __END__ (or +__DATA__ in a module). See L<SelfLoader> for more description of +__DATA__, and an example of its use. A word that has no other interpretation in the grammar will be treated as if it were a quoted string. These are known as @@ -440,6 +448,11 @@ put the list in parentheses to avoid ambiguity. Examples: # A "reverse comma operator". return (pop(@foo),pop(@foo))[0]; +You may assign to C<undef> in a list. This is useful for throwing +away some of the return values of a function: + + ($dev, $ino, undef, undef, $uid, $gid) = stat($file); + Lists may be assigned to if and only if each element of the list is legal to assign to: diff --git a/pod/perldebug.pod b/pod/perldebug.pod index a682de1ade..61263b6664 100644 --- a/pod/perldebug.pod +++ b/pod/perldebug.pod @@ -11,7 +11,7 @@ First of all, have you tried using the B<-w> switch? If you invoke Perl with the B<-d> switch, your script runs under the Perl source debugger. This works like an interactive Perl environment, prompting for debugger commands that let you examine -source code, set breakpoints, get stack back-traces, change the values of +source code, set breakpoints, get stack backtraces, change the values of variables, etc. This is so convenient that you often fire up the debugger all by itself just to test out Perl constructs interactively to see what they do. For example: @@ -102,7 +102,7 @@ Same as C<V currentpackage [vars]>. =item T -Produce a stack back-trace. See below for details on its output. +Produce a stack backtrace. See below for details on its output. =item s [expr] @@ -620,7 +620,7 @@ commands typed into the debugger. =item Stack backtrace -Here's an example of what a stack back-trace via C<T> command might +Here's an example of what a stack backtrace via C<T> command might look like: $ = main::infested called from file `Ambulation.pm' line 10 @@ -1056,4 +1056,4 @@ You cannot get the stack frame information or otherwise debug functions that were not compiled by Perl, such as C or C++ extensions. If you alter your @_ arguments in a subroutine (such as with B<shift> -or B<pop>, the stack back-trace will not show the original values. +or B<pop>, the stack backtrace will not show the original values. diff --git a/pod/perldelta.pod b/pod/perldelta.pod index cf6036ff02..958bee38ed 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -27,7 +27,7 @@ might have symbol conflicts if you embed Perl in another application, just as in the 5.003 release. By default, binary compatibility is preserved at the expense of symbol table pollution. -=head2 Subroutine Parameters Are Not Autovivified +=head2 No Autovivification of Subroutine Parameters In Perl versions 5.002 and 5.003, array and hash elements used as subroutine parameters were "autovivified"; that is, they were brought @@ -47,6 +47,13 @@ fixed. As a result, the string "$$0" is no longer equivalent to C<$$."0">, but rather to C<${$0}>. To get the old behavior, change "$$" followed by a digit to "${$}". +=head2 No Resetting of $. on Implicit Close + +The documentation for Perl 5.0 has always stated that C<$.> is I<not> +reset when an already-open file handle is re-opened with no intervening +call to C<close>. Due to a bug, perl versions 5.000 through 5.0003 +I<did> reset C<$.> under that circumstance; Perl 5.004 does not. + =head2 Changes to Tainting Checks A bug in previous versions may have failed to detect some insecure @@ -64,6 +71,15 @@ application of opcode masks. The revised Safe module has a new API and is implemented using the new Opcode module. Please read the new Opcode and Safe documentation. +=head2 Embedding Improvements + +In older versions of Perl it was not possible to create more than one +Perl interpreter instance inside a single process without leaking like a +sieve and/or crashing. The bugs that caused this behavior have all been +fixed. However, you still must take care when embedding Perl in a C +program. See the updated perlembed manpage for tips on how to manage +your interpreters. + =head2 Internal Change: FileHandle Class Based on IO::* Classes File handles are now stored internally as type IO::Handle. The @@ -124,8 +140,8 @@ This now works. (e.g. C<delete @ENV{'PATH', 'MANPATH'}>) =item flock -is now supported on more platforms, and prefers fcntl -to lockf when emulating. +is now supported on more platforms, prefers fcntl to lockf when +emulating, and always flushes before (un)locking. =item printf and sprintf @@ -283,7 +299,7 @@ are inherited by all other classes: =item isa(CLASS) -C<isa> returns I<true> if its object is blessed into a sub-class of C<CLASS> +C<isa> returns I<true> if its object is blessed into a subclass of C<CLASS> C<isa> is also exportable and can be called as a sub with two arguments. This allows the ability to check what a reference points to. Example: @@ -459,7 +475,7 @@ a fixed value are now inlined (e.g. C<sub PI () { 3.14159 }>). Each unique hash key is only allocated once, no matter how many hashes have an entry with that key. So even if you have 100 copies of the -same hash, the hash keys never have to be re-allocated. +same hash, the hash keys never have to be reallocated. =head1 Pragmata diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 24b16128dd..e0a23b0162 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -16,8 +16,8 @@ desperation): (A) An alien error message (not generated by Perl). Optional warnings are enabled by using the B<-w> switch. Warnings may -be captured by setting C<$SIG{__WARN__}> to a reference to a routine that will be -called on each warning instead of printing it. See L<perlvar>. +be captured by setting C<$SIG{__WARN__}> to a reference to a routine that +will be called on each warning instead of printing it. See L<perlvar>. Trappable errors may be trapped using the eval operator. See L<perlfunc/eval>. @@ -339,6 +339,14 @@ Perl yourself. (F) An untrapped exception was raised while executing a BEGIN subroutine. Compilation stops immediately and the interpreter is exited. +=item BEGIN not safe after errors--compilation aborted + +(F) Perl found a C<BEGIN {}> subroutine (or a C<use> directive, which +implies a C<BEGIN {}>) after one or more compilation errors had +already occurred. Since the intended environment for the C<BEGIN {}> +could not be guaranteed (due to the errors), and since subsequent code +likely depends on its correct operation, Perl just gave up. + =item bind() on closed fd (W) You tried to do a bind on a closed socket. Did you forget to check @@ -646,7 +654,7 @@ buffer. =item Can't open %s: %s -(S) An inplace edit couldn't open the original file for the indicated reason. +(S) An in-place edit couldn't open the original file for the indicated reason. Usually this is because you don't have read permission for the file. =item Can't open bidirectional pipe @@ -1066,8 +1074,8 @@ the line, and you really meant a "less than". =item Global symbol "%s" requires explicit package name -(F) You've said "use strict vars", which indicates that all variables must -either be lexically scoped (using "my"), or explicitly qualified to +(F) You've said "use strict vars", which indicates that all variables +must either be lexically scoped (using "my"), or explicitly qualified to say which package the global variable is in (using "::"). =item goto must have label @@ -1099,8 +1107,20 @@ or it may indicate that a logical name table has been corrupted. (F) A carriage return character was found in the input. This is an error, and not a warning, because carriage return characters can break -here documents (e.g. C<print E<lt>E<lt>EOF;>). Note that Perl always -opens scripts in text mode, so this error should only occur in C<eval>. +here documents (e.g., C<print E<lt>E<lt>EOF;>). + +Under UNIX, this error is usually caused by executing Perl code -- +either the main program, a module, or an eval'd string -- that was +transferred over a network connection from a non-UNIX system without +properly converting the text file format. + +Under systems that use something other than '\n' to delimit lines of +text, this error can also be caused by reading Perl code from a file +handle that is in binary mode (as set by the C<binmode> operator). + +In either case, the Perl code in question will probably need to be +converted with something like C<s/\x0D\x0A?/\n/g> before it can be +executed. =item Illegal division by zero @@ -1301,10 +1321,10 @@ like C<$foo[1][2][3]>, as in C. =item Name "%s::%s" used only once: possible typo -(W) Typographical errors often show up as unique variable names. If you -had a good reason for having a unique name, then just mention it -again somehow to suppress the message (the C<use vars> pragma is -provided for just this purpose). +(W) Typographical errors often show up as unique variable names. +If you had a good reason for having a unique name, then just mention +it again somehow to suppress the message. The C<use vars> pragma is +provided for just this purpose. =item Negative length @@ -1796,7 +1816,7 @@ old-fashioned way, with quotes and commas: =item Possible attempt to separate words with commas (W) qw() lists contain items separated by whitespace; therefore commas -aren't needed to separate the items. (You may have used different +aren't needed to separate the items. (You may have used different delimiters than the parentheses shown here; braces are also frequently used.) @@ -1826,9 +1846,10 @@ is now misinterpreted as open(FOO || die); -because of the strict regularization of Perl 5's grammar into unary and -list operators. (The old open was a little of both.) You must put -parentheses around the filehandle, or use the new "or" operator instead of "||". +because of the strict regularization of Perl 5's grammar into unary +and list operators. (The old open was a little of both.) You must +put parentheses around the filehandle, or use the new "or" operator +instead of "||". =item print on closed filehandle %s @@ -2104,7 +2125,7 @@ may break this. (P) The substitution was looping infinitely. (Obviously, a substitution shouldn't iterate more times than there are characters of -input, which is what happened.) See the discussion of substitution in +input, which is what happened.) See the discussion of substitution in L<perlop/"Quote and Quote-like Operators">. =item Substitution pattern not terminated @@ -2490,13 +2511,13 @@ L<perlref> for more on this. (W) A copy of the object returned from C<tie> (or C<tied>) was still valid when C<untie> was called. -=item Value of %s construct can be "0"; test with defined() +=item Value of %s can be "0"; test with defined() -(W) In a conditional expression, you used <HANDLE>, <*> (glob), or -C<readdir> as a boolean value. Each of these constructs can return a -value of "0"; that would make the conditional expression false, which -is probably not what you intended. When using these constructs in -conditional expressions, test their values with the C<defined> operator. +(W) In a conditional expression, you used <HANDLE>, <*> (glob), C<each()>, +or C<readdir()> as a boolean value. Each of these constructs can return a +value of "0"; that would make the conditional expression false, which is +probably not what you intended. When using these constructs in conditional +expressions, test their values with the C<defined> operator. =item Variable "%s" is not imported%s diff --git a/pod/perldsc.pod b/pod/perldsc.pod index fad539c0ec..61c45b970c 100644 --- a/pod/perldsc.pod +++ b/pod/perldsc.pod @@ -324,7 +324,7 @@ example, given the assignment to $LoL above, here's the debugger output: 2 'elroy' 3 'judy' -There's also a lower-case B<x> command which is nearly the same. +There's also a lowercase B<x> command which is nearly the same. =head1 CODE EXAMPLES diff --git a/pod/perlfaq.pod b/pod/perlfaq.pod new file mode 100644 index 0000000000..8db316c24b --- /dev/null +++ b/pod/perlfaq.pod @@ -0,0 +1,138 @@ +=head1 NAME + +perlfaq - frequently asked questions about Perl ($Date: 1997/03/17 22:17:56 $) + +=head1 DESCRIPTION + +This document is structured into the following sections: + +=over + +=item perlfaq: Structural overview of the FAQ. + +This document. + +=item L<perlfaq1>: General Questions About Perl + +Very general, high-level information about Perl. + +=item L<perlfaq2>: Obtaining and Learning about Perl + +Where to find source and documentation to Perl, support and training, +and related matters. + +=item L<perlfaq3>: Programming Tools + +Programmer tools and programming support. + +=item L<perlfaq4>: Data Manipulation + +Manipulating numbers, dates, strings, arrays, hashes, and +miscellaneous data issues. + +=item L<perlfaq5>: Files and Formats + +I/O and the "f" issues: filehandles, flushing, formats and footers. + +=item L<perlfaq6>: Regexps + +Pattern matching and regular expressions. + +=item L<perlfaq7>: General Perl Language Issues + +General Perl language issues that don't clearly fit into any of the +other sections. + +=item L<perlfaq8>: System Interaction + +Interprocess communication (IPC), control over the user-interface +(keyboard, screen and pointing devices). + +=item L<perlfaq9>: Networking + +Networking, the Internet, and a few on the web. + +=back + +=head2 Where to get this document + +This document is posted regularly to comp.lang.perl.announce and +several other related newsgroups. It is available in a variety of +formats from CPAN in the /CPAN/doc/FAQs/FAQ/ directory, or on the web +at http://www.perl.com/perl/faq/ . + +=head2 How to contribute to this document + +You may mail corrections, additions, and suggestions to +perlfaq-suggestions@perl.com. Mail sent to the old perlfaq alias will +merely cause the FAQ to be sent to you. + +=head2 What will happen if you mail your Perl programming problems to the authors + +Your questions will probably go unread, unless they're suggestions of +new questions to add to the FAQ, in which case they should have gone +to the perlfaq-suggestions@perl.com instead. + +You should have read section 2 of this faq. There you would have +learned that comp.lang.perl.misc is the appropriate place to go for +free advice. If your question is really important and you require a +prompt and correct answer, you should hire a consultant. + +=head1 Credits + +When I first began the Perl FAQ in the late 80s, I never realized it +would have grown to over a hundred pages, nor that Perl would ever become +so popular and widespread. This document could not have been written +without the tremendous help provided by Larry Wall and the rest of the +Perl Porters. + +=head1 Author and Copyright Information + +Copyright (c) 1997 Tom Christiansen and Nathan Torkington. +All rights reserved. + +=head2 Non-commercial Reproduction + +Permission is granted to distribute this document, in part or in full, +via electronic means or printed copy providing that (1) that all credits +and copyright notices be retained, (2) that no charges beyond reproduction +be involved, and (3) that a reasonable attempt be made to use the most +current version available. + +Furthermore, you may include this document in any distribution of the +full Perl source or binaries, in its verbatim documentation, or on a +complete dump of the CPAN archive, providing that the three stipulations +given above continue to be met. + +=head2 Commercial Reproduction + +Requests for all other distribution rights, including the incorporation +in part or in full of this text or its code into commercial products +such as but not limited to books, magazine articles, or CD-ROMs, must +be made to perlfaq-legal@perl.com. Any commercial use of any portion +of this document without prior written authorization by its authors +will be subject to appropriate action. + +=head2 Disclaimer + +This information is offered in good faith and in the hope that it may +be of use, but is not guaranteed to be correct, up to date, or suitable +for any particular purpose whatsoever. The authors accept no liability +in respect of this information or its use. + +=head1 Changes + +=over 4 + +=item 17/March/97 Version + +Various typos fixed throughout. + +Added new question on Perl BNF on L<perlfaq7>. + +=item Initial Release: 11/March/97 + +This is the initial release of version 3 of the FAQ; consequently there +have been no changes since its initial release. + +=back diff --git a/pod/perlfaq1.pod b/pod/perlfaq1.pod new file mode 100644 index 0000000000..2510a4b1f1 --- /dev/null +++ b/pod/perlfaq1.pod @@ -0,0 +1,248 @@ +=head1 NAME + +perlfaq1 - General Questions About Perl ($Revision: 1.10 $) + +=head1 DESCRIPTION + +This section of the FAQ answers very general, high-level questions +about Perl. + +=head2 What is Perl? + +Perl is a high-level programming language with an eclectic heritage +written by Larry Wall and a cast of thousands. It derives from the +ubiquitous C programming language and to a lesser extent from sed, +awk, the Unix shell, and at least a dozen other tools and languages. +Perl's process, file, and text manipulation facilities make it +particularly well-suited for tasks involving quick prototyping, system +utilities, software tools, system management tasks, database access, +graphical programming, networking, and world wide web programming. +These strengths make it especially popular with system administrators +and CGI script authors, but mathematicians, geneticists, journalists, +and even managers also use Perl. Maybe you should, too. + +=head2 Who supports Perl? Who develops it? Why is it free? + +The original culture of the pre-populist Internet and the deeply-held +beliefs of Perl's author, Larry Wall, gave rise to the free and open +distribution policy of perl. Perl is supported by its users. The +core, the standard Perl library, the optional modules, and the +documentation you're reading now were all written by volunteers. See +the personal note at the end of the README file in the perl source +distribution for more details. + +In particular, the core development team (known as the Perl +Porters) are a rag-tag band of highly altruistic individuals +committed to producing better software for free than you +could hope to purchase for money. You may snoop on pending +developments via news://genetics.upenn.edu/perl.porters-gw/ and +http://www.frii.com/~gnat/perl/porters/summary.html. + +While the GNU project includes Perl in its distributions, there's no +such thing as "GNU Perl". Perl is not produced nor maintained by the +Free Software Foundation. Perl's licensing terms are also more open +than GNU software's tend to be. + +You can get commercial support of Perl if you wish, although for most +users the informal support will more than suffice. See the answer to +"Where can I buy a commercial version of perl?" for more information. + +=head2 Which version of Perl should I use? + +You should definitely use version 5. Version 4 is old, limited, and +no longer maintained. Its last patch (4.036) was in 1992. The last +production release was 5.003, and the current experimental release for +those at the bleeding edge (as of 27/03/97) is 5.003_92, considered a beta +for production release 5.004, which will probably be out by the time +you read this. Further references to the Perl language in this document +refer to the current production release unless otherwise specified. + +=head2 What are perl4 and perl5? + +Perl4 and perl5 are informal names for different versions of the Perl +programming language. It's easier to say "perl5" than it is to say +"the 5(.004) release of Perl", but some people have interpreted this +to mean there's a language called "perl5", which isn't the case. +Perl5 is merely the popular name for the fifth major release (October 1994), +while perl4 was the fourth major release (March 1991). There was also a +perl1 (in January 1988), a perl2 (June 1988), and a perl3 (October 1989). + +The 5.0 release is, essentially, a complete rewrite of the perl source +code from the ground up. It has been modularized, object-oriented, +tweaked, trimmed, and optimized until it almost doesn't look like the +old code. However, the interface is mostly the same, and compatibility +with previous releases is very high. + +To avoid the "what language is perl5?" confusion, some people prefer to +simply use "perl" to refer to the latest version of perl and avoid using +"perl5" altogether. It's not really that big a deal, though. + +=head2 How stable is Perl? + +Production releases, which incorporate bug fixes and new functionality, +are widely tested before release. Since the 5.000 release, we have +averaged only about one production release per year. + +Larry and the Perl development team occasionally make changes to the +internal core of the language, but all possible efforts are made toward +backward compatibility. While not quite all perl4 scripts run flawlessly +under perl5, an update to perl should nearly never invalidate a program +written for an earlier version of perl (barring accidental bug fixes +and the rare new keyword). + +=head2 Is Perl difficult to learn? + +Perl is easy to start learning -- and easy to keep learning. It looks +like most programming languages you're likely to have had experience +with, so if you've ever written an C program, an awk script, a shell +script, or even an Excel macro, you're already part way there. + +Most tasks only require a small subset of the Perl language. One of +the guiding mottos for Perl development is "there's more than one way +to do it" (TMTOWTDI, sometimes pronounced "tim toady"). Perl's +learning curve is therefore shallow (easy to learn) and long (there's +a whole lot you can do if you really want). + +Finally, Perl is (frequently) an interpreted language. This means +that you can write your programs and test them without an intermediate +compilation step, allowing you to experiment and test/debug quickly +and easily. This ease of experimentation flattens the learning curve +even more. + +Things that make Perl easier to learn: Unix experience, almost any kind +of programming experience, an understanding of regular expressions, and +the ability to understand other people's code. If there's something you +need to do, then it's probably already been done, and a working example is +usually available for free. Don't forget the new perl modules, either. +They're discussed in Part 3 of this FAQ, along with the CPAN, which is +discussed in Part 2. + +=head2 How does Perl compare with other languages like Java, Python, REXX, Scheme, or Tcl? + +Favorably in some areas, unfavorably in others. Precisely which areas +are good and bad is often a personal choice, so asking this question +on Usenet runs a strong risk of starting an unproductive Holy War. + +Probably the best thing to do is try to write equivalent code to do a +set of tasks. These languages have their own newsgroups in which you +can learn about (but hopefully not argue about) them. + +=head2 Can I do [task] in Perl? + +Perl is flexible and extensible enough for you to use on almost any +task, from one-line file-processing tasks to complex systems. For +many people, Perl serves as a great replacement for shell scripting. +For others, it serves as a convenient, high-level replacement for most +of what they'd program in low-level languages like C or C++. It's +ultimately up to you (and possibly your management ...) which tasks +you'll use Perl for and which you won't. + +If you have a library that provides an API, you can make any component +of it available as just another Perl function or variable using a Perl +extension written in C or C++ and dynamically linked into your main +perl interpreter. You can also go the other direction, and write your +main program in C or C++, and then link in some Perl code on the fly, +to create a powerful application. + +That said, there will always be small, focused, special-purpose +languages dedicated to a specific problem domain that are simply more +convenient for certain kinds of problems. Perl tries to be all things +to all people, but nothing special to anyone. Examples of specialized +languages that come to mind include prolog and matlab. + +=head2 When shouldn't I program in Perl? + +When your manager forbids it -- but do consider replacing them :-). + +Actually, one good reason is when you already have an existing +application written in another language that's all done (and done +well), or you have an application language specifically designed for a +certain task (e.g. prolog, make). + +For various reasons, Perl is probably not well-suited for real-time +embedded systems, low-level operating systems development work like +device drivers or context-switching code, complex multithreaded +shared-memory applications, or extremely large applications. You'll +notice that perl is not itself written in Perl. + +The new native-code compiler for Perl may reduce the limitations given +in the previous statement to some degree, but understand that Perl +remains fundamentally a dynamically typed language, and not a +statically typed one. You certainly won't be chastized if you don't +trust nuclear-plant or brain-surgery monitoring code to it. And +Larry will sleep easier, too -- Wall Street programs not +withstanding. :-) + +=head2 What's the difference between "perl" and "Perl"? + +One bit. Oh, you weren't talking ASCII? :-) Larry now uses "Perl" to +signify the language proper and "perl" the implementation of it, +i.e. the current interpreter. Hence Tom's quip that "Nothing but perl +can parse Perl." You may or may not choose to follow this usage. For +example, parallelism means "awk and perl" and "Python and Perl" look +ok, while "awk and Perl" and "Python and perl" do not. + +=head2 Is it a Perl program or a Perl script? + +It doesn't matter. + +In "standard terminology" a I<program> has been compiled to physical +machine code once, and can then be be run multiple times, whereas a +I<script> must be translated by a program each time it's used. Perl +programs, however, are usually neither strictly compiled nor strictly +interpreted. They can be compiled to a bytecode form (something of a Perl +virtual machine) or to completely different languages, like C or assembly +language. You can't tell just by looking whether the source is destined +for a pure interpreter, a parse-tree interpreter, a byte-code interpreter, +or a native-code compiler, so it's hard to give a definitive answer here. + +=head2 What is a JAPH? + +These are the "just another perl hacker" signatures that some people +sign their postings with. About 100 of the of the earlier ones are +available from http://www.perl.com/CPAN/misc/japh . + +=head2 Where can I get a list of Larry Wall witticisms? + +Over a hundred quips by Larry, from postings of his or source code, +can be found at http://www.perl.com/CPAN/misc/lwall-quotes . + +=head2 How can I convince my sysadmin/supervisor/employees to use version (5/5.004/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 +might try to appeal to their self-interest. If programmers can be +more productive using and utilizing Perl constructs, functionality, +simplicity, and power, then the typical manager/supervisor/employee +may be persuaded. Regarding using Perl in general, it's also +sometimes helpful to point out that delivery times may be reduced +using Perl, as compared to other languages. + +If you have a project which has a bottleneck, especially in terms of +translation, or testing, Perl almost certainly will provide a viable, +and quick solution. In conjunction with any persuasion effort, you +should not fail to point out that Perl is used, quite extensively, and +with extremely reliable and valuable results, at many large computer +software and/or hardware companies throughout the world. In fact, +many Unix vendors now ship Perl by default, and support is usually +just a news-posting away, if you can't find the answer in the +I<comprehensive> documentation, including this FAQ. + +If you face reluctance to upgrading from an older version of perl, +then point out that version 4 is utterly unmaintained and unsupported +by the Perl Development Team. Another big sell for Perl5 is the large +number of modules and extensions which greatly reduce development time +for any given task. Also mention that the difference between version +4 and version 5 of Perl is like the difference between awk and C++. +(Well, ok, maybe 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. That probably means running the 5.004 release, +although 5.003 isn't that bad (it's just one year and one release +behind). Several important bugs were fixed from the 5.000 through +5.002 versions, though, so try upgrading past them if possible. + +=head1 AUTHOR AND COPYRIGHT + +Copyright (c) 1997 Tom Christiansen and Nathan Torkington. +All rights reserved. See L<perlfaq> for distribution information. diff --git a/pod/perlfaq2.pod b/pod/perlfaq2.pod new file mode 100644 index 0000000000..b4c3e9f1dc --- /dev/null +++ b/pod/perlfaq2.pod @@ -0,0 +1,419 @@ +=head1 NAME + +perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.13 $) + +=head1 DESCRIPTION + +This section of the FAQ answers questions about where to find +source and documentation for Perl, support and training, and +related matters. + +=head2 What machines support Perl? Where do I get it? + +The standard release of Perl (the one maintained by the perl +development team) is distributed only in source code form. You can +find this at http://www.perl.com/CPAN/src/latest.tar.gz, which is a +gzipped archive in POSIX tar format. This source builds with no +porting whatsoever on most Unix systems (Perl's native environment), +as well as Plan 9, VMS, QNX, OS/2, and the Amiga. + +Although it's rumored that the (imminent) 5.004 release may build +on Windows NT, this is yet to be proven. Binary distributions +for 32-bit Microsoft systems and for Apple systems can be found +http://www.perl.com/CPAN/ports/ directory. Because these are not part of +the standard distribution, they may and in fact do differ from the base +Perl port in a variety of ways. You'll have to check their respective +release notes to see just what the differences are. These differences +can be either positive (e.g. extensions for the features of the particular +platform that are not supported in the source release of perl) or negative +(e.g. might be based upon a less current source release of perl). + +A useful FAQ for Win32 Perl users is +http://www.endcontsw.com/people/evangelo/Perl_for_Win32_FAQ.html + +=head2 How can I get a binary version of Perl? + +If you don't have a C compiler because for whatever reasons your +vendor did not include one with your system, the best thing to do is +grab a binary version of gcc from the net and use that to compile perl +with. CPAN only has binaries for systems that are terribly hard to +get free compilers for, not for Unix systems. + +=head2 I copied the Perl binary from one machine to another, but scripts don't work. + +That's probably because you forgot libraries, or library paths differ. +You really should build the whole distribution on the machine it will +eventually live on, and then type C<make install>. Most other +approaches are doomed to failure. + +One simple way to check that things are in the right place is to print out +the hard-coded @INC which perl is looking for. + + perl -e 'print join("\n",@INC)' + +If this command lists any paths which don't exist on your system, then you +may need to move the appropriate libraries to these locations, or create +symlinks, aliases, or shortcuts appropriately. + +=head2 I grabbed the sources and tried to compile but gdbm/dynamic loading/malloc/linking/... failed. How do I make it work? + +Read the F<INSTALL> file, which is part of the source distribution. +It describes in detail how to cope with most idiosyncracies that the +Configure script can't work around for any given system or +architecture. + +=head2 What modules and extensions are available for Perl? What is CPAN? What does CPAN/src/... mean? + +CPAN stands for Comprehensive Perl Archive Network, a huge archive +replicated on dozens of machines all over the world. CPAN contains +source code, non-native ports, documentation, scripts, and many +third-party modules and extensions, designed for everything from +commercial database interfaces to keyboard/screen control to web +walking and CGI scripts. The master machine for CPAN is +ftp://ftp.funet.fi/pub/languages/perl/CPAN/, but you can use the +address http://www.perl.com/CPAN/CPAN.html to fetch a copy from a +"site near you". See http://www.perl.com/CPAN (without a slash at the +end) for how this process works. + +CPAN/path/... is a naming convention for files available on CPAN +sites. CPAN indicates the base directory of a CPAN mirror, and the +rest of the path is the path from that directory to the file. For +instance, if you're using ftp://ftp.funet.fi/pub/languages/perl/CPAN +as your CPAN site, the file CPAN/misc/japh file is downloadable as +ftp://ftp.funet.fi/pub/languages/perl/CPAN/misc/japh . + +Considering that there are hundreds of existing modules in the +archive, one probably exists to do nearly anything you can think of. +Current categories under CPAN/modules/by-category/ include perl core +modules; development support; operating system interfaces; networking, +devices, and interprocess communication; data type utilities; database +interfaces; user interfaces; interfaces to other languages; filenames, +file systems, and file locking; internationalization and locale; world +wide web support; server and daemon utilities; archiving and +compression; image manipulation; mail and news; control flow +utilities; filehandle and I/O; Microsoft Windows modules; and +miscellaneous modules. + +=head2 Is there an ISO or ANSI certified version of Perl? + +Certainly not. Larry expects that he'll be certified before Perl is. + +=head2 Where can I get information on Perl? + +The complete Perl documentation is available with the perl +distribution. If you have perl installed locally, you probably have +the documentation installed as well: type C<man perl> if you're on a +system resembling Unix. This will lead you to other important man +pages. If you're not on a Unix system, access to the documentation +will be different; for example, it might be only in HTML format. But +all proper perl installations have fully-accessible documentation. + +You might also try C<perldoc perl> in case your system doesn't +have a proper man command, or it's been misinstalled. If that doesn't +work, try looking in /usr/local/lib/perl5/pod for documentation. + +If all else fails, consult the CPAN/doc directory, which contains the +complete documentation in various formats, including native pod, +troff, html, and plain text. There's also a web page at +http://www.perl.com/perl/info/documentation.html that might help. + +It's also worth noting that there's a PDF version of the complete +documentation for perl available in the CPAN/authors/id/BMIDD +directory. + +Many good books have been written about Perl -- see the section below +for more details. + +=head2 What are the Perl newsgroups on USENET? Where do I post questions? + +The now defunct comp.lang.perl newsgroup has been superseded by the +following groups: + + comp.lang.perl.announce Moderated announcement group + comp.lang.perl.misc Very busy group about Perl in general + comp.lang.perl.modules Use and development of Perl modules + comp.lang.perl.tk Using Tk (and X) from Perl + + comp.infosystems.www.authoring.cgi Writing CGI scripts for the Web. + +There is also USENET gateway to the mailing list used by the crack +Perl development team (perl5-porters) at +news://genetics.upenn.edu/perl.porters-gw/ . + +=head2 Where should I post source code? + +You should post source code to whichever group is most appropriate, +but feel free to cross-post to comp.lang.perl.misc. If you want to +cross-post to alt.sources, please make sure it follows their posting +standards, including setting the Followup-To header line to NOT +include alt.sources; see their FAQ for details. + +=head2 Perl Books + +A number books on Perl and/or CGI programming are available. A few of +these are good, some are ok, but many aren't worth your money. Tom +Christiansen maintains a list of these books, some with extensive +reviews, at http://www.perl.com/perl/critiques/index.html. + +The incontestably definitive reference book on Perl, written by the +creator of Perl and his apostles, is now in its second edition and +fourth printing. + + Programming Perl (the "Camel Book"): + Authors: Larry Wall, Tom Christiansen, and Randal Schwartz + ISBN 1-56592-149-6 (English) + ISBN 4-89052-384-7 (Japanese) + (French and German translations in progress) + +Note that O'Reilly books are color-coded: turquoise (some would call +it teal) covers indicate perl5 coverage, while magenta (some would +call it pink) covers indicate perl4 only. Check the cover color +before you buy! + +What follows is a list of the books that the FAQ authors found personally +useful. Your mileage may (but, we hope, probably won't) vary. + +If you're already a hard-core systems programmer, then the Camel Book +just might suffice for you to learn Perl from. But if you're not, +check out the "Llama Book". It currently doesn't cover perl5, but the +2nd edition is nearly done and should be out by summer 97: + + Learning Perl (the Llama Book): + Author: Randal Schwartz, with intro by Larry Wall + ISBN 1-56592-042-2 (English) + ISBN 4-89502-678-1 (Japanese) + ISBN 2-84177-005-2 (French) + ISBN 3-930673-08-8 (German) + +Another stand-out book in the turquoise O'Reilly Perl line is the "Hip +Owls" book. It covers regular expressions inside and out, with quite a +bit devoted exclusively to Perl: + + Mastering Regular Expressions (the Cute Owls Book): + Author: Jeffrey Friedl + ISBN 1-56592-257-3 + +You can order any of these books from O'Reilly & Associates, +1-800-998-9938. Local/overseas is 1-707-829-0515. If you can locate +an O'Reilly order form, you can also fax to 1-707-829-0104. See +http://www.ora.com/ on the Web. + +Recommended Perl books that are not from O'Reilly are the following: + + Cross-Platform Perl, (for Unix and Windows NT) + Author: Eric F. Johnson + ISBN: 1-55851-483-X + + How to Set up and Maintain a World Wide Web Site, (2nd edition) + Author: Lincoln Stein, M.D., Ph.D. + ISBN: 0-201-63462-7 + + CGI Programming in C & Perl, + Author: Thomas Boutell + ISBN: 0-201-42219-0 + +Note that some of these address specific application areas (e.g. the +Web) and are not general-purpose programming books. + +=head2 Perl in Magazines + +The Perl Journal is the first and only magazine dedicated to Perl. +It is published (on paper, not online) quarterly by Jon Orwant +(orwant@tpj.com), editor. Subscription information is at http://tpj.com +or via email to subscriptions@tpj.com. + +Beyond this, two other magazines that frequently carry high-quality articles +on Perl are Web Techniques (see http://www.webtechniques.com/) and +Unix Review (http://www.unixreview.com/). + +=head2 Perl on the Net: FTP and WWW Access + +To get the best (and possibly cheapest) performance, pick a site from +the list below and use it to grab the complete list of mirror sites. +>From there you can find the quickest site for you. Remember, the +following list is I<not> the complete list of CPAN mirrors. + + http://www.perl.com/CPAN (redirects to another mirror) + http://www.perl.org/CPAN + ftp://ftp.funet.fi/pub/languages/perl/CPAN/ + http://www.cs.ruu.nl/pub/PERL/CPAN/ + ftp://ftp.cs.colorado.edu/pub/perl/CPAN/ + +=head2 What mailing lists are there for perl? + +Most of the major modules (tk, CGI, libwww-perl) have their own +mailing lists. Consult the documentation that came with the module for +subscription information. The following are a list of mailing lists +related to perl itself. + +If you subscribe to a mailing list, it behooves you to know how to +unsubscribe from it. Strident pleas to the list itself to get you off +will not be favorably received. + +=over 4 + +=item MacPerl + +There is a mailing list for discussing Macintosh Perl. Contact +"mac-perl-request@iis.ee.ethz.ch". + +Also see Matthias Neeracher's (the creator and maintainer of MacPerl) +webpage at http://www.iis.ee.ethz.ch/~neeri/macintosh/perl.html for +many links to interesting MacPerl sites, and the applications/MPW +tools, precompiled. + +=item Perl5-Porters + +The core development team have a mailing list for discussing fixes and +changes to the language. Send mail to +"perl5-porters-request@perl.org" with help in the body of the message +for information on subscribing. + +=item NTPerl + +This list is used to discuss issues involving Win32 Perl 5 (Windows NT +and Win95). Subscribe by emailing ListManager@ActiveWare.com with the +message body: + + subscribe Perl-Win32-Users + +The list software, also written in perl, will automatically determine +your address, and subscribe you automatically. To unsubscribe, email +the following in the message body to the same address like so: + + unsubscribe Perl-Win32-Users + +You can also check http://www.activeware.com/ and select "Mailing Lists" +to join or leave this list. + +=item Perl-Packrats + +Discussion related to archiving of perl materials, particularly the +Comprehensive PerlArchive Network (CPAN). Subscribe by emailing +majordomo@cis.ufl.edu: + + subscribe perl-packrats + +The list software, also written in perl, will automatically determine +your address, and subscribe you automatically. To unsubscribe, simple +prepend the same command with an "un", and mail to the same address +like so: + + unsubscribe perl-packrats + +=back + +=head2 Archives of comp.lang.perl.misc + +Have you tried Deja News or Alta Vista? + +ftp.cis.ufl.edu:/pub/perl/comp.lang.perl.*/monthly has an almost +complete collection dating back to 12/89 (missing 08/91 through +12/93). They are kept as one large file for each month. + +You'll probably want more a sophisticated query and retrieval mechanism +than a file listing, preferably one that allows you to retrieve +articles using a fast-access indices, keyed on at least author, date, +subject, thread (as in "trn") and probably keywords. The best +solution the FAQ authors know of is the MH pick command, but it is +very slow to select on 18000 articles. + +If you have, or know where can be found, the missing sections, please +let perlfaq-suggestions@perl.com know. + +=head2 Perl Training + +While some large training companies offer their own courses on Perl, +you may prefer to contact individuals near and dear to the heart of +Perl development. Two well-known members of the Perl development team +who offer such things are Tom Christiansen <perl-classes@perl.com> +and Randal Schwartz <perl-training-info@stonehenge.com>, plus their +respective minions, who offer a variety of professional tutorials +and seminars on Perl. These courses include large public seminars, +private corporate training, and fly-ins to Colorado and Oregon. +See http://www.perl.com/perl/info/training.html for more details. + +=head2 Where can I buy a commercial version of Perl? + +In a sense, Perl already I<is> commercial software: It has a licence +that you can grab and carefully read to your manager. It is +distributed in releases and comes in well-defined packages. There is a +very large user community and an extensive literature. The +comp.lang.perl.* newsgroups and several of the mailing lists provide +free answers to your questions in near real-time. Perl has +traditionally been supported by Larry, dozens of software designers +and developers, and thousands of programmers, all working for free +to create a useful thing to make life better for everyone. + +However, these answers may not suffice for managers who require a +purchase order from a company whom they can sue should anything go +wrong. Or maybe they need very serious hand-holding and contractual +obligations. Shrink-wrapped CDs with perl on them are available from +several sources if that will help. + +Or you can purchase a real support contract. Although Cygnus historically +provided this service, they no longer sell support contracts for Perl. +Instead, the Paul Ingram Group will be taking up the slack through The +Perl Clinic. The following is a commercial from them: + +"Do you need professional support for Perl and/or Oraperl? Do you need +a support contract with defined levels of service? Do you want to pay +only for what you need? + +"The Paul Ingram Group has provided quality software development and +support services to some of the world's largest corporations for ten +years. We are now offering the same quality support services for Perl +at The Perl Clinic. This service is led by Tim Bunce, an active perl +porter since 1994 and well known as the author and maintainer of the +DBI, DBD::Oracle, and Oraperl modules and author/co-maintainer of The +Perl 5 Module List. We also offer Oracle users support for Perl5 +Oraperl and related modules (which Oracle is planning to ship as part +of Oracle Web Server 3). 20% of the profit from our Perl support work +will be donated to The Perl Institute." + +For more information, contact the The Perl Clinic: + + Tel: +44 1483 424424 + Fax: +44 1483 419419 + Web: http://www.perl.co.uk/ + Email: perl-support-info@perl.co.uk or Tim.Bunce@ig.co.uk + +=head2 Where do I send bug reports? + +If you are reporting a bug in the perl interpreter or the modules +shipped with perl, use the perlbug program in the perl distribution or +email your report to perlbug@perl.com. + +If you are posting a bug with a non-standard port (see the answer to +"What platforms is Perl available for?"), a binary distribution, or a +non-standard module (such as Tk, CGI, etc), then please see the +documentation that came with it to determine the correct place to post +bugs. + +Read the perlbug man page (perl5.004 or later) for more information. + +=head2 What is perl.com? perl.org? The Perl Institute? + +perl.org is the official vehicle for The Perl Institute. The motto of +TPI is "helping people help Perl help people" (or something like +that). It's a non-profit organization supporting development, +documentation, and dissemination of perl. Current directors of TPI +include Larry Wall, Tom Christiansen, and Randal Schwartz, whom you +may have heard of somewhere else around here. + +The perl.com domain is Tom Christiansen's domain. He created it as a +public service long before perl.org came about. It's the original PBS +of the Perl world, a clearinghouse for information about all things +Perlian, accepting no paid advertisements, glossy gifs, or (gasp!) +java applets on its pages. + +=head2 How do I learn about object-oriented Perl programming? + +L<perltoot> (distributed with 5.004 or later) is a good place to start. +Also, L<perlobj>, L<perlref>, and L<perlmod> are useful references, +while L<perlbot> has some excellent tips and tricks. + +=head1 AUTHOR AND COPYRIGHT + +Copyright (c) 1997 Tom Christiansen and Nathan Torkington. +All rights reserved. See L<perlfaq> for distribution information. diff --git a/pod/perlfaq3.pod b/pod/perlfaq3.pod new file mode 100644 index 0000000000..121743ddbf --- /dev/null +++ b/pod/perlfaq3.pod @@ -0,0 +1,503 @@ +=head1 NAME + +perlfaq3 - Programming Tools ($Revision: 1.19 $) + +=head1 DESCRIPTION + +This section of the FAQ answers questions related to programmer tools +and programming support. + +=head2 How do I do (anything)? + +Have you looked at CPAN (see L<perlfaq2>)? The chances are that +someone has already written a module that can solve your problem. +Have you read the appropriate man pages? Here's a brief index: + + Objects perlref, perlmod, perlobj, perltie + Data Structures perlref, perllol, perldsc + Modules perlmod, perlsub + Regexps perlre, perlfunc, perlop + Moving to perl5 perltrap, perl + Linking w/C perlxstut, perlxs, perlcall, perlguts, perlembed + Various http://www.perl.com/CPAN/doc/FMTEYEWTK/index.html + (not a man-page but still useful) + +L<perltoc> provides a crude table of contents for the perl man page set. + +=head2 How can I use Perl interactively? + +The typical approach uses the Perl debugger, described in the +perldebug(1) man page, on an "empty" program, like this: + + perl -de 42 + +Now just type in any legal Perl code, and it will be immediately +evaluated. You can also examine the symbol table, get stack +backtraces, check variable values, set breakpoints, and other +operations typically found in symbolic debuggers + +=head2 Is there a Perl shell? + +In general, no. The Shell.pm module (distributed with perl) makes +perl try commands which aren't part of the Perl language as shell +commands. perlsh from the source distribution is simplistic and +uninteresting, but may still be what you want. + +=head2 How do I debug my Perl programs? + +Have you used C<-w>? + +Have you tried C<use strict>? + +Did you check the returns of each and every system call? + +Did you read L<perltrap>? + +Have you tried the Perl debugger, described in L<perldebug>? + +=head2 How do I profile my Perl programs? + +You should get the Devel::DProf module from CPAN, and also use +Benchmark.pm from the standard distribution. Benchmark lets you time +specific portions of your code, while Devel::DProf gives detailed +breakdowns of where your code spends its time. + +=head2 How do I cross-reference my Perl programs? + +The B::Xref module, shipped with the new, alpha-release Perl compiler +(not the general distribution), can be used to generate +cross-reference reports for Perl programs. + + perl -MO=Xref[,OPTIONS] foo.pl + +=head2 Is there a pretty-printer (formatter) for Perl? + +There is no program that will reformat Perl as much as indent(1) will +do for C. The complex feedback between the scanner and the parser +(this feedback is what confuses the vgrind and emacs programs) makes it +challenging at best to write a stand-alone Perl parser. + +Of course, if you simply follow the guidelines in L<perlstyle>, you +shouldn't need to reformat. + +Your editor can and should help you with source formatting. The +perl-mode for emacs can provide a remarkable amount of help with most +(but not all) code, and even less programmable editors can provide +significant assistance. + +If you are using to using vgrind program for printing out nice code to +a laser printer, you can take a stab at this using +http://www.perl.com/CPAN/doc/misc/tips/working.vgrind.entry, but the +results are not particularly satisfying for sophisticated code. + +=head2 Is there a ctags for Perl? + +There's a simple one at +http://www.perl.com/CPAN/authors/id/TOMC/scripts/ptags.gz which may do +the trick. + +=head2 Where can I get Perl macros for vi? + +For a complete version of Tom Christiansen's vi configuration file, +see ftp://ftp.perl.com/pub/vi/toms.exrc, the standard benchmark file +for vi emulators. This runs best with nvi, the current version of vi +out of Berkeley, which incidentally can be built with an embedded Perl +interpreter -- see http://www.perl.com/CPAN/src/misc . + +=head2 Where can I get perl-mode for emacs? + +Since Emacs version 19 patchlevel 22 or so, there have been both a +perl-mode.el and support for the perl debugger built in. These should +come with the standard Emacs 19 distribution. + +In the perl source directory, you'll find a directory called "emacs", +which contains a cperl-mode that color-codes keywords, provides +context-sensitive help, and other nifty things. + +Note that the perl-mode of emacs will have fits with "main'foo" +(single quote), and mess up the indentation and hilighting. You +should be using "main::foo", anyway. + +=head2 How can I use curses with Perl? + +The Curses module from CPAN provides a dynamically loadable object +module interface to a curses library. + +=head2 How can I use X or Tk with Perl? + +Tk is a completely Perl-based, object-oriented interface to the Tk +toolkit that doesn't force you to use Tcl just to get at Tk. Sx is an +interface to the Athena Widget set. Both are available from CPAN. + +=head2 How can I generate simple menus without using CGI or Tk? + +The http://www.perl.com/CPAN/authors/id/SKUNZ/perlmenu.v4.0.tar.gz +module, which is curses-based, can help with this. + +=head2 Can I dynamically load C routines into Perl? + +If your system architecture supports it, then the standard perl +on your system should also provide you with this via the +DynaLoader module. Read L<perlxstut> for details. + +=head2 What is undump? + +See the next questions. + +=head2 How can I make my Perl program run faster? + +The best way to do this is to come up with a better algorithm. +This can often make a dramatic difference. Chapter 8 in the Camel +has some efficiency tips in it you might want to look at. + +Other approaches include autoloading seldom-used Perl code. See the +AutoSplit and AutoLoader modules in the standard distribution for +that. Or you could locate the bottleneck and think about writing just +that part in C, the way we used to take bottlenecks in C code and +write them in assembler. Similar to rewriting in C is the use of +modules that have critical sections written in C (for instance, the +PDL module from CPAN). + +In some cases, it may be worth it to use the backend compiler to +produce byte code (saving compilation time) or compile into C, which +will certainly save compilation time and sometimes a small amount (but +not much) execution time. See the question about compiling your Perl +programs. + +If you're currently linking your perl executable to a shared libc.so, +you can often gain a 10-25% performance benefit by rebuilding it to +link with a static libc.a instead. This will make a bigger perl +executable, but your Perl programs (and programmers) may thank you for +it. See the F<INSTALL> file in the source distribution for more +information. + +Unsubstantiated reports allege that Perl interpreters that use sfio +outperform those that don't (for IO intensive applications). To try +this, see the F<INSTALL> file in the source distribution, especially +the "Selecting File IO mechanisms" section. + +The undump program was an old attempt to speed up your Perl program +by storing the already-compiled form to disk. This is no longer +a viable option, as it only worked on a few architectures, and +wasn't a good solution anyway. + +=head2 How can I make my Perl program take less memory? + +When it comes to time-space tradeoffs, Perl nearly always prefers to +throw memory at a problem. Scalars in Perl use more memory than +strings in C, arrays take more that, and hashes use even more. While +there's still a lot to be done, recent releases have been addressing +these issues. For example, as of 5.004, duplicate hash keys are +shared amongst all hashes using them, so require no reallocation. + +In some cases, using substr() or vec() to simulate arrays can be +highly beneficial. For example, an array of a thousand booleans will +take at least 20,000 bytes of space, but it can be turned into one +125-byte bit vector for a considerable memory savings. The standard +Tie::SubstrHash module can also help for certain types of data +structure. If you're working with specialist data structures +(matrices, for instance) modules that implement these in C may use +less memory than equivalent Perl modules. + +Another thing to try is learning whether your Perl was compiled with +the system malloc or with Perl's built-in malloc. Whichever one it +is, try using the other one and see whether this makes a difference. +Information about malloc is in the F<INSTALL> file in the source +distribution. You can find out whether you are using perl's malloc by +typing C<perl -V:usemymalloc>. + +=head2 Is it unsafe to return a pointer to local data? + +No, Perl's garbage collection system takes care of this. + + sub makeone { + my @a = ( 1 .. 10 ); + return \@a; + } + + for $i ( 1 .. 10 ) { + push @many, makeone(); + } + + print $many[4][5], "\n"; + + print "@many\n"; + +=head2 How can I free an array or hash so my program shrinks? + +You can't. Memory the system allocates to a program will never be +returned to the system. That's why long-running programs sometimes +re-exec themselves. + +However, judicious use of my() on your variables will help make sure +that they go out of scope so that Perl can free up their storage for +use in other parts of your program. (NB: my() variables also execute +about 10% faster than globals.) A global variable, of course, never +goes out of scope, so you can't get its space automatically reclaimed, +although undef()ing and/or delete()ing it will achieve the same effect. +In general, memory allocation and de-allocation isn't something you can +or should be worrying about much in Perl, but even this capability +(preallocation of data types) is in the works. + +=head2 How can I make my CGI script more efficient? + +Beyond the normal measures described to make general Perl programs +faster or smaller, a CGI program has additional issues. It may be run +several times per second. Given that each time it runs it will need +to be re-compiled and will often allocate a megabyte or more of system +memory, this can be a killer. Compiling into C B<isn't going to help +you> because the process start-up overhead is where the bottleneck is. + +There are at least two popular ways to avoid this overhead. One +solution involves running the Apache HTTP server (available from +http://www.apache.org/) with either of the mod_perl or mod_fastcgi +plugin modules. With mod_perl and the Apache::* modules (from CPAN), +httpd will run with an embedded Perl interpreter which pre-compiles +your script and then executes it within the same address space without +forking. The Apache extension also gives Perl access to the internal +server API, so modules written in Perl can do just about anything a +module written in C can. With the FCGI module (from CPAN), a Perl +executable compiled with sfio (see the F<INSTALL> file in the +distribution) and the mod_fastcgi module (available from +http://www.fastcgi.com/) each of your perl scripts becomes a permanent +CGI daemon processes. + +Both of these solutions can have far-reaching effects on your system +and on the way you write your CGI scripts, so investigate them with +care. + +=head2 How can I hide the source for my Perl program? + +Delete it. :-) Seriously, there are a number of (mostly +unsatisfactory) solutions with varying levels of "security". + +First of all, however, you I<can't> take away read permission, because +the source code has to be readable in order to be compiled and +interpreted. (That doesn't mean that a CGI script's source is +readable by people on the web, though.) So you have to leave the +permissions at the socially friendly 0755 level. + +Some people regard this as a security problem. If your program does +insecure things, and relies on people not knowing how to exploit those +insecurities, it is not secure. It is often possible for someone to +determine the insecure things and exploit them without viewing the +source. Security through obscurity, the name for hiding your bugs +instead of fixing them, is little security indeed. + +You can try using encryption via source filters (Filter::* from CPAN). +But crackers might be able to decrypt it. You can try using the +byte-code compiler and interpreter described below, but crackers might +be able to de-compile it. You can try using the native-code compiler +described below, but crackers might be able to disassemble it. These +pose varying degrees of difficulty to people wanting to get at your +code, but none can definitively conceal it (this is true of every +language, not just Perl). + +If you're concerned about people profiting from your code, then the +bottom line is that nothing but a restrictive licence will give you +legal security. License your software and pepper it with threatening +statements like "This is unpublished proprietary software of XYZ Corp. +Your access to it does not give you permission to use it blah blah +blah." We are not lawyers, of course, so you should see a lawyer if +you want to be sure your licence's wording will stand up in court. + +=head2 How can I compile my Perl program into byte-code or C? + +Malcolm Beattie has written a multifunction backend compiler, +available from CPAN, that can do both these things. It is as of +Feb-1997 in late alpha release, which means it's fun to play with if +you're a programmer but not really for people looking for turn-key +solutions. + +I<Please> understand that merely compiling into C does not in and of +itself guarantee that your code will run very much faster. That's +because except for lucky cases where a lot of native type inferencing +is possible, the normal Perl run time system is still present and thus +will still take just as long to run and be just as big. Most programs +save little more than compilation time, leaving execution no more than +10-30% faster. A few rare programs actually benefit significantly +(like several times faster), but this takes some tweaking of your +code. + +Malcolm will be in charge of the 5.005 release of Perl itself +to try to unify and merge his compiler and multithreading work into +the main release. + +You'll probably be astonished to learn that the current version of the +compiler generates a compiled form of your script whose executable is +just as big as the original perl executable, and then some. That's +because as currently written, all programs are prepared for a full +eval() statement. You can tremendously reduce this cost by building a +shared libperl.so library and linking against that. See the +F<INSTALL> podfile in the perl source distribution for details. If +you link your main perl binary with this, it will make it miniscule. +For example, on one author's system, /usr/bin/perl is only 11k in +size! + +=head2 How can I get '#!perl' to work on [MSDOS,NT,...]? + +For OS/2 just use + + extproc perl -S -your_switches + +as the first line in C<*.cmd> file (C<-S> due to a bug in cmd.exe's +`extproc' handling). For DOS one should first invent a corresponding +batch file, and codify it in C<ALTERNATIVE_SHEBANG> (see the +F<INSTALL> file in the source distribution for more information). + +The Win95/NT installation, when using the Activeware port of Perl, +will modify the Registry to associate the .pl extension with the perl +interpreter. If you install another port, or (eventually) build your +own Win95/NT Perl using WinGCC, then you'll have to modify the +Registry yourself. + +Macintosh perl scripts will have the the appropriate Creator and +Type, so that double-clicking them will invoke the perl application. + +I<IMPORTANT!>: Whatever you do, PLEASE don't get frustrated, and just +throw the perl interpreter into your cgi-bin directory, in order to +get your scripts working for a web server. This is an EXTREMELY big +security risk. Take the time to figure out how to do it correctly. + +=head2 Can I write useful perl programs on the command line? + +Yes. Read L<perlrun> for more information. Some examples follow. +(These assume standard Unix shell quoting rules.) + + # sum first and last fields + perl -lane 'print $F[0] + $F[-1]' + + # identify text files + perl -le 'for(@ARGV) {print if -f && -T _}' * + + # remove comments from C program + perl -0777 -pe 's{/\*.*?\*/}{}gs' foo.c + + # make file a month younger than today, defeating reaper daemons + perl -e '$X=24*60*60; utime(time(),time() + 30 * $X,@ARGV)' * + + # find first unused uid + perl -le '$i++ while getpwuid($i); print $i' + + # display reasonable manpath + echo $PATH | perl -nl -072 -e ' + s![^/+]*$!man!&&-d&&!$s{$_}++&&push@m,$_;END{print"@m"}' + +Ok, the last one was actually an obfuscated perl entry. :-) + +=head2 Why don't perl one-liners work on my DOS/Mac/VMS system? + +The problem is usually that the command interpreters on those systems +have rather different ideas about quoting than the Unix shells under +which the one-liners were created. On some systems, you may have to +change single-quotes to double ones, which you must I<NOT> do on Unix +or Plan9 systems. You might also have to change a single % to a %%. + +For example: + + # Unix + perl -e 'print "Hello world\n"' + + # DOS, etc. + perl -e "print \"Hello world\n\"" + + # Mac + print "Hello world\n" + (then Run "Myscript" or Shift-Command-R) + + # VMS + perl -e "print ""Hello world\n""" + +The problem is that none of this is reliable: it depends on the command +interpreter. Under Unix, the first two often work. Under DOS, it's +entirely possible neither works. If 4DOS was the command shell, I'd +probably have better luck like this: + + perl -e "print <Ctrl-x>"Hello world\n<Ctrl-x>"" + +Under the Mac, it depends which environment you are using. The MacPerl +shell, or MPW, is much like Unix shells in its support for several +quoting variants, except that it makes free use of the Mac's non-ASCII +characters as control characters. + +I'm afraid that there is no general solution to all of this. It is a +mess, pure and simple. + +[Some of this answer was contributed by Kenneth Albanowski.] + +=head2 Where can I learn about CGI or Web programming in Perl? + +For modules, get the CGI or LWP modules from CPAN. For textbooks, +see the two especially dedicated to web stuff in the question on +books. For problems and questions related to the web, like "Why +do I get 500 Errors" or "Why doesn't it run from the browser right +when it runs fine on the command line", see these sources: + + The Idiot's Guide to Solving Perl/CGI Problems, by Tom Christiansen + http://www.perl.com/perl/faq/idiots-guide.html + + Frequently Asked Questions about CGI Programming, by Nick Kew + ftp://rtfm.mit.edu/pub/usenet/news.answers/www/cgi-faq + http://www3.pair.com/webthing/docs/cgi/faqs/cgifaq.shtml + + Perl/CGI programming FAQ, by Shishir Gundavaram and Tom Christiansen + http://www.perl.com/perl/faq/perl-cgi-faq.html + + The WWW Security FAQ, by Lincoln Stein + http://www-genome.wi.mit.edu/WWW/faqs/www-security-faq.html + + World Wide Web FAQ, by Thomas Boutell + http://www.boutell.com/faq/ + +=head2 Where can I learn about object-oriented Perl programming? + +L<perltoot> is a good place to start, and you can use L<perlobj> and +L<perlbot> for reference. Perltoot didn't come out until the 5.004 +release, but you can get a copy (in pod, html, or postscript) from +http://www.perl.com/CPAN/doc/FMTEYEWTK/ . + +=head2 Where can I learn about linking C with Perl? [h2xs, xsubpp] + +If you want to call C from Perl, start with L<perlxstut>, +moving on to L<perlxs>, L<xsubpp>, and L<perlguts>. If you want to +call Perl from C, then read L<perlembed>, L<perlcall>, and +L<perlguts>. Don't forget that you can learn a lot from looking at +how the authors of existing extension modules wrote their code and +solved their problems. + +=head2 I've read perlembed, perlguts, etc., but I can't embed perl in +my C program, what am I doing wrong? + +Download the ExtUtils::Embed kit from CPAN and run `make test'. If +the tests pass, read the pods again and again and again. If they +fail, see L<perlbug> and send a bugreport with the output of +C<make test TEST_VERBOSE=1> along with C<perl -V>. + +=head2 When I tried to run my script, I got this message. What does it +mean? + +L<perldiag> has a complete list of perl's error messages and warnings, +with explanatory text. You can also use the splain program (distributed +with perl) to explain the error messages: + + perl program 2>diag.out + splain [-v] [-p] diag.out + +or change your program to explain the messages for you: + + use diagnostics; + +or + + use diagnostics -verbose; + +=head2 What's MakeMaker? + +This module (part of the standard perl distribution) is designed to +write a Makefile for an extension module from a Makefile.PL. For more +information, see L<ExtUtils::MakeMaker>. + +=head1 AUTHOR AND COPYRIGHT + +Copyright (c) 1997 Tom Christiansen and Nathan Torkington. +All rights reserved. See L<perlfaq> for distribution information. diff --git a/pod/perlfaq4.pod b/pod/perlfaq4.pod new file mode 100644 index 0000000000..1c1edfa467 --- /dev/null +++ b/pod/perlfaq4.pod @@ -0,0 +1,1034 @@ +=head1 NAME + +perlfaq4 - Data Manipulation ($Revision: 1.15 $) + +=head1 DESCRIPTION + +The section of the FAQ answers question related to the manipulation +of data as numbers, dates, strings, arrays, hashes, and miscellaneous +data issues. + +=head1 Data: Numbers + +=head2 Why isn't my octal data interpreted correctly? + +Perl only understands octal and hex numbers as such when they occur +as literals in your program. If they are read in from somewhere and +assigned, no automatic conversion takes place. You must explicitly +use oct() or hex() if you want the values converted. oct() interprets +both hex ("0x350") numbers and octal ones ("0350" or even without the +leading "0", like "377"), while hex() only converts hexadecimal ones, +with or without a leading "0x", like "0x255", "3A", "ff", or "deadbeef". + +This problem shows up most often when people try using chmod(), mkdir(), +umask(), or sysopen(), which all want permissions in octal. + + chmod(644, $file); # WRONG -- perl -w catches this + chmod(0644, $file); # right + +=head2 Does perl have a round function? What about ceil() and floor()? +Trig functions? + +For rounding to a certain number of digits, sprintf() or printf() is +usually the easiest route. + +The POSIX module (part of the standard perl distribution) implements +ceil(), floor(), and a number of other mathematical and trigonometric +functions. + +The Math::Complex module (part of the standard perl distribution) +defines a number of mathematical functions that can also work on real +numbers. It's not as efficient as the POSIX library, but the POSIX +library can't work with complex numbers. + +Rounding in financial applications can have serious implications, and +the rounding method used should be specified precisely. In these +cases, it probably pays not to trust whichever system rounding is +being used by Perl, but to instead implement the rounding function you +need yourself. + +=head2 How do I convert bits into ints? + +To turn a string of 1s and 0s like '10110110' into a scalar containing +its binary value, use the pack() function (documented in +L<perlfunc/"pack">): + + $decimal = pack('B8', '10110110'); + +Here's an example of going the other way: + + $binary_string = join('', unpack('B*', "\x29")); + +=head2 How do I multiply matrices? + +Use the Math::Matrix or Math::MatrixReal modules (available from CPAN) +or the PDL extension (also available from CPAN). + +=head2 How do I perform an operation on a series of integers? + +To call a function on each element in an array, and collect the +results, use: + + @results = map { my_func($_) } @array; + +For example: + + @triple = map { 3 * $_ } @single; + +To call a function on each element of an array, but ignore the +results: + + foreach $iterator (@array) { + &my_func($iterator); + } + +To call a function on each integer in a (small) range, you B<can> use: + + @results = map { &my_func($_) } (5 .. 25); + +but you should be aware that the C<..> operator creates an array of +all integers in the range. This can take a lot of memory for large +ranges. Instead use: + + @results = (); + for ($i=5; $i < 500_005; $i++) { + push(@results, &my_func($i)); + } + +=head2 How can I output Roman numerals? + +Get the http://www.perl.com/CPAN/modules/by-module/Roman module. + +=head2 Why aren't my random numbers random? + +The short explanation is that you're getting pseudorandom numbers, not +random ones, because that's how these things work. A longer +explanation is available on +http://www.perl.com/CPAN/doc/FMTEYEWTK/random, courtesy of Tom +Phoenix. + +You should also check out the Math::TrulyRandom module from CPAN. + +=head1 Data: Dates + +=head2 How do I find the week-of-the-year/day-of-the-year? + +The day of the year is in the array returned by localtime() (see +L<perlfunc/"localtime">): + + $day_of_year = (localtime(time()))[7]; + +or more legibly (in 5.004 or higher): + + use Time::localtime; + $day_of_year = localtime(time())->yday; + +You can find the week of the year by dividing this by 7: + + $week_of_year = int($day_of_year / 7); + +Of course, this believes that weeks start at zero. + +=head2 How can I compare two date strings? + +Use the Date::Manip or Date::DateCalc modules from CPAN. + +=head2 How can I take a string and turn it into epoch seconds? + +If it's a regular enough string that it always has the same format, +you can split it up and pass the parts to timelocal in the standard +Time::Local module. Otherwise, you should look into one of the +Date modules from CPAN. + +=head2 How can I find the Julian Day? + +Neither Date::Manip nor Date::DateCalc deal with Julian days. +Instead, there is an example of Julian date calculation in +http://www.perl.com/CPAN/authors/David_Muir_Sharnoff/modules/Time/JulianDay.pm.gz, +which should help. + +=head2 Does Perl have a year 2000 problem? + +Not unless you use Perl to create one. The date and time functions +supplied with perl (gmtime and localtime) supply adequate information +to determine the year well beyond 2000 (2038 is when trouble strikes). +The year returned by these functions when used in an array context is +the year minus 1900. For years between 1910 and 1999 this I<happens> +to be a 2-digit decimal number. To avoid the year 2000 problem simply +do not treat the year as a 2-digit number. It isn't. + +When gmtime() and localtime() are used in a scalar context they return +a timestamp string that contains a fully-expanded year. For example, +C<$timestamp = gmtime(1005613200)> sets $timestamp to "Tue Nov 13 01:00:00 +2001". There's no year 2000 problem here. + +=head1 Data: Strings + +=head2 How do I validate input? + +The answer to this question is usually a regular expression, perhaps +with auxiliary logic. See the more specific questions (numbers, email +addresses, etc.) for details. + +=head2 How do I unescape a string? + +It depends just what you mean by "escape". URL escapes are dealt with +in L<perlfaq9>. Shell escapes with the backslash (\) +character are removed with: + + s/\\(.)/$1/g; + +Note that this won't expand \n or \t or any other special escapes. + +=head2 How do I remove consecutive pairs of characters? + +To turn "abbcccd" into "abccd": + + s/(.)\1/$1/g; + +=head2 How do I expand function calls in a string? + +This is documented in L<perlref>. In general, this is fraught with +quoting and readability problems, but it is possible. To interpolate +a subroutine call (in a list context) into a string: + + print "My sub returned @{[mysub(1,2,3)]} that time.\n"; + +If you prefer scalar context, similar chicanery is also useful for +arbitrary expressions: + + print "That yields ${\($n + 5)} widgets\n"; + +=head2 How do I find matching/nesting anything? + +This isn't something that can be tackled in one regular expression, no +matter how complicated. To find something between two single characters, +a pattern like C</x([^x]*)x/> will get the intervening bits in $1. For +multiple ones, then something more like C</alpha(.*?)omega/> would +be needed. But none of these deals with nested patterns, nor can they. +For that you'll have to write a parser. + +=head2 How do I reverse a string? + +Use reverse() in a scalar context, as documented in +L<perlfunc/reverse>. + + $reversed = reverse $string; + +=head2 How do I expand tabs in a string? + +You can do it the old-fashioned way: + + 1 while $string =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e; + +Or you can just use the Text::Tabs module (part of the standard perl +distribution). + + use Text::Tabs; + @expanded_lines = expand(@lines_with_tabs); + +=head2 How do I reformat a paragraph? + +Use Text::Wrap (part of the standard perl distribution): + + use Text::Wrap; + print wrap("\t", ' ', @paragraphs); + +=head2 How can I access/change the first N letters of a string? + +There are many ways. If you just want to grab a copy, use +substr: + + $first_byte = substr($a, 0, 1); + +If you want to modify part of a string, the simplest way is often to +use substr() as an lvalue: + + substr($a, 0, 3) = "Tom"; + +Although those with a regexp kind of thought process will likely prefer + + $a =~ s/^.../Tom/; + +=head2 How do I change the Nth occurrence of something? + +You have to keep track. For example, let's say you want +to change the fifth occurrence of "whoever" or "whomever" +into "whosoever", case insensitively. + + $count = 0; + s{((whom?)ever)}{ + ++$count == 5 # is it the 5th? + ? "${2}soever" # yes, swap + : $1 # renege and leave it there + }igex; + +=head2 How can I count the number of occurrences of a substring within a string? + +There are a number of ways, with varying efficiency: If you want a +count of a certain single character (X) within a string, you can use the +C<tr///> function like so: + + $string = "ThisXlineXhasXsomeXx'sXinXit": + $count = ($string =~ tr/X//); + print "There are $count X charcters in the string"; + +This is fine if you are just looking for a single character. However, +if you are trying to count multiple character substrings within a +larger string, C<tr///> won't work. What you can do is wrap a while() +loop around a global pattern match. For example, let's count negative +integers: + + $string = "-9 55 48 -2 23 -76 4 14 -44"; + while ($string =~ /-\d+/g) { $count++ } + print "There are $count negative numbers in the string"; + +=head2 How do I capitalize all the words on one line? + +To make the first letter of each word upper case: + $line =~ s/\b(\w)/\U$1/g; + +To make the whole line upper case: + $line = uc($line); + +To force each word to be lower case, with the first letter upper case: + $line =~ s/(\w+)/\u\L$1/g; + +=head2 How can I split a [character] delimited string except when inside +[character]? (Comma-separated files) + +Take the example case of trying to split a string that is comma-separated +into its different fields. (We'll pretend you said comma-separated, not +comma-delimited, which is different and almost never what you mean.) You +can't use C<split(/,/)> because you shouldn't split if the comma is inside +quotes. For example, take a data line like this: + + SAR001,"","Cimetrix, Inc","Bob Smith","CAM",N,8,1,0,7,"Error, Core Dumped" + +Due to the restriction of the quotes, this is a fairly complex +problem. Thankfully, we have Jeffrey Friedl, author of a highly +recommended book on regular expressions, to handle these for us. He +suggests (assuming your string is contained in $text): + + @new = (); + push(@new, $+) while $text =~ m{ + "([^\"\\]*(?:\\.[^\"\\]*)*)",? # groups the phrase inside the quotes + | ([^,]+),? + | , + }gx; + push(@new, undef) if substr($text,-1,1) eq ','; + +Alternatively, the Text::ParseWords module (part of the standard perl +distribution) lets you say: + + use Text::ParseWords; + @new = quotewords(",", 0, $text); + +=head2 How do I strip blank space from the beginning/end of a string? + +The simplest approach, albeit not the fastest, is probably like this: + + $string =~ s/^\s*(.*?)\s*$/$1/; + +It would be faster to do this in two steps: + + $string =~ s/^\s+//; + $string =~ s/\s+$//; + +Or more nicely written as: + + for ($string) { + s/^\s+//; + s/\s+$//; + } + +=head2 How do I extract selected columns from a string? + +Use substr() or unpack(), both documented in L<perlfunc>. + +=head2 How do I find the soundex value of a string? + +Use the standard Text::Soundex module distributed with perl. + +=head2 How can I expand variables in text strings? + +Let's assume that you have a string like: + + $text = 'this has a $foo in it and a $bar'; + $text =~ s/\$(\w+)/${$1}/g; + +Before version 5 of perl, this had to be done with a double-eval +substitution: + + $text =~ s/(\$\w+)/$1/eeg; + +Which is bizarre enough that you'll probably actually need an EEG +afterwards. :-) + +=head2 What's wrong with always quoting "$vars"? + +The problem is that those double-quotes force stringification, +coercing numbers and references into strings, even when you +don't want them to be. + +If you get used to writing odd things like these: + + print "$var"; # BAD + $new = "$old"; # BAD + somefunc("$var"); # BAD + +You'll be in trouble. Those should (in 99.8% of the cases) be +the simpler and more direct: + + print $var; + $new = $old; + somefunc($var); + +Otherwise, besides slowing you down, you're going to break code when +the thing in the scalar is actually neither a string nor a number, but +a reference: + + func(\@array); + sub func { + my $aref = shift; + my $oref = "$aref"; # WRONG + } + +You can also get into subtle problems on those few operations in Perl +that actually do care about the difference between a string and a +number, such as the magical C<++> autoincrement operator or the +syscall() function. + +=head2 Why don't my <<HERE documents work? + +Check for these three things: + +=over 4 + +=item 1. There must be no space after the << part. + +=item 2. There (probably) should be a semicolon at the end. + +=item 3. You can't (easily) have any space in front of the tag. + +=back + +=head1 Data: Arrays + +=head2 What is the difference between $array[1] and @array[1]? + +The former is a scalar value, the latter an array slice, which makes +it a list with one (scalar) value. You should use $ when you want a +scalar value (most of the time) and @ when you want a list with one +scalar value in it (very, very rarely; nearly never, in fact). + +Sometimes it doesn't make a difference, but sometimes it does. +For example, compare: + + $good[0] = `some program that outputs several lines`; + +with + + @bad[0] = `same program that outputs several lines`; + +The B<-w> flag will warn you about these matters. + +=head2 How can I extract just the unique elements of an array? + +There are several possible ways, depending on whether the array is +ordered and whether you wish to preserve the ordering. + +=over 4 + +=item a) If @in is sorted, and you want @out to be sorted: + + $prev = 'nonesuch'; + @out = grep($_ ne $prev && ($prev = $_), @in); + +This is nice in that it doesn't use much extra memory, +simulating uniq(1)'s behavior of removing only adjacent +duplicates. + +=item b) If you don't know whether @in is sorted: + + undef %saw; + @out = grep(!$saw{$_}++, @in); + +=item c) Like (b), but @in contains only small integers: + + @out = grep(!$saw[$_]++, @in); + +=item d) A way to do (b) without any loops or greps: + + undef %saw; + @saw{@in} = (); + @out = sort keys %saw; # remove sort if undesired + +=item e) Like (d), but @in contains only small positive integers: + + undef @ary; + @ary[@in] = @in; + @out = @ary; + +=back + +=head2 How can I tell whether an array contains a certain element? + +There are several ways to approach this. If you are going to make +this query many times and the values are arbitrary strings, the +fastest way is probably to invert the original array and keep an +associative array lying about whose keys are the first array's values. + + @blues = qw/azure cerulean teal turquoise lapis-lazuli/; + undef %is_blue; + for (@blues) { $is_blue{$_} = 1 } + +Now you can check whether $is_blue{$some_color}. It might have been a +good idea to keep the blues all in a hash in the first place. + +If the values are all small integers, you could use a simple indexed +array. This kind of an array will take up less space: + + @primes = (2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31); + undef @is_tiny_prime; + for (@primes) { $is_tiny_prime[$_] = 1; } + +Now you check whether $is_tiny_prime[$some_number]. + +If the values in question are integers instead of strings, you can save +quite a lot of space by using bit strings instead: + + @articles = ( 1..10, 150..2000, 2017 ); + undef $read; + grep (vec($read,$_,1) = 1, @articles); + +Now check whether C<vec($read,$n,1)> is true for some C<$n>. + +Please do not use + + $is_there = grep $_ eq $whatever, @array; + +or worse yet + + $is_there = grep /$whatever/, @array; + +These are slow (checks every element even if the first matches), +inefficient (same reason), and potentially buggy (what if there are +regexp characters in $whatever?). + +=head2 How do I compute the difference of two arrays? How do I compute the intersection of two arrays? + +Use a hash. Here's code to do both and more. It assumes that +each element is unique in a given array: + + @union = @intersection = @difference = (); + %count = (); + foreach $element (@array1, @array2) { $count{$element}++ } + foreach $element (keys %count) { + push @union, $element; + push @{ $count{$element} > 1 ? \@intersection : \@difference }, $element; + } + +=head2 How do I find the first array element for which a condition is true? + +You can use this if you care about the index: + + for ($i=0; $i < @array; $i++) { + if ($array[$i] eq "Waldo") { + $found_index = $i; + last; + } + } + +Now C<$found_index> has what you want. + +=head2 How do I handle linked lists? + +In general, you usually don't need a linked list in Perl, since with +regular arrays, you can push and pop or shift and unshift at either end, +or you can use splice to add and/or remove arbitrary number of elements +at arbitrary points. + +If you really, really wanted, you could use structures as described in +L<perldsc> or L<perltoot> and do just what the algorithm book tells you +to do. + +=head2 How do I handle circular lists? + +Circular lists could be handled in the traditional fashion with linked +lists, or you could just do something like this with an array: + + unshift(@array, pop(@array)); # the last shall be first + push(@array, shift(@array)); # and vice versa + +=head2 How do I shuffle an array randomly? + +Here's a shuffling algorithm which works its way through the list, +randomly picking another element to swap the current element with: + + srand; + @new = (); + @old = 1 .. 10; # just a demo + while (@old) { + push(@new, splice(@old, rand @old, 1)); + } + +For large arrays, this avoids a lot of the reshuffling: + + srand; + @new = (); + @old = 1 .. 10000; # just a demo + for( @old ){ + my $r = rand @new+1; + push(@new,$new[$r]); + $new[$r] = $_; + } + +=head2 How do I process/modify each element of an array? + +Use C<for>/C<foreach>: + + for (@lines) { + s/foo/bar/; + tr[a-z][A-Z]; + } + +Here's another; let's compute spherical volumes: + + for (@radii) { + $_ **= 3; + $_ *= (4/3) * 3.14159; # this will be constant folded + } + +=head2 How do I select a random element from an array? + +Use the rand() function (see L<perlfunc/rand>): + + srand; # not needed for 5.004 and later + $index = rand @array; + $element = $array[$index]; + +=head2 How do I permute N elements of a list? + +Here's a little program that generates all permutations +of all the words on each line of input. The algorithm embodied +in the permut() function should work on any list: + + #!/usr/bin/perl -n + # permute - tchrist@perl.com + permut([split], []); + sub permut { + my @head = @{ $_[0] }; + my @tail = @{ $_[1] }; + unless (@head) { + # stop recursing when there are no elements in the head + print "@tail\n"; + } else { + # for all elements in @head, move one from @head to @tail + # and call permut() on the new @head and @tail + my(@newhead,@newtail,$i); + foreach $i (0 .. $#head) { + @newhead = @head; + @newtail = @tail; + unshift(@newtail, splice(@newhead, $i, 1)); + permut([@newhead], [@newtail]); + } + } + } + +=head2 How do I sort an array by (anything)? + +Supply a comparison function to sort() (described in L<perlfunc/sort>): + + @list = sort { $a <=> $b } @list; + +The default sort function is cmp, string comparison, which would +sort C<(1, 2, 10)> into C<(1, 10, 2)>. C<E<lt>=E<gt>>, used above, is +the numerical comparison operator. + +If you have a complicated function needed to pull out the part you +want to sort on, then don't do it inside the sort function. Pull it +out first, because the sort BLOCK can be called many times for the +same element. Here's an example of how to pull out the first word +after the first number on each item, and then sort those words +case-insensitively. + + @idx = (); + for (@data) { + ($item) = /\d+\s*(\S+)/; + push @idx, uc($item); + } + @sorted = @data[ sort { $idx[$a] cmp $idx[$b] } 0 .. $#idx ]; + +Which could also be written this way, using a trick +that's come to be known as the Schwartzian Transform: + + @sorted = map { $_->[0] } + sort { $a->[1] cmp $b->[1] } + map { [ $_, uc((/\d+\s*(\S+) )[0] ] } @data; + +If you need to sort on several fields, the following paradigm is useful. + + @sorted = sort { field1($a) <=> field1($b) || + field2($a) cmp field2($b) || + field3($a) cmp field3($b) + } @data; + +This can be conveniently combined with precalculation of keys as given +above. + +See http://www.perl.com/CPAN/doc/FMTEYEWTK/sort.html for more about +this approach. + +See also the question below on sorting hashes. + +=head2 How do I manipulate arrays of bits? + +Use pack() and unpack(), or else vec() and the bitwise operations. + +For example, this sets $vec to have bit N set if $ints[N] was set: + + $vec = ''; + foreach(@ints) { vec($vec,$_,1) = 1 } + +And here's how, given a vector in $vec, you can +get those bits into your @ints array: + + sub bitvec_to_list { + my $vec = shift; + my @ints; + # Find null-byte density then select best algorithm + if ($vec =~ tr/\0// / length $vec > 0.95) { + use integer; + my $i; + # This method is faster with mostly null-bytes + while($vec =~ /[^\0]/g ) { + $i = -9 + 8 * pos $vec; + push @ints, $i if vec($vec, ++$i, 1); + push @ints, $i if vec($vec, ++$i, 1); + push @ints, $i if vec($vec, ++$i, 1); + push @ints, $i if vec($vec, ++$i, 1); + push @ints, $i if vec($vec, ++$i, 1); + push @ints, $i if vec($vec, ++$i, 1); + push @ints, $i if vec($vec, ++$i, 1); + push @ints, $i if vec($vec, ++$i, 1); + } + } else { + # This method is a fast general algorithm + use integer; + my $bits = unpack "b*", $vec; + push @ints, 0 if $bits =~ s/^(\d)// && $1; + push @ints, pos $bits while($bits =~ /1/g); + } + return \@ints; + } + +This method gets faster the more sparse the bit vector is. +(Courtesy of Tim Bunce and Winfried Koenig.) + +=head2 Why does defined() return true on empty arrays and hashes? + +See L<perlfunc/defined> in the 5.004 release or later of Perl. + +=head1 Data: Hashes (Associative Arrays) + +=head2 How do I process an entire hash? + +Use the each() function (see L<perlfunc/each>) if you don't care +whether it's sorted: + + while (($key,$value) = each %hash) { + print "$key = $value\n"; + } + +If you want it sorted, you'll have to use foreach() on the result of +sorting the keys as shown in an earlier question. + +=head2 What happens if I add or remove keys from a hash while iterating over it? + +Don't do that. + +=head2 How do I look up a hash element by value? + +Create a reverse hash: + + %by_value = reverse %by_key; + $key = $by_value{$value}; + +That's not particularly efficient. It would be more space-efficient +to use: + + while (($key, $value) = each %by_key) { + $by_value{$value} = $key; + } + +If your hash could have repeated values, the methods above will only +find one of the associated keys. This may or may not worry you. + +=head2 How can I know how many entries are in a hash? + +If you mean how many keys, then all you have to do is +take the scalar sense of the keys() function: + + $num_keys = scalar keys %hash; + +In void context it just resets the iterator, which is faster +for tied hashes. + +=head2 How do I sort a hash (optionally by value instead of key)? + +Internally, hashes are stored in a way that prevents you from imposing +an order on key-value pairs. Instead, you have to sort a list of the +keys or values: + + @keys = sort keys %hash; # sorted by key + @keys = sort { + $hash{$a} cmp $hash{$b} + } keys %hash; # and by value + +Here we'll do a reverse numeric sort by value, and if two keys are +identical, sort by length of key, and if that fails, by straight ASCII +comparison of the keys (well, possibly modified by your locale -- see +L<perllocale>). + + @keys = sort { + $hash{$b} <=> $hash{$a} + || + length($b) <=> length($a) + || + $a cmp $b + } keys %hash; + +=head2 How can I always keep my hash sorted? + +You can look into using the DB_File module and tie() using the +$DB_BTREE hash bindings as documented in L<DB_File/"In Memory Databases">. + +=head2 What's the difference between "delete" and "undef" with hashes? + +Hashes are pairs of scalars: the first is the key, the second is the +value. The key will be coerced to a string, although the value can be +any kind of scalar: string, number, or reference. If a key C<$key> is +present in the array, C<exists($key)> will return true. The value for +a given key can be C<undef>, in which case C<$array{$key}> will be +C<undef> while C<$exists{$key}> will return true. This corresponds to +(C<$key>, C<undef>) being in the hash. + +Pictures help... here's the C<%ary> table: + + keys values + +------+------+ + | a | 3 | + | x | 7 | + | d | 0 | + | e | 2 | + +------+------+ + +And these conditions hold + + $ary{'a'} is true + $ary{'d'} is false + defined $ary{'d'} is true + defined $ary{'a'} is true + exists $ary{'a'} is true (perl5 only) + grep ($_ eq 'a', keys %ary) is true + +If you now say + + undef $ary{'a'} + +your table now reads: + + + keys values + +------+------+ + | a | undef| + | x | 7 | + | d | 0 | + | e | 2 | + +------+------+ + +and these conditions now hold; changes in caps: + + $ary{'a'} is FALSE + $ary{'d'} is false + defined $ary{'d'} is true + defined $ary{'a'} is FALSE + exists $ary{'a'} is true (perl5 only) + grep ($_ eq 'a', keys %ary) is true + +Notice the last two: you have an undef value, but a defined key! + +Now, consider this: + + delete $ary{'a'} + +your table now reads: + + keys values + +------+------+ + | x | 7 | + | d | 0 | + | e | 2 | + +------+------+ + +and these conditions now hold; changes in caps: + + $ary{'a'} is false + $ary{'d'} is false + defined $ary{'d'} is true + defined $ary{'a'} is false + exists $ary{'a'} is FALSE (perl5 only) + grep ($_ eq 'a', keys %ary) is FALSE + +See, the whole entry is gone! + +=head2 Why don't my tied hashes make the defined/exists distinction? + +They may or may not implement the EXISTS() and DEFINED() methods +differently. For example, there isn't the concept of undef with hashes +that are tied to DBM* files. This means the true/false tables above +will give different results when used on such a hash. It also means +that exists and defined do the same thing with a DBM* file, and what +they end up doing is not what they do with ordinary hashes. + +=head2 How do I reset an each() operation part-way through? + +Using C<keys %hash> in a scalar context returns the number of keys in +the hash I<and> resets the iterator associated with the hash. You may +need to do this if you use C<last> to exit a loop early so that when you +re-enter it, the hash iterator has been reset. + +=head2 How can I get the unique keys from two hashes? + +First you extract the keys from the hashes into arrays, and then solve +the uniquifying the array problem described above. For example: + + %seen = (); + for $element (keys(%foo), keys(%bar)) { + $seen{$element}++; + } + @uniq = keys %seen; + +Or more succinctly: + + @uniq = keys %{{%foo,%bar}}; + +Or if you really want to save space: + + %seen = (); + while (defined ($key = each %foo)) { + $seen{$key}++; + } + while (defined ($key = each %bar)) { + $seen{$key}++; + } + @uniq = keys %seen; + +=head2 How can I store a multidimensional array in a DBM file? + +Either stringify the structure yourself (no fun), or else +get the MLDBM (which uses Data::Dumper) module from CPAN and layer +it on top of either DB_File or GDBM_File. + +=head2 How can I make my hash remember the order I put elements into it? + +Use the Tie::IxHash from CPAN. + +=head2 Why does passing a subroutine an undefined element in a hash create it? + +If you say something like: + + somefunc($hash{"nonesuch key here"}); + +Then that element "autovivifies"; that is, it springs into existence +whether you store something there or not. That's because functions +get scalars passed in by reference. If somefunc() modifies C<$_[0]>, +it has to be ready to write it back into the caller's version. + +This has been fixed as of perl5.004. + +Normally, merely accessing a key's value for a nonexistent key does +I<not> cause that key to be forever there. This is different than +awk's behavior. + +=head2 How can I make the Perl equivalent of a C structure/C++ class/hash +or array of hashes or arrays? + +Use references (documented in L<perlref>). Examples of complex data +structures are given in L<perldsc> and L<perllol>. Examples of +structures and object-oriented classes are in L<perltoot>. + +=head2 How can I use a reference as a hash key? + +You can't do this directly, but you could use the standard Tie::Refhash +module distributed with perl. + +=head1 Data: Misc + +=head2 How do I handle binary data correctly? + +Perl is binary clean, so this shouldn't be a problem. For example, +this works fine (assuming the files are found): + + if (`cat /vmunix` =~ /gzip/) { + print "Your kernel is GNU-zip enabled!\n"; + } + +On some systems, however, you have to play tedious games with "text" +versus "binary" files. See L<perlfunc/"binmode">. + +If you're concerned about 8-bit ASCII data, then see L<perllocale>. + +If you want to deal with multi-byte characters, however, there are +some gotchas. See the section on Regular Expressions. + +=head2 How do I determine whether a scalar is a number/whole/integer/float? + +Assuming that you don't care about IEEE notations like "NaN" or +"Infinity", you probably just want to use a regular expression. + + warn "has nondigits" if /\D/; + warn "not a whole number" unless /^\d+$/; + warn "not an integer" unless /^-?\d+$/; # reject +3 + warn "not an integer" unless /^[+-]?\d+$/; + warn "not a decimal number" unless /^-?\d+\.?\d*$/; # rejects .2 + warn "not a decimal number" unless /^-?(?:\d+(?:\.\d*)?|\.\d+)$/; + warn "not a C float" + unless /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/; + +Or you could check out +http://www.perl.com/CPAN/modules/by-module/String/String-Scanf-1.1.tar.gz +instead. The POSIX module (part of the standard Perl distribution) +provides the C<strtol> and C<strtod> for converting strings to double +and longs, respectively. + +=head2 How do I keep persistent data across program calls? + +For some specific applications, you can use one of the DBM modules. +See L<AnyDBM_File>. More generically, you should consult the +FreezeThaw, Storable, or Class::Eroot modules from CPAN. + +=head2 How do I print out or copy a recursive data structure? + +The Data::Dumper module on CPAN is nice for printing out +data structures, and FreezeThaw for copying them. For example: + + use FreezeThaw qw(freeze thaw); + $new = thaw freeze $old; + +Where $old can be (a reference to) any kind of data structure you'd like. +It will be deeply copied. + +=head2 How do I define methods for every class/object? + +Use the UNIVERSAL class (see L<UNIVERSAL>). + +=head2 How do I verify a credit card checksum? + +Get the Business::CreditCard module from CPAN. + +=head1 AUTHOR AND COPYRIGHT + +Copyright (c) 1997 Tom Christiansen and Nathan Torkington. +All rights reserved. See L<perlfaq> for distribution information. diff --git a/pod/perlfaq5.pod b/pod/perlfaq5.pod new file mode 100644 index 0000000000..c36576ff7f --- /dev/null +++ b/pod/perlfaq5.pod @@ -0,0 +1,788 @@ +=head1 NAME + +perlfaq5 - Files and Formats ($Revision: 1.19 $) + +=head1 DESCRIPTION + +This section deals with I/O and the "f" issues: filehandles, flushing, +formats, and footers. + +=head2 How do I flush/unbuffer a filehandle? Why must I do this? + +The C standard I/O library (stdio) normally buffers characters sent to +devices. This is done for efficiency reasons, so that there isn't a +system call for each byte. Any time you use print() or write() in +Perl, you go though this buffering. syswrite() circumvents stdio and +buffering. + +In most stdio implementations, the type of buffering and the size of +the buffer varies according to the type of device. Disk files are block +buffered, often with a buffer size of more than 2k. Pipes and sockets +are often buffered with a buffer size between 1/2 and 2k. Serial devices +(e.g. modems, terminals) are normally line-buffered, and stdio sends +the entire line when it gets the newline. + +Perl does not support truly unbuffered output (except insofar as you can +C<syswrite(OUT, $char, 1)>). What it does instead support is "command +buffering", in which a physical write is performed after every output +command. This isn't as hard on your system as unbuffering, but does +get the output where you want it when you want it. + +If you expect characters to get to your device when you print them there, +you'll want to autoflush its handle, as in the older: + + use FileHandle; + open(DEV, "<+/dev/tty"); # ceci n'est pas une pipe + DEV->autoflush(1); + +or the newer IO::* modules: + + use IO::Handle; + open(DEV, ">/dev/printer"); # but is this? + DEV->autoflush(1); + +or even this: + + use IO::Socket; # this one is kinda a pipe? + $sock = IO::Socket::INET->new(PeerAddr => 'www.perl.com', + PeerPort => 'http(80)', + Proto => 'tcp'); + die "$!" unless $sock; + + $sock->autoflush(); + $sock->print("GET /\015\012"); + $document = join('', $sock->getlines()); + print "DOC IS: $document\n"; + +Note the hardcoded carriage return and newline in their octal +equivalents. This is the ONLY way (currently) to assure a proper +flush on all platforms, including Macintosh. + +You can use select() and the C<$|> variable to control autoflushing +(see L<perlvar/$|> and L<perlfunc/select>): + + $oldh = select(DEV); + $| = 1; + select($oldh); + +You'll also see code that does this without a temporary variable, as in + + select((select(DEV), $| = 1)[0]); + +=head2 How do I change one line in a file/delete a line in a file/insert a line in the middle of a file/append to the beginning of a file? + +Although humans have an easy time thinking of a text file as being a +sequence of lines that operates much like a stack of playing cards -- +or punch cards -- computers usually see the text file as a sequence of +bytes. In general, there's no direct way for Perl to seek to a +particular line of a file, insert text into a file, or remove text +from a file. + +(There are exceptions in special circumstances. Replacing a sequence +of bytes with another sequence of the same length is one. Another is +using the C<$DB_RECNO> array bindings as documented in L<DB_File>. +Yet another is manipulating files with all lines the same length.) + +The general solution is to create a temporary copy of the text file with +the changes you want, then copy that over the original. + + $old = $file; + $new = "$file.tmp.$$"; + $bak = "$file.bak"; + + open(OLD, "< $old") or die "can't open $old: $!"; + open(NEW, "> $new") or die "can't open $new: $!"; + + # Correct typos, preserving case + while (<OLD>) { + s/\b(p)earl\b/${1}erl/i; + (print NEW $_) or die "can't write to $new: $!"; + } + + close(OLD) or die "can't close $old: $!"; + close(NEW) or die "can't close $new: $!"; + + rename($old, $bak) or die "can't rename $old to $bak: $!"; + rename($new, $old) or die "can't rename $new to $old: $!"; + +Perl can do this sort of thing for you automatically with the C<-i> +command-line switch or the closely-related C<$^I> variable (see +L<perlrun> for more details). Note that +C<-i> may require a suffix on some non-Unix systems; see the +platform-specific documentation that came with your port. + + # Renumber a series of tests from the command line + perl -pi -e 's/(^\s+test\s+)\d+/ $1 . ++$count /e' t/op/taint.t + + # form a script + local($^I, @ARGV) = ('.bak', glob("*.c")); + while (<>) { + if ($. == 1) { + print "This line should appear at the top of each file\n"; + } + s/\b(p)earl\b/${1}erl/i; # Correct typos, preserving case + print; + close ARGV if eof; # Reset $. + } + +If you need to seek to an arbitrary line of a file that changes +infrequently, you could build up an index of byte positions of where +the line ends are in the file. If the file is large, an index of +every tenth or hundredth line end would allow you to seek and read +fairly efficiently. If the file is sorted, try the look.pl library +(part of the standard perl distribution). + +In the unique case of deleting lines at the end of a file, you +can use tell() and truncate(). The following code snippet deletes +the last line of a file without making a copy or reading the +whole file into memory: + + open (FH, "+< $file"); + while ( <FH> ) { $addr = tell(FH) unless eof(FH) } + truncate(FH, $addr); + +Error checking is left as an exercise for the reader. + +=head2 How do I count the number of lines in a file? + +One fairly efficient way is to count newlines in the file. The +following program uses a feature of tr///, as documented in L<perlop>. +If your text file doesn't end with a newline, then it's not really a +proper text file, so this may report one fewer line than you expect. + + $lines = 0; + open(FILE, $filename) or die "Can't open `$filename': $!"; + while (sysread FILE, $buffer, 4096) { + $lines += ($buffer =~ tr/\n//); + } + close FILE; + +=head2 How do I make a temporary file name? + +Use the process ID and/or the current time-value. If you need to have +many temporary files in one process, use a counter: + + BEGIN { + use IO::File; + use Fcntl; + my $temp_dir = -d '/tmp' ? '/tmp' : $ENV{TMP} || $ENV{TEMP}; + my $base_name = sprintf("%s/%d-%d-0000", $temp_dir, $$, time()); + sub temp_file { + my $fh = undef; + my $count = 0; + until (defined($fh) || $count > 100) { + $base_name =~ s/-(\d+)$/"-" . (1 + $1)/e; + $fh = IO::File->new($base_name, O_WRONLY|O_EXCL|O_CREAT, 0644) + } + if (defined($fh)) { + return ($fh, $base_name); + } else { + return (); + } + } + } + +Or you could simply use IO::Handle::new_tmpfile. + +=head2 How can I manipulate fixed-record-length files? + +The most efficient way is using pack() and unpack(). This is faster +than using substr(). Here is a sample chunk of code to break up and +put back together again some fixed-format input lines, in this case +from the output of a normal, Berkeley-style ps: + + # sample input line: + # 15158 p5 T 0:00 perl /home/tchrist/scripts/now-what + $PS_T = 'A6 A4 A7 A5 A*'; + open(PS, "ps|"); + $_ = <PS>; print; + while (<PS>) { + ($pid, $tt, $stat, $time, $command) = unpack($PS_T, $_); + for $var (qw!pid tt stat time command!) { + print "$var: <$$var>\n"; + } + print 'line=', pack($PS_T, $pid, $tt, $stat, $time, $command), + "\n"; + } + +=head2 How can I make a filehandle local to a subroutine? How do I pass filehandles between subroutines? How do I make an array of filehandles? + +You may have some success with typeglobs, as we always had to use +in days of old: + + local(*FH); + +But while still supported, that isn't the best to go about getting +local filehandles. Typeglobs have their drawbacks. You may well want +to use the C<FileHandle> module, which creates new filehandles for you +(see L<FileHandle>): + + use FileHandle; + sub findme { + my $fh = FileHandle->new(); + open($fh, "</etc/hosts") or die "no /etc/hosts: $!"; + while (<$fh>) { + print if /\b127\.(0\.0\.)?1\b/; + } + # $fh automatically closes/disappears here + } + +Internally, Perl believes filehandles to be of class IO::Handle. You +may use that module directly if you'd like (see L<IO::Handle>), or +one of its more specific derived classes. + +=head2 How can I set up a footer format to be used with write()? + +There's no built-in way to do this, but L<perlform> has a couple of +techniques to make it possible for the intrepid hacker. + +=head2 How can I write() into a string? + +See L<perlform> for an swrite() function. + +=head2 How can I output my numbers with commas added? + +This one will do it for you: + + sub commify { + local $_ = shift; + 1 while s/^(-?\d+)(\d{3})/$1,$2/; + return $_; + } + + $n = 23659019423.2331; + print "GOT: ", commify($n), "\n"; + + GOT: 23,659,019,423.2331 + +You can't just: + + s/^(-?\d+)(\d{3})/$1,$2/g; + +because you have to put the comma in and then recalculate your +position. + +=head2 How can I translate tildes (~) in a filename? + +Use the E<lt>E<gt> (glob()) operator, documented in L<perlfunc>. This +requires that you have a shell installed that groks tildes, meaning +csh or tcsh or (some versions of) ksh, and thus may have portability +problems. The Glob::KGlob module (available from CPAN) gives more +portable glob functionality. + +Within Perl, you may use this directly: + + $filename =~ s{ + ^ ~ # find a leading tilde + ( # save this in $1 + [^/] # a non-slash character + * # repeated 0 or more times (0 means me) + ) + }{ + $1 + ? (getpwnam($1))[7] + : ( $ENV{HOME} || $ENV{LOGDIR} ) + }ex; + +=head2 How come when I open the file read-write it wipes it out? + +Because you're using something like this, which truncates the file and +I<then> gives you read-write access: + + open(FH, "+> /path/name"); # WRONG + +Whoops. You should instead use this, which will fail if the file +doesn't exist. + + open(FH, "+< /path/name"); # open for update + +If this is an issue, try: + + sysopen(FH, "/path/name", O_RDWR|O_CREAT, 0644); + +Error checking is left as an exercise for the reader. + +=head2 Why do I sometimes get an "Argument list too long" when I use <*>? + +The C<E<lt>E<gt>> operator performs a globbing operation (see above). +By default glob() forks csh(1) to do the actual glob expansion, but +csh can't handle more than 127 items and so gives the error message +C<Argument list too long>. People who installed tcsh as csh won't +have this problem, but their users may be surprised by it. + +To get around this, either do the glob yourself with C<Dirhandle>s and +patterns, or use a module like Glob::KGlob, one that doesn't use the +shell to do globbing. + +=head2 Is there a leak/bug in glob()? + +Due to the current implementation on some operating systems, when you +use the glob() function or its angle-bracket alias in a scalar +context, you may cause a leak and/or unpredictable behavior. It's +best therefore to use glob() only in list context. + +=head2 How can I open a file with a leading "E<gt>" or trailing blanks? + +Normally perl ignores trailing blanks in filenames, and interprets +certain leading characters (or a trailing "|") to mean something +special. To avoid this, you might want to use a routine like this. +It makes incomplete pathnames into explicit relative ones, and tacks a +trailing null byte on the name to make perl leave it alone: + + sub safe_filename { + local $_ = shift; + return m#^/# + ? "$_\0" + : "./$_\0"; + } + + $fn = safe_filename("<<<something really wicked "); + open(FH, "> $fn") or "couldn't open $fn: $!"; + +You could also use the sysopen() function (see L<perlfunc/sysopen>). + +=head2 How can I reliably rename a file? + +Well, usually you just use Perl's rename() function. But that may +not work everywhere, in particular, renaming files across file systems. +If your operating system supports a mv(1) program or its moral equivalent, +this works: + + rename($old, $new) or system("mv", $old, $new); + +It may be more compelling to use the File::Copy module instead. You +just copy to the new file to the new name (checking return values), +then delete the old one. This isn't really the same semantics as a +real rename(), though, which preserves metainformation like +permissions, timestamps, inode info, etc. + +=head2 How can I lock a file? + +Perl's built-in flock() function (see L<perlfunc> for details) will call +flock(2) if that exists, fcntl(2) if it doesn't (on perl version 5.004 and +later), and lockf(3) if neither of the two previous system calls exists. +On some systems, it may even use a different form of native locking. +Here are some gotchas with Perl's flock(): + +=over 4 + +=item 1 + +Produces a fatal error if none of the three system calls (or their +close equivalent) exists. + +=item 2 + +lockf(3) does not provide shared locking, and requires that the +filehandle be open for writing (or appending, or read/writing). + +=item 3 + +Some versions of flock() can't lock files over a network (e.g. on NFS +file systems), so you'd need to force the use of fcntl(2) when you +build Perl. See the flock entry of L<perlfunc>, and the F<INSTALL> +file in the source distribution for information on building Perl to do +this. + +=back + +The CPAN module File::Lock offers similar functionality and (if you +have dynamic loading) won't require you to rebuild perl if your +flock() can't lock network files. + +=head2 What can't I just open(FH, ">file.lock")? + +A common bit of code B<NOT TO USE> is this: + + sleep(3) while -e "file.lock"; # PLEASE DO NOT USE + open(LCK, "> file.lock"); # THIS BROKEN CODE + +This is a classic race condition: you take two steps to do something +which must be done in one. That's why computer hardware provides an +atomic test-and-set instruction. In theory, this "ought" to work: + + sysopen(FH, "file.lock", O_WRONLY|O_EXCL|O_CREAT, 0644) + or die "can't open file.lock: $!": + +except that lamentably, file creation (and deletion) is not atomic +over NFS, so this won't work (at least, not every time) over the net. +Various schemes involving involving link() have been suggested, but +these tend to involve busy-wait, which is also subdesirable. + +=head2 I still don't get locking. I just want to increment the number +in the file. How can I do this? + +Didn't anyone ever tell you web-page hit counters were useless? + +Anyway, this is what to do: + + use Fcntl; + sysopen(FH, "numfile", O_RDWR|O_CREAT, 0644) or die "can't open numfile: $!"; + flock(FH, 2) or die "can't flock numfile: $!"; + $num = <FH> || 0; + seek(FH, 0, 0) or die "can't rewind numfile: $!"; + truncate(FH, 0) or die "can't truncate numfile: $!"; + (print FH $num+1, "\n") or die "can't write numfile: $!"; + # DO NOT UNLOCK THIS UNTIL YOU CLOSE + close FH or die "can't close numfile: $!"; + +Here's a much better web-page hit counter: + + $hits = int( (time() - 850_000_000) / rand(1_000) ); + +If the count doesn't impress your friends, then the code might. :-) + +=head2 How do I randomly update a binary file? + +If you're just trying to patch a binary, in many cases something as +simple as this works: + + perl -i -pe 's{window manager}{window mangler}g' /usr/bin/emacs + +However, if you have fixed sized records, then you might do something more +like this: + + $RECSIZE = 220; # size of record, in bytes + $recno = 37; # which record to update + open(FH, "+<somewhere") || die "can't update somewhere: $!"; + seek(FH, $recno * $RECSIZE, 0); + read(FH, $record, $RECSIZE) == $RECSIZE || die "can't read record $recno: $!"; + # munge the record + seek(FH, $recno * $RECSIZE, 0); + print FH $record; + close FH; + +Locking and error checking are left as an exercise for the reader. +Don't forget them, or you'll be quite sorry. + +Don't forget to set binmode() under DOS-like platforms when operating +on files that have anything other than straight text in them. See the +docs on open() and on binmode() for more details. + +=head2 How do I get a file's timestamp in perl? + +If you want to retrieve the time at which the file was last read, +written, or had its meta-data (owner, etc) changed, you use the B<-M>, +B<-A>, or B<-C> filetest operations as documented in L<perlfunc>. These +retrieve the age of the file (measured against the start-time of your +program) in days as a floating point number. To retrieve the "raw" +time in seconds since the epoch, you would call the stat function, +then use localtime(), gmtime(), or POSIX::strftime() to convert this +into human-readable form. + +Here's an example: + + $write_secs = (stat($file))[9]; + print "file $file updated at ", scalar(localtime($file)), "\n"; + +If you prefer something more legible, use the File::stat module +(part of the standard distribution in version 5.004 and later): + + use File::stat; + use Time::localtime; + $date_string = ctime(stat($file)->mtime); + print "file $file updated at $date_string\n"; + +Error checking is left as an exercise for the reader. + +=head2 How do I set a file's timestamp in perl? + +You use the utime() function documented in L<perlfunc/utime>. +By way of example, here's a little program that copies the +read and write times from its first argument to all the rest +of them. + + if (@ARGV < 2) { + die "usage: cptimes timestamp_file other_files ...\n"; + } + $timestamp = shift; + ($atime, $mtime) = (stat($timestamp))[8,9]; + utime $atime, $mtime, @ARGV; + +Error checking is left as an exercise for the reader. + +Note that utime() currently doesn't work correctly with Win95/NT +ports. A bug has been reported. Check it carefully before using +it on those platforms. + +=head2 How do I print to more than one file at once? + +If you only have to do this once, you can do this: + + for $fh (FH1, FH2, FH3) { print $fh "whatever\n" } + +To connect up to one filehandle to several output filehandles, it's +easiest to use the tee(1) program if you have it, and let it take care +of the multiplexing: + + open (FH, "| tee file1 file2 file3"); + +Otherwise you'll have to write your own multiplexing print function -- +or your own tee program -- or use Tom Christiansen's, at +http://www.perl.com/CPAN/authors/id/TOMC/scripts/tct.gz, which is +written in Perl. + +In theory a IO::Tee class could be written, but to date we haven't +seen such. + +=head2 How can I read in a file by paragraphs? + +Use the C<$\> variable (see L<perlvar> for details). You can either +set it to C<""> to eliminate empty paragraphs (C<"abc\n\n\n\ndef">, +for instance, gets treated as two paragraphs and not three), or +C<"\n\n"> to accept empty paragraphs. + +=head2 How can I read a single character from a file? From the keyboard? + +You can use the builtin C<getc()> function for most filehandles, but +it won't (easily) work on a terminal device. For STDIN, either use +the Term::ReadKey module from CPAN, or use the sample code in +L<perlfunc/getc>. + +If your system supports POSIX, you can use the following code, which +you'll note turns off echo processing as well. + + #!/usr/bin/perl -w + use strict; + $| = 1; + for (1..4) { + my $got; + print "gimme: "; + $got = getone(); + print "--> $got\n"; + } + exit; + + BEGIN { + use POSIX qw(:termios_h); + + my ($term, $oterm, $echo, $noecho, $fd_stdin); + + $fd_stdin = fileno(STDIN); + + $term = POSIX::Termios->new(); + $term->getattr($fd_stdin); + $oterm = $term->getlflag(); + + $echo = ECHO | ECHOK | ICANON; + $noecho = $oterm & ~$echo; + + sub cbreak { + $term->setlflag($noecho); + $term->setcc(VTIME, 1); + $term->setattr($fd_stdin, TCSANOW); + } + + sub cooked { + $term->setlflag($oterm); + $term->setcc(VTIME, 0); + $term->setattr($fd_stdin, TCSANOW); + } + + sub getone { + my $key = ''; + cbreak(); + sysread(STDIN, $key, 1); + cooked(); + return $key; + } + + } + + END { cooked() } + +The Term::ReadKey module from CPAN may be easier to use: + + use Term::ReadKey; + open(TTY, "</dev/tty"); + print "Gimme a char: "; + ReadMode "raw"; + $key = ReadKey 0, *TTY; + ReadMode "normal"; + printf "\nYou said %s, char number %03d\n", + $key, ord $key; + +For DOS systems, Dan Carson <dbc@tc.fluke.COM> reports the following: + +To put the PC in "raw" mode, use ioctl with some magic numbers gleaned +from msdos.c (Perl source file) and Ralf Brown's interrupt list (comes +across the net every so often): + + $old_ioctl = ioctl(STDIN,0,0); # Gets device info + $old_ioctl &= 0xff; + ioctl(STDIN,1,$old_ioctl | 32); # Writes it back, setting bit 5 + +Then to read a single character: + + sysread(STDIN,$c,1); # Read a single character + +And to put the PC back to "cooked" mode: + + ioctl(STDIN,1,$old_ioctl); # Sets it back to cooked mode. + +So now you have $c. If C<ord($c) == 0>, you have a two byte code, which +means you hit a special key. Read another byte with C<sysread(STDIN,$c,1)>, +and that value tells you what combination it was according to this +table: + + # PC 2-byte keycodes = ^@ + the following: + + # HEX KEYS + # --- ---- + # 0F SHF TAB + # 10-19 ALT QWERTYUIOP + # 1E-26 ALT ASDFGHJKL + # 2C-32 ALT ZXCVBNM + # 3B-44 F1-F10 + # 47-49 HOME,UP,PgUp + # 4B LEFT + # 4D RIGHT + # 4F-53 END,DOWN,PgDn,Ins,Del + # 54-5D SHF F1-F10 + # 5E-67 CTR F1-F10 + # 68-71 ALT F1-F10 + # 73-77 CTR LEFT,RIGHT,END,PgDn,HOME + # 78-83 ALT 1234567890-= + # 84 CTR PgUp + +This is all trial and error I did a long time ago, I hope I'm reading the +file that worked. + +=head2 How can I tell if there's a character waiting on a filehandle? + +You should check out the Frequently Asked Questions list in +comp.unix.* for things like this: the answer is essentially the same. +It's very system dependent. Here's one solution that works on BSD +systems: + + sub key_ready { + my($rin, $nfd); + vec($rin, fileno(STDIN), 1) = 1; + return $nfd = select($rin,undef,undef,0); + } + +You should look into getting the Term::ReadKey extension from CPAN. + +=head2 How do I open a file without blocking? + +You need to use the O_NDELAY or O_NONBLOCK flag from the Fcntl module +in conjunction with sysopen(): + + use Fcntl; + sysopen(FH, "/tmp/somefile", O_WRONLY|O_NDELAY|O_CREAT, 0644) + or die "can't open /tmp/somefile: $!": + +=head2 How do I create a file only if it doesn't exist? + +You need to use the O_CREAT and O_EXCL flags from the Fcntl module in +conjunction with sysopen(): + + use Fcntl; + sysopen(FH, "/tmp/somefile", O_WRONLY|O_EXCL|O_CREAT, 0644) + or die "can't open /tmp/somefile: $!": + +Be warned that neither creation nor deletion of files is guaranteed to +be an atomic operation over NFS. That is, two processes might both +successful create or unlink the same file! + +=head2 How do I do a C<tail -f> in perl? + +First try + + seek(GWFILE, 0, 1); + +The statement C<seek(GWFILE, 0, 1)> doesn't change the current position, +but it does clear the end-of-file condition on the handle, so that the +next <GWFILE> makes Perl try again to read something. + +If that doesn't work (it relies on features of your stdio implementation), +then you need something more like this: + + for (;;) { + for ($curpos = tell(GWFILE); <GWFILE>; $curpos = tell(GWFILE)) { + # search for some stuff and put it into files + } + # sleep for a while + seek(GWFILE, $curpos, 0); # seek to where we had been + } + +If this still doesn't work, look into the POSIX module. POSIX defines +the clearerr() method, which can remove the end of file condition on a +filehandle. The method: read until end of file, clearerr(), read some +more. Lather, rinse, repeat. + +=head2 How do I dup() a filehandle in Perl? + +If you check L<perlfunc/open>, you'll see that several of the ways +to call open() should do the trick. For example: + + open(LOG, ">>/tmp/logfile"); + open(STDERR, ">&LOG"); + +Or even with a literal numeric descriptor: + + $fd = $ENV{MHCONTEXTFD}; + open(MHCONTEXT, "<&=$fd"); # like fdopen(3S) + +Error checking has been left as an exercise for the reader. + +=head2 How do I close a file descriptor by number? + +This should rarely be necessary, as the Perl close() function is to be +used for things that Perl opened itself, even if it was a dup of a +numeric descriptor, as with MHCONTEXT above. But if you really have +to, you may be able to do this: + + require 'sys/syscall.ph'; + $rc = syscall(&SYS_close, $fd + 0); # must force numeric + die "can't sysclose $fd: $!" unless $rc == -1; + +=head2 Why can't I use "C:\temp\foo" in DOS paths? What doesn't `C:\temp\foo.exe` work? + +Whoops! You just put a tab and a formfeed into that filename! +Remember that within double quoted strings ("like\this"), the +backslash is an escape character. The full list of these is in +L<perlop/Quote and Quote-like Operators>. Unsurprisingly, you don't +have a file called "c:(tab)emp(formfeed)oo" or +"c:(tab)emp(formfeed)oo.exe" on your DOS filesystem. + +Either single-quote your strings, or (preferably) use forward slashes. +Since all DOS and Windows versions since something like MS-DOS 2.0 or so +have treated C</> and C<\> the same in a path, you might as well use the +one that doesn't clash with Perl -- or the POSIX shell, ANSI C and C++, +awk, Tcl, Java, or Python, just to mention a few. + +=head2 Why doesn't glob("*.*") get all the files? + +Because even on non-Unix ports, Perl's glob function follows standard +Unix globbing semantics. You'll need C<glob("*")> to get all (non-hidden) +files. + +=head2 Why does Perl let me delete read-only files? Why does C<-i> clobber protected files? Isn't this a bug in Perl? + +This is elaborately and painstakingly described in the "Far More Than +You Every Wanted To Know" in +http://www.perl.com/CPAN/doc/FMTEYEWTK/file-dir-perms . + +The executive summary: learn how your filesystem works. The +permissions on a file say what can happen to the data in that file. +The permissions on a directory say what can happen to the list of +files in that directory. If you delete a file, you're removing its +name from the directory (so the operation depends on the permissions +of the directory, not of the file). If you try to write to the file, +the permissions of the file govern whether you're allowed to. + +=head2 How do I select a random line from a file? + +Here's an algorithm from the Camel Book: + + srand; + rand($.) < 1 && ($line = $_) while <>; + +This has a significant advantage in space over reading the whole +file in. + +=head1 AUTHOR AND COPYRIGHT + +Copyright (c) 1997 Tom Christiansen and Nathan Torkington. +All rights reserved. See L<perlfaq> for distribution information. diff --git a/pod/perlfaq6.pod b/pod/perlfaq6.pod new file mode 100644 index 0000000000..589d89e495 --- /dev/null +++ b/pod/perlfaq6.pod @@ -0,0 +1,580 @@ +=head1 NAME + +perlfaq6 - Regexps ($Revision: 1.14 $) + +=head1 DESCRIPTION + +This section is surprisingly small because the rest of the FAQ is +littered with answers involving regular expressions. For example, +decoding a URL and checking whether something is a number are handled +with regular expressions, but those answers are found elsewhere in +this document (in the section on Data and the Networking one on +networking, to be precise). + +=head2 How can I hope to use regular expressions without creating illegible and unmaintainable code? + +Three techniques can make regular expressions maintainable and +understandable. + +=over 4 + +=item Comments Outside the Regexp + +Describe what you're doing and how you're doing it, using normal Perl +comments. + + # turn the line into the first word, a colon, and the + # number of characters on the rest of the line + s/^(\w+)(.*)/ lc($1) . ":" . length($2) /ge; + +=item Comments Inside the Regexp + +The C</x> modifier causes whitespace to be ignored in a regexp pattern +(except in a character class), and also allows you to use normal +comments there, too. As you can imagine, whitespace and comments help +a lot. + +C</x> lets you turn this: + + s{<(?:[^>'"]*|".*?"|'.*?')+>}{}gs; + +into this: + + s{ < # opening angle bracket + (?: # Non-backreffing grouping paren + [^>'"] * # 0 or more things that are neither > nor ' nor " + | # or else + ".*?" # a section between double quotes (stingy match) + | # or else + '.*?' # a section between single quotes (stingy match) + ) + # all occurring one or more times + > # closing angle bracket + }{}gsx; # replace with nothing, i.e. delete + +It's still not quite so clear as prose, but it is very useful for +describing the meaning of each part of the pattern. + +=item Different Delimiters + +While we normally think of patterns as being delimited with C</> +characters, they can be delimited by almost any character. L<perlre> +describes this. For example, the C<s///> above uses braces as +delimiters. Selecting another delimiter can avoid quoting the +delimiter within the pattern: + + s/\/usr\/local/\/usr\/share/g; # bad delimiter choice + s#/usr/local#/usr/share#g; # better + +=back + +=head2 I'm having trouble matching over more than one line. What's wrong? + +Either you don't have newlines in your string, or you aren't using the +correct modifier(s) on your pattern. + +There are many ways to get multiline data into a string. If you want +it to happen automatically while reading input, you'll want to set $/ +(probably to '' for paragraphs or C<undef> for the whole file) to +allow you to read more than one line at a time. + +Read L<perlre> to help you decide which of C</s> and C</m> (or both) +you might want to use: C</s> allows dot to include newline, and C</m> +allows caret and dollar to match next to a newline, not just at the +end of the string. You do need to make sure that you've actually +got a multiline string in there. + +For example, this program detects duplicate words, even when they span +line breaks (but not paragraph ones). For this example, we don't need +C</s> because we aren't using dot in a regular expression that we want +to cross line boundaries. Neither do we need C</m> because we aren't +wanting caret or dollar to match at any point inside the record next +to newlines. But it's imperative that $/ be set to something other +than the default, or else we won't actually ever have a multiline +record read in. + + $/ = ''; # read in more whole paragraph, not just one line + while ( <> ) { + while ( /\b(\w\S+)(\s+\1)+\b/gi ) { + print "Duplicate $1 at paragraph $.\n"; + } + } + +Here's code that finds sentences that begin with "From " (which would +be mangled by many mailers): + + $/ = ''; # read in more whole paragraph, not just one line + while ( <> ) { + while ( /^From /gm ) { # /m makes ^ match next to \n + print "leading from in paragraph $.\n"; + } + } + +Here's code that finds everything between START and END in a paragraph: + + undef $/; # read in whole file, not just one line or paragraph + while ( <> ) { + while ( /START(.*?)END/sm ) { # /s makes . cross line boundaries + print "$1\n"; + } + } + +=head2 How can I pull out lines between two patterns that are themselves on different lines? + +You can use Perl's somewhat exotic C<..> operator (documented in +L<perlop>): + + perl -ne 'print if /START/ .. /END/' file1 file2 ... + +If you wanted text and not lines, you would use + + perl -0777 -pe 'print "$1\n" while /START(.*?)END/gs' file1 file2 ... + +But if you want nested occurrences of C<START> through C<END>, you'll +run up against the problem described in the question in this section +on matching balanced text. + +=head2 I put a regular expression into $/ but it didn't work. What's wrong? + +$/ must be a string, not a regular expression. Awk has to be better +for something. :-) + +Actually, you could do this if you don't mind reading the whole file into + + undef $/; + @records = split /your_pattern/, <FH>; + +=head2 How do I substitute case insensitively on the LHS, but preserving case on the RHS? + +It depends on what you mean by "preserving case". The following +script makes the substitution have the same case, letter by letter, as +the original. If the substitution has more characters than the string +being substituted, the case of the last character is used for the rest +of the substitution. + + # Original by Nathan Torkington, massaged by Jeffrey Friedl + # + sub preserve_case($$) + { + my ($old, $new) = @_; + my ($state) = 0; # 0 = no change; 1 = lc; 2 = uc + my ($i, $oldlen, $newlen, $c) = (0, length($old), length($new)); + my ($len) = $oldlen < $newlen ? $oldlen : $newlen; + + for ($i = 0; $i < $len; $i++) { + if ($c = substr($old, $i, 1), $c =~ /[\W\d_]/) { + $state = 0; + } elsif (lc $c eq $c) { + substr($new, $i, 1) = lc(substr($new, $i, 1)); + $state = 1; + } else { + substr($new, $i, 1) = uc(substr($new, $i, 1)); + $state = 2; + } + } + # finish up with any remaining new (for when new is longer than old) + if ($newlen > $oldlen) { + if ($state == 1) { + substr($new, $oldlen) = lc(substr($new, $oldlen)); + } elsif ($state == 2) { + substr($new, $oldlen) = uc(substr($new, $oldlen)); + } + } + return $new; + } + + $a = "this is a TEsT case"; + $a =~ s/(test)/preserve_case($1, "success")/gie; + print "$a\n"; + +This prints: + + this is a SUcCESS case + +=head2 How can I make C<\w> match accented characters? + +See L<perllocale>. + +=head2 How can I match a locale-smart version of C</[a-zA-Z]/>? + +One alphabetic character would be C</[^\W\d_]/>, no matter what locale +you're in. Non-alphabetics would be C</[\W\d_]/> (assuming you don't +consider an underscore a letter). + +=head2 How can I quote a variable to use in a regexp? + +The Perl parser will expand $variable and @variable references in +regular expressions unless the delimiter is a single quote. Remember, +too, that the right-hand side of a C<s///> substitution is considered +a double-quoted string (see L<perlop> for more details). Remember +also that any regexp special characters will be acted on unless you +precede the substitution with \Q. Here's an example: + + $string = "to die?"; + $lhs = "die?"; + $rhs = "sleep no more"; + + $string =~ s/\Q$lhs/$rhs/; + # $string is now "to sleep no more" + +Without the \Q, the regexp would also spuriously match "di". + +=head2 What is C</o> really for? + +Using a variable in a regular expression match forces a re-evaluation +(and perhaps recompilation) each time through. The C</o> modifier +locks in the regexp the first time it's used. This always happens in a +constant regular expression, and in fact, the pattern was compiled +into the internal format at the same time your entire program was. + +Use of C</o> is irrelevant unless variable interpolation is used in +the pattern, and if so, the regexp engine will neither know nor care +whether the variables change after the pattern is evaluated the I<very +first> time. + +C</o> is often used to gain an extra measure of efficiency by not +performing subsequent evaluations when you know it won't matter +(because you know the variables won't change), or more rarely, when +you don't want the regexp to notice if they do. + +For example, here's a "paragrep" program: + + $/ = ''; # paragraph mode + $pat = shift; + while (<>) { + print if /$pat/o; + } + +=head2 How do I use a regular expression to strip C style comments from a file? + +While this actually can be done, it's much harder than you'd think. +For example, this one-liner + + perl -0777 -pe 's{/\*.*?\*/}{}gs' foo.c + +will work in many but not all cases. You see, it's too simple-minded for +certain kinds of C programs, in particular, those with what appear to be +comments in quoted strings. For that, you'd need something like this, +created by Jeffrey Friedl: + + $/ = undef; + $_ = <>; + s#/\*[^*]*\*+([^/*][^*]*\*+)*/|("(\\.|[^"\\])*"|'(\\.|[^'\\])*'|\n+|.[^/"'\\]*)#$2#g; + print; + +This could, of course, be more legibly written with the C</x> modifier, adding +whitespace and comments. + +=head2 Can I use Perl regular expressions to match balanced text? + +Although Perl regular expressions are more powerful than "mathematical" +regular expressions, because they feature conveniences like backreferences +(C<\1> and its ilk), they still aren't powerful enough. You still need +to use non-regexp techniques to parse balanced text, such as the text +enclosed between matching parentheses or braces, for example. + +An elaborate subroutine (for 7-bit ASCII only) to pull out balanced +and possibly nested single chars, like C<`> and C<'>, C<{> and C<}>, +or C<(> and C<)> can be found in +http://www.perl.com/CPAN/authors/id/TOMC/scripts/pull_quotes.gz . + +The C::Scan module from CPAN contains such subs for internal usage, +but they are undocumented. + +=head2 What does it mean that regexps are greedy? How can I get around it? + +Most people mean that greedy regexps match as much as they can. +Technically speaking, it's actually the quantifiers (C<?>, C<*>, C<+>, +C<{}>) that are greedy rather than the whole pattern; Perl prefers local +greed and immediate gratification to overall greed. To get non-greedy +versions of the same quantifiers, use (C<??>, C<*?>, C<+?>, C<{}?>). + +An example: + + $s1 = $s2 = "I am very very cold"; + $s1 =~ s/ve.*y //; # I am cold + $s2 =~ s/ve.*?y //; # I am very cold + +Notice how the second substitution stopped matching as soon as it +encountered "y ". The C<*?> quantifier effectively tells the regular +expression engine to find a match as quickly as possible and pass +control on to whatever is next in line, like you would if you were +playing hot potato. + +=head2 How do I process each word on each line? + +Use the split function: + + while (<>) { + foreach $word ( split ) { + # do something with $word here + } + } + +Note that this isn't really a word in the English sense; it's just +chunks of consecutive non-whitespace characters. + +To work with only alphanumeric sequences, you might consider + + while (<>) { + foreach $word (m/(\w+)/g) { + # do something with $word here + } + } + +=head2 How can I print out a word-frequency or line-frequency summary? + +To do this, you have to parse out each word in the input stream. We'll +pretend that by word you mean chunk of alphabetics, hyphens, or +apostrophes, rather than the non-whitespace chunk idea of a word given +in the previous question: + + while (<>) { + while ( /(\b[^\W_\d][\w'-]+\b)/g ) { # misses "`sheep'" + $seen{$1}++; + } + } + while ( ($word, $count) = each %seen ) { + print "$count $word\n"; + } + +If you wanted to do the same thing for lines, you wouldn't need a +regular expression: + + while (<>) { + $seen{$_}++; + } + while ( ($line, $count) = each %seen ) { + print "$count $line"; + } + +If you want these output in a sorted order, see the section on Hashes. + +=head2 How can I do approximate matching? + +See the module String::Approx available from CPAN. + +=head2 How do I efficiently match many regular expressions at once? + +The following is super-inefficient: + + while (<FH>) { + foreach $pat (@patterns) { + if ( /$pat/ ) { + # do something + } + } + } + +Instead, you either need to use one of the experimental Regexp extension +modules from CPAN (which might well be overkill for your purposes), +or else put together something like this, inspired from a routine +in Jeffrey Friedl's book: + + sub _bm_build { + my $condition = shift; + my @regexp = @_; # this MUST not be local(); need my() + my $expr = join $condition => map { "m/\$regexp[$_]/o" } (0..$#regexp); + my $match_func = eval "sub { $expr }"; + die if $@; # propagate $@; this shouldn't happen! + return $match_func; + } + + sub bm_and { _bm_build('&&', @_) } + sub bm_or { _bm_build('||', @_) } + + $f1 = bm_and qw{ + xterm + (?i)window + }; + + $f2 = bm_or qw{ + \b[Ff]ree\b + \bBSD\B + (?i)sys(tem)?\s*[V5]\b + }; + + # feed me /etc/termcap, prolly + while ( <> ) { + print "1: $_" if &$f1; + print "2: $_" if &$f2; + } + +=head2 Why don't word-boundary searches with C<\b> work for me? + +Two common misconceptions are that C<\b> is a synonym for C<\s+>, and +that it's the edge between whitespace characters and non-whitespace +characters. Neither is correct. C<\b> is the place between a C<\w> +character and a C<\W> character (that is, C<\b> is the edge of a +"word"). It's a zero-width assertion, just like C<^>, C<$>, and all +the other anchors, so it doesn't consume any characters. L<perlre> +describes the behaviour of all the regexp metacharacters. + +Here are examples of the incorrect application of C<\b>, with fixes: + + "two words" =~ /(\w+)\b(\w+)/; # WRONG + "two words" =~ /(\w+)\s+(\w+)/; # right + + " =matchless= text" =~ /\b=(\w+)=\b/; # WRONG + " =matchless= text" =~ /=(\w+)=/; # right + +Although they may not do what you thought they did, C<\b> and C<\B> +can still be quite useful. For an example of the correct use of +C<\b>, see the example of matching duplicate words over multiple +lines. + +An example of using C<\B> is the pattern C<\Bis\B>. This will find +occurrences of "is" on the insides of words only, as in "thistle", but +not "this" or "island". + +=head2 Why does using $&, $`, or $' slow my program down? + +Because once Perl sees that you need one of these variables anywhere +in the program, it has to provide them on each and every pattern +match. The same mechanism that handles these provides for the use of +$1, $2, etc., so you pay the same price for each regexp that contains +capturing parentheses. But if you never use $&, etc., in your script, +then regexps I<without> capturing parentheses won't be penalized. So +avoid $&, $', and $` if you can, but if you can't (and some algorithms +really appreciate them), once you've used them once, use them at will, +because you've already paid the price. + +=head2 What good is C<\G> in a regular expression? + +The notation C<\G> is used in a match or substitution in conjunction the +C</g> modifier (and ignored if there's no C</g>) to anchor the regular +expression to the point just past where the last match occurred, i.e. the +pos() point. + +For example, suppose you had a line of text quoted in standard mail +and Usenet notation, (that is, with leading C<E<gt>> characters), and +you want change each leading C<E<gt>> into a corresponding C<:>. You +could do so in this way: + + s/^(>+)/':' x length($1)/gem; + +Or, using C<\G>, the much simpler (and faster): + + s/\G>/:/g; + +A more sophisticated use might involve a tokenizer. The following +lex-like example is courtesy of Jeffrey Friedl. It did not work in +5.003 due to bugs in that release, but does work in 5.004 or better: + + while (<>) { + chomp; + PARSER: { + m/ \G( \d+\b )/gx && do { print "number: $1\n"; redo; }; + m/ \G( \w+ )/gx && do { print "word: $1\n"; redo; }; + m/ \G( \s+ )/gx && do { print "space: $1\n"; redo; }; + m/ \G( [^\w\d]+ )/gx && do { print "other: $1\n"; redo; }; + } + } + +Of course, that could have been written as + + while (<>) { + chomp; + PARSER: { + if ( /\G( \d+\b )/gx { + print "number: $1\n"; + redo PARSER; + } + if ( /\G( \w+ )/gx { + print "word: $1\n"; + redo PARSER; + } + if ( /\G( \s+ )/gx { + print "space: $1\n"; + redo PARSER; + } + if ( /\G( [^\w\d]+ )/gx { + print "other: $1\n"; + redo PARSER; + } + } + } + +But then you lose the vertical alignment of the regular expressions. + +=head2 Are Perl regexps DFAs or NFAs? Are they POSIX compliant? + +While it's true that Perl's regular expressions resemble the DFAs +(deterministic finite automata) of the egrep(1) program, they are in +fact implemented as NFAs (non-deterministic finite automata) to allow +backtracking and backreferencing. And they aren't POSIX-style either, +because those guarantee worst-case behavior for all cases. (It seems +that some people prefer guarantees of consistency, even when what's +guaranteed is slowness.) See the book "Mastering Regular Expressions" +(from O'Reilly) by Jeffrey Friedl for all the details you could ever +hope to know on these matters (a full citation appears in +L<perlfaq2>). + +=head2 What's wrong with using grep or map in a void context? + +Strictly speaking, nothing. Stylistically speaking, it's not a good +way to write maintainable code. That's because you're using these +constructs not for their return values but rather for their +side-effects, and side-effects can be mystifying. There's no void +grep() that's not better written as a C<for> (well, C<foreach>, +technically) loop. + +=head2 How can I match strings with multi-byte characters? + +This is hard, and there's no good way. Perl does not directly support +wide characters. It pretends that a byte and a character are +synonymous. The following set of approaches was offered by Jeffrey +Friedl, whose article in issue #5 of The Perl Journal talks about this +very matter. + +Let's suppose you have some weird Martian encoding where pairs of ASCII +uppercase letters encode single Martian letters (i.e. the two bytes +"CV" make a single Martian letter, as do the two bytes "SG", "VS", +"XX", etc.). Other bytes represent single characters, just like ASCII. + +So, the string of Martian "I am CVSGXX!" uses 12 bytes to encode the nine +characters 'I', ' ', 'a', 'm', ' ', 'CV', 'SG', 'XX', '!'. + +Now, say you want to search for the single character C</GX/>. Perl +doesn't know about Martian, so it'll find the two bytes "GX" in the +"I am CVSGXX!" string, even though that character isn't there: it just +looks like it is because "SG" is next to "XX", but there's no real "GX". +This is a big problem. + +Here are a few ways, all painful, to deal with it: + + $martian =~ s/([A-Z][A-Z])/ $1 /g; # Make sure adjacent ``maritan'' bytes + # are no longer adjacent. + print "found GX!\n" if $martian =~ /GX/; + +Or like this: + + @chars = $martian =~ m/([A-Z][A-Z]|[^A-Z])/g; + # above is conceptually similar to: @chars = $text =~ m/(.)/g; + # + foreach $char (@chars) { + print "found GX!\n", last if $char eq 'GX'; + } + +Or like this: + + while ($martian =~ m/\G([A-Z][A-Z]|.)/gs) { # \G probably unneeded + print "found GX!\n", last if $1 eq 'GX'; + } + +Or like this: + + die "sorry, Perl doesn't (yet) have Martian support )-:\n"; + +In addition, a sample program which converts half-width to full-width +katakana (in Shift-JIS or EUC encoding) is available from CPAN as + +=for Tom make it so + +There are many double- (and multi-) byte encodings commonly used these +days. Some versions of these have 1-, 2-, 3-, and 4-byte characters, +all mixed. + +=head1 AUTHOR AND COPYRIGHT + +Copyright (c) 1997 Tom Christiansen and Nathan Torkington. +All rights reserved. See L<perlfaq> for distribution information. diff --git a/pod/perlfaq7.pod b/pod/perlfaq7.pod new file mode 100644 index 0000000000..14bfc678fc --- /dev/null +++ b/pod/perlfaq7.pod @@ -0,0 +1,675 @@ +=head1 NAME + +perlfaq7 - Perl Language Issues ($Revision: 1.15 $) + +=head1 DESCRIPTION + +This section deals with general Perl language issues that don't +clearly fit into any of the other sections. + +=head2 Can I get a BNF/yacc/RE for the Perl language? + +No, in the words of Chaim Frenkel: "Perl's grammar can not be reduced +to BNF. The work of parsing perl is distributed between yacc, the +lexer, smoke and mirrors." + +=head2 What are all these $@%* punctuation signs, and how do I know when to use them? + +They are type specifiers, as detailed in L<perldata>: + + $ for scalar values (number, string or reference) + @ for arrays + % for hashes (associative arrays) + * for all types of that symbol name. In version 4 you used them like + pointers, but in modern perls you can just use references. + +While there are a few places where you don't actually need these type +specifiers, you should always use them. + +A couple of others that you're likely to encounter that aren't +really type specifiers are: + + <> are used for inputting a record from a filehandle. + \ takes a reference to something. + +Note that E<lt>FILEE<gt> is I<neither> the type specifier for files +nor the name of the handle. It is the C<E<lt>E<gt>> operator applied +to the handle FILE. It reads one line (well, record - see +L<perlvar/$/>) from the handle FILE in scalar context, or I<all> lines +in list context. When performing open, close, or any other operation +besides C<E<lt>E<gt>> on files, or even talking about the handle, do +I<not> use the brackets. These are correct: C<eof(FH)>, C<seek(FH, 0, +2)> and "copying from STDIN to FILE". + +=head2 Do I always/never have to quote my strings or use semicolons and commas? + +Normally, a bareword doesn't need to be quoted, but in most cases +probably should be (and must be under C<use strict>). But a hash key +consisting of a simple word (that isn't the name of a defined +subroutine) and the left-hand operand to the C<=E<gt>> operator both +count as though they were quoted: + + This is like this + ------------ --------------- + $foo{line} $foo{"line"} + bar => stuff "bar" => stuff + +The final semicolon in a block is optional, as is the final comma in a +list. Good style (see L<perlstyle>) says to put them in except for +one-liners: + + if ($whoops) { exit 1 } + @nums = (1, 2, 3); + + if ($whoops) { + exit 1; + } + @lines = ( + "There Beren came from mountains cold", + "And lost he wandered under leaves", + ); + +=head2 How do I skip some return values? + +One way is to treat the return values as a list and index into it: + + $dir = (getpwnam($user))[7]; + +Another way is to use undef as an element on the left-hand-side: + + ($dev, $ino, undef, undef, $uid, $gid) = stat($file); + +=head2 How do I temporarily block warnings? + +The C<$^W> variable (documented in L<perlvar>) controls +runtime warnings for a block: + + { + local $^W = 0; # temporarily turn off warnings + $a = $b + $c; # I know these might be undef + } + +Note that like all the punctuation variables, you cannot currently +use my() on C<$^W>, only local(). + +A new C<use warnings> pragma is in the works to provide finer control +over all this. The curious should check the perl5-porters mailing list +archives for details. + +=head2 What's an extension? + +A way of calling compiled C code from Perl. Reading L<perlxstut> +is a good place to learn more about extensions. + +=head2 Why do Perl operators have different precedence than C operators? + +Actually, they don't. All C operators that Perl copies have the same +precedence in Perl as they do in C. The problem is with operators that C +doesn't have, especially functions that give a list context to everything +on their right, eg print, chmod, exec, and so on. Such functions are +called "list operators" and appear as such in the precedence table in +L<perlop>. + +A common mistake is to write: + + unlink $file || die "snafu"; + +This gets interpreted as: + + unlink ($file || die "snafu"); + +To avoid this problem, either put in extra parentheses or use the +super low precedence C<or> operator: + + (unlink $file) || die "snafu"; + unlink $file or die "snafu"; + +The "English" operators (C<and>, C<or>, C<xor>, and C<not>) +deliberately have precedence lower than that of list operators for +just such situations as the one above. + +Another operator with surprising precedence is exponentiation. It +binds more tightly even than unary minus, making C<-2**2> product a +negative not a positive four. It is also right-associating, meaning +that C<2**3**2> is two raised to the ninth power, not eight squared. + +=head2 How do I declare/create a structure? + +In general, you don't "declare" a structure. Just use a (probably +anonymous) hash reference. See L<perlref> and L<perldsc> for details. +Here's an example: + + $person = {}; # new anonymous hash + $person->{AGE} = 24; # set field AGE to 24 + $person->{NAME} = "Nat"; # set field NAME to "Nat" + +If you're looking for something a bit more rigorous, try L<perltoot>. + +=head2 How do I create a module? + +A module is a package that lives in a file of the same name. For +example, the Hello::There module would live in Hello/There.pm. For +details, read L<perlmod>. You'll also find L<Exporter> helpful. If +you're writing a C or mixed-language module with both C and Perl, then +you should study L<perlxstut>. + +Here's a convenient template you might wish you use when starting your +own module. Make sure to change the names appropriately. + + package Some::Module; # assumes Some/Module.pm + + use strict; + + BEGIN { + use Exporter (); + use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + + ## set the version for version checking; uncomment to use + ## $VERSION = 1.00; + + # if using RCS/CVS, this next line may be preferred, + # but beware two-digit versions. + $VERSION = do{my@r=q$Revision: 1.15 $=~/\d+/g;sprintf '%d.'.'%02d'x$#r,@r}; + + @ISA = qw(Exporter); + @EXPORT = qw(&func1 &func2 &func3); + %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], + + # your exported package globals go here, + # as well as any optionally exported functions + @EXPORT_OK = qw($Var1 %Hashit); + } + use vars @EXPORT_OK; + + # non-exported package globals go here + use vars qw( @more $stuff ); + + # initialize package globals, first exported ones + $Var1 = ''; + %Hashit = (); + + # then the others (which are still accessible as $Some::Module::stuff) + $stuff = ''; + @more = (); + + # all file-scoped lexicals must be created before + # the functions below that use them. + + # file-private lexicals go here + my $priv_var = ''; + my %secret_hash = (); + + # here's a file-private function as a closure, + # callable as &$priv_func; it cannot be prototyped. + my $priv_func = sub { + # stuff goes here. + }; + + # make all your functions, whether exported or not; + # remember to put something interesting in the {} stubs + sub func1 {} # no prototype + sub func2() {} # proto'd void + sub func3($$) {} # proto'd to 2 scalars + + # this one isn't exported, but could be called! + sub func4(\%) {} # proto'd to 1 hash ref + + END { } # module clean-up code here (global destructor) + + 1; # modules must return true + +=head2 How do I create a class? + +See L<perltoot> for an introduction to classes and objects, as well as +L<perlobj> and L<perlbot>. + +=head2 How can I tell if a variable is tainted? + +See L<perlsec/"Laundering and Detecting Tainted Data">. Here's an +example (which doesn't use any system calls, because the kill() +is given no processes to signal): + + sub is_tainted { + return ! eval { join('',@_), kill 0; 1; }; + } + +This is not C<-w> clean, however. There is no C<-w> clean way to +detect taintedness - take this as a hint that you should untaint +all possibly-tainted data. + +=head2 What's a closure? + +Closures are documented in L<perlref>. + +I<Closure> is a computer science term with a precise but +hard-to-explain meaning. Closures are implemented in Perl as anonymous +subroutines with lasting references to lexical variables outside their +own scopes. These lexicals magically refer to the variables that were +around when the subroutine was defined (deep binding). + +Closures make sense in any programming language where you can have the +return value of a function be itself a function, as you can in Perl. +Note that some languages provide anonymous functions but are not +capable of providing proper closures; the Python language, for +example. For more information on closures, check out any textbook on +functional programming. Scheme is a language that not only supports +but encourages closures. + +Here's a classic function-generating function: + + sub add_function_generator { + return sub { shift + shift }; + } + + $add_sub = add_function_generator(); + $sum = &$add_sub(4,5); # $sum is 9 now. + +The closure works as a I<function template> with some customization +slots left out to be filled later. The anonymous subroutine returned +by add_function_generator() isn't technically a closure because it +refers to no lexicals outside its own scope. + +Contrast this with the following make_adder() function, in which the +returned anonymous function contains a reference to a lexical variable +outside the scope of that function itself. Such a reference requires +that Perl return a proper closure, thus locking in for all time the +value that the lexical had when the function was created. + + sub make_adder { + my $addpiece = shift; + return sub { shift + $addpiece }; + } + + $f1 = make_adder(20); + $f2 = make_adder(555); + +Now C<&$f1($n)> is always 20 plus whatever $n you pass in, whereas +C<&$f2($n)> is always 555 plus whatever $n you pass in. The $addpiece +in the closure sticks around. + +Closures are often used for less esoteric purposes. For example, when +you want to pass in a bit of code into a function: + + my $line; + timeout( 30, sub { $line = <STDIN> } ); + +If the code to execute had been passed in as a string, C<'$line = +E<lt>STDINE<gt>'>, there would have been no way for the hypothetical +timeout() function to access the lexical variable $line back in its +caller's scope. + +=head2 How can I pass/return a {Function, FileHandle, Array, Hash, Method, Regexp}? + +With the exception of regexps, you need to pass references to these +objects. See L<perlsub/"Pass by Reference"> for this particular +question, and L<perlref> for information on references. + +=over 4 + +=item Passing Variables and Functions + +Regular variables and functions are quite easy: just pass in a +reference to an existing or anonymous variable or function: + + func( \$some_scalar ); + + func( \$some_array ); + func( [ 1 .. 10 ] ); + + func( \%some_hash ); + func( { this => 10, that => 20 } ); + + func( \&some_func ); + func( sub { $_[0] ** $_[1] } ); + +=item Passing Filehandles + +To create filehandles you can pass to subroutines, you can use C<*FH> +or C<\*FH> notation ("typeglobs" - see L<perldata> for more information), +or create filehandles dynamically using the old FileHandle or the new +IO::File modules, both part of the standard Perl distribution. + + use Fcntl; + use IO::File; + my $fh = new IO::File $filename, O_WRONLY|O_APPEND; + or die "Can't append to $filename: $!"; + func($fh); + +=item Passing Regexps + +To pass regexps around, you'll need to either use one of the highly +experimental regular expression modules from CPAN (Nick Ing-Simmons's +Regexp or Ilya Zakharevich's Devel::Regexp), pass around strings +and use an exception-trapping eval, or else be be very, very clever. +Here's an example of how to pass in a string to be regexp compared: + + sub compare($$) { + my ($val1, $regexp) = @_; + my $retval = eval { $val =~ /$regexp/ }; + die if $@; + return $retval; + } + + $match = compare("old McDonald", q/d.*D/); + +Make sure you never say something like this: + + return eval "\$val =~ /$regexp/"; # WRONG + +or someone can sneak shell escapes into the regexp due to the double +interpolation of the eval and the double-quoted string. For example: + + $pattern_of_evil = 'danger ${ system("rm -rf * &") } danger'; + + eval "\$string =~ /$pattern_of_evil/"; + +Those preferring to be very, very clever might see the O'Reilly book, +I<Mastering Regular Expressions>, by Jeffrey Friedl. Page 273's +Build_MatchMany_Function() is particularly interesting. A complete +citation of this book is given in L<perlfaq2>. + +=item Passing Methods + +To pass an object method into a subroutine, you can do this: + + call_a_lot(10, $some_obj, "methname") + sub call_a_lot { + my ($count, $widget, $trick) = @_; + for (my $i = 0; $i < $count; $i++) { + $widget->$trick(); + } + } + +or you can use a closure to bundle up the object and its method call +and arguments: + + my $whatnot = sub { $some_obj->obfuscate(@args) }; + func($whatnot); + sub func { + my $code = shift; + &$code(); + } + +You could also investigate the can() method in the UNIVERSAL class +(part of the standard perl distribution). + +=back + +=head2 How do I create a static variable? + +As with most things in Perl, TMTOWTDI. What is a "static variable" in +other languages could be either a function-private variable (visible +only within a single function, retaining its value between calls to +that function), or a file-private variable (visible only to functions +within the file it was declared in) in Perl. + +Here's code to implement a function-private variable: + + BEGIN { + my $counter = 42; + sub prev_counter { return --$counter } + sub next_counter { return $counter++ } + } + +Now prev_counter() and next_counter() share a private variable $counter +that was initialized at compile time. + +To declare a file-private variable, you'll still use a my(), putting +it at the outer scope level at the top of the file. Assume this is in +file Pax.pm: + + package Pax; + my $started = scalar(localtime(time())); + + sub begun { return $started } + +When C<use Pax> or C<require Pax> loads this module, the variable will +be initialized. It won't get garbage-collected the way most variables +going out of scope do, because the begun() function cares about it, +but no one else can get it. It is not called $Pax::started because +its scope is unrelated to the package. It's scoped to the file. You +could conceivably have several packages in that same file all +accessing the same private variable, but another file with the same +package couldn't get to it. + +=head2 What's the difference between dynamic and lexical (static) scoping? Between local() and my()? + +C<local($x)> saves away the old value of the global variable C<$x>, +and assigns a new value for the duration of the subroutine, I<which is +visible in other functions called from that subroutine>. This is done +at run-time, so is called dynamic scoping. local() always affects global +variables, also called package variables or dynamic variables. + +C<my($x)> creates a new variable that is only visible in the current +subroutine. This is done at compile-time, so is called lexical or +static scoping. my() always affects private variables, also called +lexical variables or (improperly) static(ly scoped) variables. + +For instance: + + sub visible { + print "var has value $var\n"; + } + + sub dynamic { + local $var = 'local'; # new temporary value for the still-global + visible(); # variable called $var + } + + sub lexical { + my $var = 'private'; # new private variable, $var + visible(); # (invisible outside of sub scope) + } + + $var = 'global'; + + visible(); # prints global + dynamic(); # prints local + lexical(); # prints global + +Notice how at no point does the value "private" get printed. That's +because $var only has that value within the block of the lexical() +function, and it is hidden from called subroutine. + +In summary, local() doesn't make what you think of as private, local +variables. It gives a global variable a temporary value. my() is +what you're looking for if you want private variables. + +See also L<perlsub>, which explains this all in more detail. + +=head2 How can I access a dynamic variable while a similarly named lexical is in scope? + +You can do this via symbolic references, provided you haven't set +C<use strict "refs">. So instead of $var, use C<${'var'}>. + + local $var = "global"; + my $var = "lexical"; + + print "lexical is $var\n"; + + no strict 'refs'; + print "global is ${'var'}\n"; + +If you know your package, you can just mention it explicitly, as in +$Some_Pack::var. Note that the notation $::var is I<not> the dynamic +$var in the current package, but rather the one in the C<main> +package, as though you had written $main::var. Specifying the package +directly makes you hard-code its name, but it executes faster and +avoids running afoul of C<use strict "refs">. + +=head2 What's the difference between deep and shallow binding? + +In deep binding, lexical variables mentioned in anonymous subroutines +are the same ones that were in scope when the subroutine was created. +In shallow binding, they are whichever variables with the same names +happen to be in scope when the subroutine is called. Perl always uses +deep binding of lexical variables (i.e., those created with my()). +However, dynamic variables (aka global, local, or package variables) +are effectively shallowly bound. Consider this just one more reason +not to use them. See the answer to L<"What's a closure?">. + +=head2 Why doesn't "local($foo) = <FILE>;" work right? + +C<local()> gives list context to the right hand side of C<=>. The +E<lt>FHE<gt> read operation, like so many of Perl's functions and +operators, can tell which context it was called in and behaves +appropriately. In general, the scalar() function can help. This +function does nothing to the data itself (contrary to popular myth) +but rather tells its argument to behave in whatever its scalar fashion +is. If that function doesn't have a defined scalar behavior, this of +course doesn't help you (such as with sort()). + +To enforce scalar context in this particular case, however, you need +merely omit the parentheses: + + local($foo) = <FILE>; # WRONG + local($foo) = scalar(<FILE>); # ok + local $foo = <FILE>; # right + +You should probably be using lexical variables anyway, although the +issue is the same here: + + my($foo) = <FILE>; # WRONG + my $foo = <FILE>; # right + +=head2 How do I redefine a built-in function, operator, or method? + +Why do you want to do that? :-) + +If you want to override a predefined function, such as open(), +then you'll have to import the new definition from a different +module. See L<perlsub/"Overriding Builtin Functions">. There's +also an example in L<perltoot/"Class::Template">. + +If you want to overload a Perl operator, such as C<+> or C<**>, +then you'll want to use the C<use overload> pragma, documented +in L<overload>. + +If you're talking about obscuring method calls in parent classes, +see L<perltoot/"Overridden Methods">. + +=head2 What's the difference between calling a function as &foo and foo()? + +When you call a function as C<&foo>, you allow that function access to +your current @_ values, and you by-pass prototypes. That means that +the function doesn't get an empty @_, it gets yours! While not +strictly speaking a bug (it's documented that way in L<perlsub>), it +would be hard to consider this a feature in most cases. + +When you call your function as C<&foo()>, then you do get a new @_, +but prototyping is still circumvented. + +Normally, you want to call a function using C<foo()>. You may only +omit the parentheses if the function is already known to the compiler +because it already saw the definition (C<use> but not C<require>), +or via a forward reference or C<use subs> declaration. Even in this +case, you get a clean @_ without any of the old values leaking through +where they don't belong. + +=head2 How do I create a switch or case statement? + +This is explained in more depth in the L<perlsyn>. Briefly, there's +no official case statement, because of the variety of tests possible +in Perl (numeric comparison, string comparison, glob comparison, +regexp matching, overloaded comparisons, ...). Larry couldn't decide +how best to do this, so he left it out, even though it's been on the +wish list since perl1. + +Here's a simple example of a switch based on pattern matching. We'll +do a multi-way conditional based on the type of reference stored in +$whatchamacallit: + + SWITCH: + for (ref $whatchamacallit) { + + /^$/ && die "not a reference"; + + /SCALAR/ && do { + print_scalar($$ref); + last SWITCH; + }; + + /ARRAY/ && do { + print_array(@$ref); + last SWITCH; + }; + + /HASH/ && do { + print_hash(%$ref); + last SWITCH; + }; + + /CODE/ && do { + warn "can't print function ref"; + last SWITCH; + }; + + # DEFAULT + + warn "User defined type skipped"; + + } + +=head2 How can I catch accesses to undefined variables/functions/methods? + +The AUTOLOAD method, discussed in L<perlsub/"Autoloading"> and +L<perltoot/"AUTOLOAD: Proxy Methods">, lets you capture calls to +undefined functions and methods. + +When it comes to undefined variables that would trigger a warning +under C<-w>, you can use a handler to trap the pseudo-signal +C<__WARN__> like this: + + $SIG{__WARN__} = sub { + + for ( $_[0] ) { + + /Use of uninitialized value/ && do { + # promote warning to a fatal + die $_; + }; + + # other warning cases to catch could go here; + + warn $_; + } + + }; + +=head2 Why can't a method included in this same file be found? + +Some possible reasons: your inheritance is getting confused, you've +misspelled the method name, or the object is of the wrong type. Check +out L<perltoot> for details on these. You may also use C<print +ref($object)> to find out the class C<$object> was blessed into. + +Another possible reason for problems is because you've used the +indirect object syntax (eg, C<find Guru "Samy">) on a class name +before Perl has seen that such a package exists. It's wisest to make +sure your packages are all defined before you start using them, which +will be taken care of if you use the C<use> statement instead of +C<require>. If not, make sure to use arrow notation (eg, +C<Guru->find("Samy")>) instead. Object notation is explained in +L<perlobj>. + +=head2 How can I find out my current package? + +If you're just a random program, you can do this to find +out what the currently compiled package is: + + my $packname = ref bless []; + +But if you're a method and you want to print an error message +that includes the kind of object you were called on (which is +not necessarily the same as the one in which you were compiled): + + sub amethod { + my $self = shift; + my $class = ref($self) || $self; + warn "called me from a $class object"; + } + +=head1 AUTHOR AND COPYRIGHT + +Copyright (c) 1997 Tom Christiansen and Nathan Torkington. +All rights reserved. See L<perlfaq> for distribution information. diff --git a/pod/perlfaq8.pod b/pod/perlfaq8.pod new file mode 100644 index 0000000000..6ad5c15750 --- /dev/null +++ b/pod/perlfaq8.pod @@ -0,0 +1,749 @@ +=head1 NAME + +perlfaq8 - System Interaction ($Revision: 1.15 $) + +=head1 DESCRIPTION + +This section of the Perl FAQ covers questions involving operating +system interaction. This involves interprocess communication (IPC), +control over the user-interface (keyboard, screen and pointing +devices), and most anything else not related to data manipulation. + +Read the FAQs and documentation specific to the port of perl to your +operating system (eg, L<perlvms>, L<perlplan9>, ...). These should +contain more detailed information on the vagaries of your perl. + +=head2 How do I find out which operating system I'm running under? + +The $^O variable ($OSTYPE if you use English) contains the operating +system that your perl binary was built for. + +=head2 How come exec() doesn't return? + +Because that's what it does: it replaces your currently running +program with a different one. If you want to keep going (as is +probably the case if you're asking this question) use system() +instead. + +=head2 How do I do fancy stuff with the keyboard/screen/mouse? + +How you access/control keyboards, screens, and pointing devices +("mice") is system-dependent. Try the following modules: + +=over 4 + +=item Keyboard + + Term::Cap Standard perl distribution + Term::ReadKey CPAN + Term::ReadLine::Gnu CPAN + Term::ReadLine::Perl CPAN + Term::Screen CPAN + +=item Screen + + Term::Cap Standard perl distribution + Curses CPAN + Term::ANSIColor CPAN + +=item Mouse + + Tk CPAN + +=back + +=head2 How do I ask the user for a password? + +(This question has nothing to do with the web. See a different +FAQ for that.) + +There's an example of this in L<perlfunc/crypt>). First, you put +the terminal into "no echo" mode, then just read the password +normally. You may do this with an old-style ioctl() function, POSIX +terminal control (see L<POSIX>, and Chapter 7 of the Camel), or a call +to the B<stty> program, with varying degrees of portability. + +You can also do this for most systems using the Term::ReadKey module +from CPAN, which is easier to use and in theory more portable. + +=head2 How do I read and write the serial port? + +This depends on which operating system your program is running on. In +the case of Unix, the serial ports will be accessible through files in +/dev; on other systems, the devices names will doubtless differ. +Several problem areas common to all device interaction are the +following + +=over 4 + +=item lockfiles + +Your system may use lockfiles to control multiple access. Make sure +you follow the correct protocol. Unpredictable behaviour can result +from multiple processes reading from one device. + +=item open mode + +If you expect to use both read and write operations on the device, +you'll have to open it for update (see L<perlfunc/"open"> for +details). You may wish to open it without running the risk of +blocking by using sysopen() and C<O_RDWR|O_NDELAY|O_NOCTTY> from the +Fcntl module (part of the standard perl distribution). See +L<perlfunc/"sysopen"> for more on this approach. + +=item end of line + +Some devices will be expecting a "\r" at the end of each line rather +than a "\n". In some ports of perl, "\r" and "\n" are different from +their usual (Unix) ASCII values of "\012" and "\015". You may have to +give the numeric values you want directly, using octal ("\015"), hex +("0x0D"), or as a control-character specification ("\cM"). + + print DEV "atv1\012"; # wrong, for some devices + print DEV "atv1\015"; # right, for some devices + +Even though with normal text files, a "\n" will do the trick, there is +still no unified scheme for terminating a line that is portable +between Unix, DOS/Win, and Macintosh, except to terminate I<ALL> line +ends with "\015\012", and strip what you don't need from the output. +This applies especially to socket I/O and autoflushing, discussed +next. + +=item flushing output + +If you expect characters to get to your device when you print() them, +you'll want to autoflush that filehandle, as in the older + + use FileHandle; + DEV->autoflush(1); + +and the newer + + use IO::Handle; + DEV->autoflush(1); + +You can use select() and the C<$|> variable to control autoflushing +(see L<perlvar/$|> and L<perlfunc/select>): + + $oldh = select(DEV); + $| = 1; + select($oldh); + +You'll also see code that does this without a temporary variable, as in + + select((select(DEV), $| = 1)[0]); + +As mentioned in the previous item, this still doesn't work when using +socket I/O between Unix and Macintosh. You'll need to hardcode your +line terminators, in that case. + +=item non-blocking input + +If you are doing a blocking read() or sysread(), you'll have to +arrange for an alarm handler to provide a timeout (see +L<perlfunc/alarm>). If you have a non-blocking open, you'll likely +have a non-blocking read, which means you may have to use a 4-arg +select() to determine whether I/O is ready on that device (see +L<perlfunc/"select">. + +=back + +=head2 How do I decode encrypted password files? + +You spend lots and lots of money on dedicated hardware, but this is +bound to get you talked about. + +Seriously, you can't if they are Unix password files - the Unix +password system employs one-way encryption. Programs like Crack can +forcibly (and intelligently) try to guess passwords, but don't (can't) +guarantee quick success. + +If you're worried about users selecting bad passwords, you should +proactively check when they try to change their password (by modifying +passwd(1), for example). + +=head2 How do I start a process in the background? + +You could use + + system("cmd &") + +or you could use fork as documented in L<perlfunc/"fork">, with +further examples in L<perlipc>. Some things to be aware of, if you're +on a Unix-like system: + +=over 4 + +=item STDIN, STDOUT and STDERR are shared + +Both the main process and the backgrounded one (the "child" process) +share the same STDIN, STDOUT and STDERR filehandles. If both try to +access them at once, strange things can happen. You may want to close +or reopen these for the child. You can get around this with +C<open>ing a pipe (see L<perlfunc/"open">) but on some systems this +means that the child process cannot outlive the parent. + +=item Signals + +You'll have to catch the SIGCHLD signal, and possibly SIGPIPE too. +SIGCHLD is sent when the backgrounded process finishes. SIGPIPE is +sent when you write to a filehandle whose child process has closed (an +untrapped SIGPIPE can cause your program to silently die). This is +not an issue with C<system("cmd&")>. + +=item Zombies + +You have to be prepared to "reap" the child process when it finishes + + $SIG{CHLD} = sub { wait }; + +See L<perlipc/"Signals"> for other examples of code to do this. +Zombies are not an issue with C<system("prog &")>. + +=back + +=head2 How do I trap control characters/signals? + +You don't actually "trap" a control character. Instead, that +character generates a signal, which you then trap. Signals are +documented in L<perlipc/"Signals"> and chapter 6 of the Camel. + +Be warned that very few C libraries are re-entrant. Therefore, if you +attempt to print() in a handler that got invoked during another stdio +operation your internal structures will likely be in an +inconsistent state, and your program will dump core. You can +sometimes avoid this by using syswrite() instead of print(). + +Unless you're exceedingly careful, the only safe things to do inside a +signal handler are: set a variable and exit. And in the first case, +you should only set a variable in such a way that malloc() is not +called (eg, by setting a variable that already has a value). + +For example: + + $Interrupted = 0; # to ensure it has a value + $SIG{INT} = sub { + $Interrupted++; + syswrite(STDERR, "ouch\n", 5); + } + +However, because syscalls restart by default, you'll find that if +you're in a "slow" call, such as E<lt>FHE<gt>, read(), connect(), or +wait(), that the only way to terminate them is by "longjumping" out; +that is, by raising an exception. See the time-out handler for a +blocking flock() in L<perlipc/"Signals"> or chapter 6 of the Camel. + +=head2 How do I modify the shadow password file on a Unix system? + +If perl was installed correctly, the getpw*() functions described in +L<perlfunc> provide (read-only) access to the shadow password file. +To change the file, make a new shadow password file (the format varies +from system to system - see L<passwd(5)> for specifics) and use +pwd_mkdb(8) to install it (see L<pwd_mkdb(5)> for more details). + +=head2 How do I set the time and date? + +Assuming you're running under sufficient permissions, you should be +able to set the system-wide date and time by running the date(1) +program. (There is no way to set the time and date on a per-process +basis.) This mechanism will work for Unix, MS-DOS, Windows, and NT; +the VMS equivalent is C<set time>. + +However, if all you want to do is change your timezone, you can +probably get away with setting an environment variable: + + $ENV{TZ} = "MST7MDT"; # unixish + $ENV{'SYS$TIMEZONE_DIFFERENTIAL'}="-5" # vms + system "trn comp.lang.perl"; + +=head2 How can I sleep() or alarm() for under a second? + +If you want finer granularity than the 1 second that the sleep() +function provides, the easiest way is to use the select() function as +documented in L<perlfunc/"select">. If your system has itimers and +syscall() support, you can check out the old example in +http://www.perl.com/CPAN/doc/misc/ancient/tutorial/eg/itimers.pl . + +=head2 How can I measure time under a second? + +In general, you may not be able to. The Time::HiRes module (available +from CPAN) provides this functionality for some systems. + +In general, you may not be able to. But if you system supports both the +syscall() function in Perl as well as a system call like gettimeofday(2), +then you may be able to do something like this: + + require 'sys/syscall.ph'; + + $TIMEVAL_T = "LL"; + + $done = $start = pack($TIMEVAL_T, ()); + + syscall( &SYS_gettimeofday, $start, 0)) != -1 + or die "gettimeofday: $!"; + + ########################## + # DO YOUR OPERATION HERE # + ########################## + + syscall( &SYS_gettimeofday, $done, 0) != -1 + or die "gettimeofday: $!"; + + @start = unpack($TIMEVAL_T, $start); + @done = unpack($TIMEVAL_T, $done); + + # fix microseconds + for ($done[1], $start[1]) { $_ /= 1_000_000 } + + $delta_time = sprintf "%.4f", ($done[0] + $done[1] ) + - + ($start[0] + $start[1] ); + +=head2 How can I do an atexit() or setjmp()/longjmp()? (Exception handling) + +Release 5 of Perl added the END block, which can be used to simulate +atexit(). Each package's END block is called when the program or +thread ends (see L<perlmod> manpage for more details). It isn't +called when untrapped signals kill the program, though, so if you use +END blocks you should also use + + use sigtrap qw(die normal-signals); + +Perl's exception-handling mechanism is its eval() operator. You can +use eval() as setjmp and die() as longjmp. For details of this, see +the section on signals, especially the time-out handler for a blocking +flock() in L<perlipc/"Signals"> and chapter 6 of the Camel. + +If exception handling is all you're interested in, try the +exceptions.pl library (part of the standard perl distribution). + +If you want the atexit() syntax (and an rmexit() as well), try the +AtExit module available from CPAN. + +=head2 Why doesn't my sockets program work under System V (Solaris)? What does the error message "Protocol not supported" mean? + +Some Sys-V based systems, notably Solaris 2.X, redefined some of the +standard socket constants. Since these were constant across all +architectures, they were often hardwired into perl code. The proper +way to deal with this is to "use Socket" to get the correct values. + +Note that even though SunOS and Solaris are binary compatible, these +values are different. Go figure. + +=head2 How can I call my system's unique C functions from Perl? + +In most cases, you write an external module to do it - see the answer +to "Where can I learn about linking C with Perl? [h2xs, xsubpp]". +However, if the function is a system call, and your system supports +syscall(), you can use the syscall function (documented in +L<perlfunc>). + +Remember to check the modules that came with your distribution, and +CPAN as well - someone may already have written a module to do it. + +=head2 Where do I get the include files to do ioctl() or syscall()? + +Historically, these would be generated by the h2ph tool, part of the +standard perl distribution. This program converts cpp(1) directives +in C header files to files containing subroutine definitions, like +&SYS_getitimer, which you can use as arguments to your functions. +It doesn't work perfectly, but it usually gets most of the job done. +Simple files like F<errno.h>, F<syscall.h>, and F<socket.h> were fine, +but the hard ones like F<ioctl.h> nearly always need to hand-edited. +Here's how to install the *.ph files: + + 1. become super-user + 2. cd /usr/include + 3. h2ph *.h */*.h + +If your system supports dynamic loading, for reasons of portability and +sanity you probably ought to use h2xs (also part of the standard perl +distribution). This tool converts C header files to Perl extensions. +See L<perlxstut> for how to get started with h2xs. + +If your system doesn't support dynamic loading, you still probably +ought to use h2xs. See L<perlxstut> and L<ExtUtils::MakeMaker> for +more information (in brief, just use B<make perl> instead of a plain +B<make> to rebuild perl with a new static extension). + +=head2 Why do setuid perl scripts complain about kernel problems? + +Some operating systems have bugs in the kernel that make setuid +scripts inherently insecure. Perl gives you a number of options +(described in L<perlsec>) to work around such systems. + +=head2 How can I open a pipe both to and from a command? + +The IPC::Open2 module (part of the standard perl distribution) is an +easy-to-use approach that internally uses pipe(), fork(), and exec() +to do the job. Make sure you read the deadlock warnings in its +documentation, though (see L<IPC::Open2>). + +=head2 How can I capture STDERR from an external command? + +There are three basic ways of running external commands: + + system $cmd; # using system() + $output = `$cmd`; # using backticks (``) + open (PIPE, "cmd |"); # using open() + +With system(), both STDOUT and STDERR will go the same place as the +script's versions of these, unless the command redirects them. +Backticks and open() read B<only> the STDOUT of your command. + +With any of these, you can change file descriptors before the call: + + open(STDOUT, ">logfile"); + system("ls"); + +or you can use Bourne shell file-descriptor redirection: + + $output = `$cmd 2>some_file`; + open (PIPE, "cmd 2>some_file |"); + +You can also use file-descriptor redirection to make STDERR a +duplicate of STDOUT: + + $output = `$cmd 2>&1`; + open (PIPE, "cmd 2>&1 |"); + +Note that you I<cannot> simply open STDERR to be a dup of STDOUT +in your Perl program and avoid calling the shell to do the redirection. +This doesn't work: + + open(STDERR, ">&STDOUT"); + $alloutput = `cmd args`; # stderr still escapes + +This fails because the open() makes STDERR go to where STDOUT was +going at the time of the open(). The backticks then make STDOUT go to +a string, but don't change STDERR (which still goes to the old +STDOUT). + +Note that you I<must> use Bourne shell (sh(1)) redirection syntax in +backticks, not csh(1)! Details on why Perl's system() and backtick +and pipe opens all use the Bourne shell are in +http://www.perl.com/CPAN/doc/FMTEYEWTK/versus/csh.whynot . + +You may also use the IPC::Open3 module (part of the standard perl +distribution), but be warned that it has a different order of +arguments from IPC::Open2 (see L<IPC::Open3>). + +=head2 Why doesn't open() return an error when a pipe open fails? + +It does, but probably not how you expect it to. On systems that +follow the standard fork()/exec() paradigm (eg, Unix), it works like +this: open() causes a fork(). In the parent, open() returns with the +process ID of the child. The child exec()s the command to be piped +to/from. The parent can't know whether the exec() was successful or +not - all it can return is whether the fork() succeeded or not. To +find out if the command succeeded, you have to catch SIGCHLD and +wait() to get the exit status. + +On systems that follow the spawn() paradigm, open() I<might> do what +you expect - unless perl uses a shell to start your command. In this +case the fork()/exec() description still applies. + +=head2 What's wrong with using backticks in a void context? + +Strictly speaking, nothing. Stylistically speaking, it's not a good +way to write maintainable code because backticks have a (potentially +humungous) return value, and you're ignoring it. It's may also not be very +efficient, because you have to read in all the lines of output, allocate +memory for them, and then throw it away. Too often people are lulled +to writing: + + `cp file file.bak`; + +And now they think "Hey, I'll just always use backticks to run programs." +Bad idea: backticks are for capturing a program's output; the system() +function is for running programs. + +Consider this line: + + `cat /etc/termcap`; + +You haven't assigned the output anywhere, so it just wastes memory +(for a little while). Plus you forgot to check C<$?> to see whether +the program even ran correctly. Even if you wrote + + print `cat /etc/termcap`; + +In most cases, this could and probably should be written as + + system("cat /etc/termcap") == 0 + or die "cat program failed!"; + +Which will get the output quickly (as its generated, instead of only +at the end ) and also check the return value. + +system() also provides direct control over whether shell wildcard +processing may take place, whereas backticks do not. + +=head2 How can I call backticks without shell processing? + +This is a bit tricky. Instead of writing + + @ok = `grep @opts '$search_string' @filenames`; + +You have to do this: + + my @ok = (); + if (open(GREP, "-|")) { + while (<GREP>) { + chomp; + push(@ok, $_); + } + close GREP; + } else { + exec 'grep', @opts, $search_string, @filenames; + } + +Just as with system(), no shell escapes happen when you exec() a list. + +=head2 Why can't my script read from STDIN after I gave it EOF (^D on Unix, ^Z on MSDOS)? + +Because some stdio's set error and eof flags that need clearing. The +POSIX module defines clearerr() that you can use. That is the +technically correct way to do it. Here are some less reliable +workarounds: + +=over 4 + +=item 1 + +Try keeping around the seekpointer and go there, like this: + + $where = tell(LOG); + seek(LOG, $where, 0); + +=item 2 + +If that doesn't work, try seeking to a different part of the file and +then back. + +=item 3 + +If that doesn't work, try seeking to a different part of +the file, reading something, and then seeking back. + +=item 4 + +If that doesn't work, give up on your stdio package and use sysread. + +=back + +=head2 How can I convert my shell script to perl? + +Learn Perl and rewrite it. Seriously, there's no simple converter. +Things that are awkward to do in the shell are easy to do in Perl, and +this very awkwardness is what would make a shell->perl converter +nigh-on impossible to write. By rewriting it, you'll think about what +you're really trying to do, and hopefully will escape the shell's +pipeline datastream paradigm, which while convenient for some matters, +causes many inefficiencies. + +=head2 Can I use perl to run a telnet or ftp session? + +Try the Net::FTP and TCP::Client modules (available from CPAN). +http://www.perl.com/CPAN/scripts/netstuff/telnet.emul.shar will also +help for emulating the telnet protocol. + +=head2 How can I write expect in Perl? + +Once upon a time, there was a library called chat2.pl (part of the +standard perl distribution), which never really got finished. These +days, your best bet is to look at the Comm.pl library available from +CPAN. + +=head2 Is there a way to hide perl's command line from programs such as "ps"? + +First of all note that if you're doing this for security reasons (to +avoid people seeing passwords, for example) then you should rewrite +your program so that critical information is never given as an +argument. Hiding the arguments won't make your program completely +secure. + +To actually alter the visible command line, you can assign to the +variable $0 as documented in L<perlvar>. This won't work on all +operating systems, though. Daemon programs like sendmail place their +state there, as in: + + $0 = "orcus [accepting connections]"; + +=head2 I {changed directory, modified my environment} in a perl script. How come the change disappeared when I exited the script? How do I get my changes to be visible? + +=over 4 + +=item Unix + +In the strictest sense, it can't be done -- the script executes as a +different process from the shell it was started from. Changes to a +process are not reflected in its parent, only in its own children +created after the change. There is shell magic that may allow you to +fake it by eval()ing the script's output in your shell; check out the +comp.unix.questions FAQ for details. + +=item VMS + +Change to %ENV persist after Perl exits, but directory changes do not. + +=back + +=head2 How do I close a process's filehandle without waiting for it to complete? + +Assuming your system supports such things, just send an appropriate signal +to the process (see L<perlfunc/"kill">. It's common to first send a TERM +signal, wait a little bit, and then send a KILL signal to finish it off. + +=head2 How do I fork a daemon process? + +If by daemon process you mean one that's detached (disassociated from +its tty), then the following process is reported to work on most +Unixish systems. Non-Unix users should check their Your_OS::Process +module for other solutions. + +=over 4 + +=item * + +Open /dev/tty and use the the TIOCNOTTY ioctl on it. See L<tty(4)> +for details. + +=item * + +Change directory to / + +=item * + +Reopen STDIN, STDOUT, and STDERR so they're not connected to the old +tty. + +=item * + +Background yourself like this: + + fork && exit; + +=back + +=head2 How do I make my program run with sh and csh? + +See the F<eg/nih> script (part of the perl source distribution). + +=head2 How do I keep my own module/library directory? + +When you build modules, use the PREFIX option when generating +Makefiles: + + perl Makefile.PL PREFIX=/u/mydir/perl + +then either set the PERL5LIB environment variable before you run +scripts that use the modules/libraries (see L<perlrun>) or say + + use lib '/u/mydir/perl'; + +See Perl's L<lib> for more information. + +=head2 How do I find out if I'm running interactively or not? + +Good question. Sometimes C<-t STDIN> and C<-t STDOUT> can give clues, +sometimes not. + + if (-t STDIN && -t STDOUT) { + print "Now what? "; + } + +On POSIX systems, you can test whether your own process group matches +the current process group of your controlling terminal as follows: + + use POSIX qw/getpgrp tcgetpgrp/; + open(TTY, "/dev/tty") or die $!; + $tpgrp = tcgetpgrp(TTY); + $pgrp = getpgrp(); + if ($tpgrp == $pgrp) { + print "foreground\n"; + } else { + print "background\n"; + } + +=head2 How do I timeout a slow event? + +Use the alarm() function, probably in conjunction with a signal +handler, as documented L<perlipc/"Signals"> and chapter 6 of the +Camel. You may instead use the more flexible Sys::AlarmCall module +available from CPAN. + +=head2 How do I set CPU limits? + +Use the BSD::Resource module from CPAN. + +=head2 How do I avoid zombies on a Unix system? + +Use the reaper code from L<perlipc/"Signals"> to call wait() when a +SIGCHLD is received, or else use the double-fork technique described +in L<perlfunc/fork>. + +=head2 How do I use an SQL database? + +There are a number of excellent interfaces to SQL databases. See the +DBD::* modules available from +http://www.perl.com/CPAN/modules/dbperl/DBD . + +=head2 How do I make a system() exit on control-C? + +You can't. You need to imitate the system() call (see L<perlipc> for +sample code) and then have a signal handler for the INT signal that +passes the signal on to the subprocess. + +=head2 How do I open a file without blocking? + +If you're lucky enough to be using a system that supports +non-blocking reads (most Unixish systems do), you need only to use the +O_NDELAY or O_NONBLOCK flag from the Fcntl module in conjunction with +sysopen(): + + use Fcntl; + sysopen(FH, "/tmp/somefile", O_WRONLY|O_NDELAY|O_CREAT, 0644) + or die "can't open /tmp/somefile: $!": + +=head2 How do I install a CPAN module? + +The easiest way is to have the CPAN module do it for you. This module +comes with perl version 5.004 and later. To manually install the CPAN +module, or any well-behaved CPAN module for that matter, follow these +steps: + +=over 4 + +=item 1 + +Unpack the source into a temporary area. + +=item 2 + + perl Makefile.PL + +=item 3 + + make + +=item 4 + + make test + +=item 5 + + make install + +=back + +If your version of perl is compiled without dynamic loading, then you +just need to replace step 3 (B<make>) with B<make perl> and you will +get a new F<perl> binary with your extension linked in. + +See L<ExtUtils::MakeMaker> for more details on building extensions. + +=head1 AUTHOR AND COPYRIGHT + +Copyright (c) 1997 Tom Christiansen and Nathan Torkington. +All rights reserved. See L<perlfaq> for distribution information. diff --git a/pod/perlfaq9.pod b/pod/perlfaq9.pod new file mode 100644 index 0000000000..e62dac4bd3 --- /dev/null +++ b/pod/perlfaq9.pod @@ -0,0 +1,277 @@ +=head1 NAME + +perlfaq9 - Networking ($Revision: 1.13 $) + +=head1 DESCRIPTION + +This section deals with questions related to networking, the internet, +and a few on the web. + +=head2 My CGI script runs from the command line but not the browser. Can you help me fix it? + +Sure, but you probably can't afford our contracting rates :-) + +Seriously, if you can demonstrate that you've read the following FAQs +and that your problem isn't something simple that can be easily +answered, you'll probably receive a courteous and useful reply to your +question if you post it on comp.infosystems.www.authoring.cgi (if it's +something to do with HTTP, HTML, or the CGI protocols). Questions that +appear to be Perl questions but are really CGI ones that are posted to +comp.lang.perl.misc may not be so well received. + +The useful FAQs are: + + http://www.perl.com/perl/faq/idiots-guide.html + http://www3.pair.com/webthing/docs/cgi/faqs/cgifaq.shtml + http://www.perl.com/perl/faq/perl-cgi-faq.html + http://www-genome.wi.mit.edu/WWW/faqs/www-security-faq.html + http://www.boutell.com/faq/ + +=head2 How do I remove HTML from a string? + +The most correct way (albeit not the fastest) is to use HTML::Parse +from CPAN (part of the libwww-perl distribution, which is a must-have +module for all web hackers). + +Many folks attempt a simple-minded regular expression approach, like +C<s/E<lt>.*?E<gt>//g>, but that fails in many cases because the tags +may continue over line breaks, they may contain quoted angle-brackets, +or HTML comment may be present. Plus folks forget to convert +entities, like C<<> for example. + +Here's one "simple-minded" approach, that works for most files: + + #!/usr/bin/perl -p0777 + s/<(?:[^>'"]*|(['"]).*?\1)*>//gs + +If you want a more complete solution, see the 3-stage striphtml +program in +http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/striphtml.gz +. + +=head2 How do I extract URLs? + +A quick but imperfect approach is + + #!/usr/bin/perl -n00 + # qxurl - tchrist@perl.com + print "$2\n" while m{ + < \s* + A \s+ HREF \s* = \s* (["']) (.*?) \1 + \s* > + }gsix; + +This version does not adjust relative URLs, understand alternate +bases, deal with HTML comments, or accept URLs themselves as +arguments. It also runs about 100x faster than a more "complete" +solution using the LWP suite of modules, such as the +http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/xurl.gz +program. + +=head2 How do I download a file from the user's machine? How do I open a file on another machine? + +In the context of an HTML form, you can use what's known as +B<multipart/form-data> encoding. The CGI.pm module (available from +CPAN) supports this in the start_multipart_form() method, which isn't +the same as the startform() method. + +=head2 How do I make a pop-up menu in HTML? + +Use the B<E<lt>SELECTE<gt>> and B<E<lt>OPTIONE<gt>> tags. The CGI.pm +module (available from CPAN) supports this widget, as well as many +others, including some that it cleverly synthesizes on its own. + +=head2 How do I fetch an HTML file? + +Use the LWP::Simple module available from CPAN, part of the excellent +libwww-perl (LWP) package. On the other hand, and if you have the +lynx text-based HTML browser installed on your system, this isn't too +bad: + + $html_code = `lynx -source $url`; + $text_data = `lynx -dump $url`; + +=head2 how do I decode or create those %-encodings on the web? + +Here's an example of decoding: + + $string = "http://altavista.digital.com/cgi-bin/query?pg=q&what=news&fmt=.&q=%2Bcgi-bin+%2Bperl.exe"; + $string =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge; + +Encoding is a bit harder, because you can't just blindly change +all the non-alphanumunder character (C<\W>) into their hex escapes. +It's important that characters with special meaning like C</> and C<?> +I<not> be translated. Probably the easiest way to get this right is +to avoid reinventing the wheel and just use the URI::Escape module, +which is part of the libwww-perl package (LWP) available from CPAN. + +=head2 How do I redirect to another page? + +Instead of sending back a C<Content-Type> as the headers of your +reply, send back a C<Location:> header. Officially this should be a +C<URI:> header, so the CGI.pm module (available from CPAN) sends back +both: + + Location: http://www.domain.com/newpage + URI: http://www.domain.com/newpage + +Note that relative URLs in these headers can cause strange effects +because of "optimizations" that servers do. + +=head2 How do I put a password on my web pages? + +That depends. You'll need to read the documentation for your web +server, or perhaps check some of the other FAQs referenced above. + +=head2 How do I edit my .htpasswd and .htgroup files with Perl? + +The HTTPD::UserAdmin and HTTPD::GroupAdmin modules provide a +consistent OO interface to these files, regardless of how they're +stored. Databases may be text, dbm, Berkley DB or any database with a +DBI compatible driver. HTTPD::UserAdmin supports files used by the +`Basic' and `Digest' authentication schemes. Here's an example: + + use HTTPD::UserAdmin (); + HTTPD::UserAdmin + ->new(DB => "/foo/.htpasswd") + ->add($username => $password); + +=head2 How do I parse an email header? + +For a quick-and-dirty solution, try this solution derived +from page 222 of the 2nd edition of "Programming Perl": + + $/ = ''; + $header = <MSG>; + $header =~ s/\n\s+/ /g; # merge continuation lines + %head = ( UNIX_FROM_LINE, split /^([-\w]+):\s*/m, $header ); + +That solution doesn't do well if, for example, you're trying to +maintain all the Received lines. A more complete approach is to use +the Mail::Header module from CPAN (part of the MailTools package). + +=head2 How do I decode a CGI form? + +A lot of people are tempted to code this up themselves, so you've +probably all seen a lot of code involving C<$ENV{CONTENT_LENGTH}> and +C<$ENV{QUERY_STRING}>. It's true that this can work, but there are +also a lot of versions of this floating around that are quite simply +broken! + +Please do not be tempted to reinvent the wheel. Instead, use the +CGI.pm or CGI_Lite.pm (available from CPAN), or if you're trapped in +the module-free land of perl1 .. perl4, you might look into cgi-lib.pl +(available from http://www.bio.cam.ac.uk/web/form.html). + +=head2 How do I check a valid email address? + +You can't. + +Without sending mail to the address and seeing whether it bounces (and +even then you face the halting problem), you cannot determine whether +an email address is valid. Even if you apply the email header +standard, you can have problems, because there are deliverable +addresses that aren't RFC-822 (the mail header standard) compliant, +and addresses that aren't deliverable which are compliant. + +Many are tempted to try to eliminate many frequently-invalid email +addresses with a simple regexp, such as +C</^[\w.-]+\@([\w.-]\.)+\w+$/>. However, this also throws out many +valid ones, and says nothing about potential deliverability, so is not +suggested. Instead, see +http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/ckaddr.gz , +which actually checks against the full RFC spec (except for nested +comments), looks for addresses you may not wish to accept email to +(say, Bill Clinton or your postmaster), and then makes sure that the +hostname given can be looked up in DNS. It's not fast, but it works. + +=head2 How do I decode a MIME/BASE64 string? + +The MIME-tools package (available from CPAN) handles this and a lot +more. Decoding BASE64 becomes as simple as: + + use MIME::base64; + $decoded = decode_base64($encoded); + +A more direct approach is to use the unpack() function's "u" +format after minor transliterations: + + tr#A-Za-z0-9+/##cd; # remove non-base64 chars + tr#A-Za-z0-9+/# -_#; # convert to uuencoded format + $len = pack("c", 32 + 0.75*length); # compute length byte + print unpack("u", $len . $_); # uudecode and print + +=head2 How do I return the user's email address? + +On systems that support getpwuid, the $E<lt> variable and the +Sys::Hostname module (which is part of the standard perl distribution), +you can probably try using something like this: + + use Sys::Hostname; + $address = sprintf('%s@%s', getpwuid($<), hostname); + +Company policies on email address can mean that this generates addresses +that the company's email system will not accept, so you should ask for +users' email addresses when this matters. Furthermore, not all systems +on which Perl runs are so forthcoming with this information as is Unix. + +The Mail::Util module from CPAN (part of the MailTools package) provides a +mailaddress() function that tries to guess the mail address of the user. +It makes a more intelligent guess than the code above, using information +given when the module was installed, but it could still be incorrect. +Again, the best way is often just to ask the user. + +=head2 How do I send/read mail? + +Sending mail: the Mail::Mailer module from CPAN (part of the MailTools +package) is UNIX-centric, while Mail::Internet uses Net::SMTP which is +not UNIX-centric. Reading mail: use the Mail::Folder module from CPAN +(part of the MailFolder package) or the Mail::Internet module from +CPAN (also part of the MailTools package). + +=head2 How do I find out my hostname/domainname/IP address? + +A lot of code has historically cavalierly called the C<`hostname`> +program. While sometimes expedient, this isn't very portable. It's +one of those tradeoffs of convenience versus portability. + +The Sys::Hostname module (part of the standard perl distribution) will +give you the hostname after which you can find out the IP address +(assuming you have working DNS) with a gethostbyname() call. + + use Socket; + use Sys::Hostname; + my $host = hostname(); + my $addr = inet_ntoa(scalar(gethostbyname($name)) || 'localhost'); + +Probably the simplest way to learn your DNS domain name is to grok +it out of /etc/resolv.conf, at least under Unix. Of course, this +assumes several things about your resolv.conf configuration, including +that it exists. + +(We still need a good DNS domain name-learning method for non-Unix +systems.) + +=head2 How do I fetch a news article or the active newsgroups? + +Use the Net::NNTP or News::NNTPClient modules, both available from CPAN. +This can make tasks like fetching the newsgroup list as simple as: + + perl -MNews::NNTPClient + -e 'print News::NNTPClient->new->list("newsgroups")' + +=head2 How do I fetch/put an FTP file? + +LWP::Simple (available from CPAN) can fetch but not put. Net::FTP (also +available from CPAN) is more complex but can put as well as fetch. + +=head2 How can I do RPC in Perl? + +A DCE::RPC module is being developed (but is not yet available), and +will be released as part of the DCE-Perl package (available from +CPAN). No ONC::RPC module is known. + +=head1 AUTHOR AND COPYRIGHT + +Copyright (c) 1997 Tom Christiansen and Nathan Torkington. +All rights reserved. See L<perlfaq> for distribution information. diff --git a/pod/perlform.pod b/pod/perlform.pod index fcdea2495e..4e55e02800 100644 --- a/pod/perlform.pod +++ b/pod/perlform.pod @@ -194,7 +194,7 @@ If you use the English module, you can even read the variable names: select($ofh); But you still have those funny select()s. So just use the FileHandle -module. Now, you can access these special variables using lower-case +module. Now, you can access these special variables using lowercase method names instead: use FileHandle; @@ -315,12 +315,12 @@ is to printf(), do this: =head1 WARNINGS -The lone dot that ends a format can also prematurely end an E-Mail +The lone dot that ends a format can also prematurely end an email message passing through a misconfigured Internet mailer (and based on experience, such misconfiguration is the rule, not the exception). So -when sending format code through E-Mail, you should indent it so that +when sending format code through email, you should indent it so that the format-ending dot is not on the left margin; this will prevent -E-Mail cutoff. +email cutoff. Lexical variables (declared with "my") are not visible within a format unless the format is declared within the scope of the lexical diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index eb7276a3b4..c4de4a39ae 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -35,11 +35,11 @@ operator or unary operator, and precedence does matter. And whitespace between the function and left parenthesis doesn't count--so you need to be careful sometimes: - print 1+2+3; # Prints 6. - print(1+2) + 3; # Prints 3. - print (1+2)+3; # Also prints 3! - print +(1+2)+3; # Prints 6. - print ((1+2)+3); # Prints 6. + print 1+2+4; # Prints 7. + print(1+2) + 4; # Prints 3. + print (1+2)+4; # Also prints 3! + print +(1+2)+4; # Prints 7. + print ((1+2)+4); # Prints 7. If you run Perl with the B<-w> switch it can warn you about this. For example, the third line above produces: @@ -1123,21 +1123,22 @@ value is taken as the name of the filehandle. =item flock FILEHANDLE,OPERATION Calls flock(2), or an emulation of it, on FILEHANDLE. Returns TRUE for -success, FALSE on failure. Will produce a fatal error if used on a -machine that doesn't implement flock(2), fcntl(2) locking, or lockf(3). -flock() is Perl's portable file locking interface, although it will lock -only entire files, not records. +success, FALSE on failure. Produces a fatal error if used on a machine +that doesn't implement flock(2), fcntl(2) locking, or lockf(3). flock() +is Perl's portable file locking interface, although it locks only entire +files, not records. OPERATION is one of LOCK_SH, LOCK_EX, or LOCK_UN, possibly combined with LOCK_NB. These constants are traditionally valued 1, 2, 8 and 4, but -you can use the symbolic names if you pull them in with an explicit -request to the Fcntl module. The names can be requested as a group with -the :flock tag (or they can be requested individually, of course). -LOCK_SH requests a shared lock, LOCK_EX requests an exclusive lock, and -LOCK_UN releases a previously requested lock. If LOCK_NB is added to -LOCK_SH or LOCK_EX then flock() will return immediately rather than -blocking waiting for the lock (check the return status to see if you got -it). +you can use the symbolic names if import them from the Fcntl module, +either individually, or as a group using the ':flock' tag. LOCK_SH +requests a shared lock, LOCK_EX requests an exclusive lock, and LOCK_UN +releases a previously requested lock. If LOCK_NB is added to LOCK_SH or +LOCK_EX then flock() will return immediately rather than blocking +waiting for the lock (check the return status to see if you got it). + +To avoid the possibility of mis-coordination, Perl flushes FILEHANDLE +before (un)locking it. Note that the emulation built with lockf(3) doesn't provide shared locks, and it requires that FILEHANDLE be open with write intent. These @@ -1436,9 +1437,11 @@ Returns the socket option requested, or undefined if there is an error. =item glob -Returns the value of EXPR with filename expansions such as a shell -would do. This is the internal function implementing the <*.c> -operator, except it's easier to use. If EXPR is omitted, $_ is used. +Returns the value of EXPR with filename expansions such as a shell would +do. This is the internal function implementing the C<E<lt>*.cE<gt>> +operator, but you can use it directly. If EXPR is omitted, $_ is used. +The C<E<lt>*.cE<gt>> operator is discussed in more detail in +L<perlop/"I/O Operators">. =item gmtime EXPR @@ -2299,7 +2302,7 @@ Generalized quotes. See L<perlop>. =item quotemeta -Returns the value of EXPR with with all non-alphanumeric +Returns the value of EXPR with all non-alphanumeric characters backslashed. (That is, all characters not matching C</[A-Za-z_0-9]/> will be preceded by a backslash in the returned string, regardless of any locale settings.) @@ -2499,9 +2502,9 @@ so you'll probably want to use them instead. See L</my>. =item return LIST -Returns from a subroutine or eval with the value specified. (Note that -in the absence of a return a subroutine or eval() will automatically -return the value of the last expression evaluated.) +Returns from a subroutine, eval(), or do FILE with the value specified. +(Note that in the absence of a return, a subroutine, eval, or do FILE +will automatically return the value of the last expression evaluated.) =item reverse LIST diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 8c78802fb4..866cafb2fc 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -777,9 +777,9 @@ The current kinds of Magic Virtual Tables are: . vtbl_pos $. scalar variable ~ None Used by certain extensions -When an upper-case and lower-case letter both exist in the table, then the -upper-case letter is used to represent some kind of composite type (a list -or a hash), and the lower-case letter is used to represent an element of +When an uppercase and lowercase letter both exist in the table, then the +uppercase letter is used to represent some kind of composite type (a list +or a hash), and the lowercase letter is used to represent an element of that composite type. The '~' magic type is defined specifically for use by extensions and @@ -805,12 +805,12 @@ if the SV is not of type SVt_PVMG, Perl may core-dump. int mg_copy(SV* sv, SV* nsv, char* key, STRLEN klen); This routine checks to see what types of magic C<sv> has. If the mg_type -field is an upper-case letter, then the mg_obj is copied to C<nsv>, but -the mg_type field is changed to be the lower-case letter. +field is an uppercase letter, then the mg_obj is copied to C<nsv>, but +the mg_type field is changed to be the lowercase letter. =head1 Subroutines -=head2 XSUB's and the Argument Stack +=head2 XSUBs and the Argument Stack The XSUB mechanism is a simple way for Perl programs to access C subroutines. An XSUB routine will have a stack that contains the arguments from the Perl @@ -954,7 +954,7 @@ The most recent development releases of Perl has been experimenting with removing Perl's dependency on the "normal" standard I/O suite and allowing other stdio implementations to be used. This involves creating a new abstraction layer that then calls whichever implementation of stdio Perl -was compiled with. All XSUB's should now use the functions in the PerlIO +was compiled with. All XSUBs should now use the functions in the PerlIO abstraction layer and not make any assumptions about what kind of stdio is being used. @@ -1396,7 +1396,7 @@ be the glob for "AUTOLOAD". In this case the corresponing variable $AUTOLOAD is already setup. Note that if you want to keep this glob for a long time, you need to -check for it being "AUTOLOAD", since at the later time the the call +check for it being "AUTOLOAD", since at the later time the call may load a different subroutine due to $AUTOLOAD changing its value. Use the glob created via a side effect to do this. @@ -1427,27 +1427,12 @@ Returns a pointer to the stash for a specified package. See C<gv_stashpv>. Return the SV from the GV. -=item he_delayfree - -Releases a hash entry, such as while iterating though the hash, but -delays actual freeing of key and value until the end of the current -statement (or thereabouts) with C<sv_2mortal>. See C<hv_iternext>. - - void he_delayfree _((HV* hv, HE* hent)); - =item HEf_SVKEY This flag, used in the length slot of hash entries and magic structures, specifies the structure contains a C<SV*> pointer where a C<char*> pointer is to be expected. (For information only--not to be used). -=item he_free - -Releases a hash entry, such as while iterating though the hash. See -C<hv_iternext>. - - void he_free _((HV* hv, HE* hent)); - =item HeHASH Returns the computed hash (type C<U32>) stored in the hash entry. @@ -1519,6 +1504,15 @@ Clears a hash, making it empty. void hv_clear _((HV* tb)); +=item hv_delayfree_ent + +Releases a hash entry, such as while iterating though the hash, but +delays actual freeing of key and value until the end of the current +statement (or thereabouts) with C<sv_2mortal>. See C<hv_iternext> +and C<hv_free_ent>. + + void hv_delayfree_ent _((HV* hv, HE* entry)); + =item hv_delete Deletes a key/value pair in the hash. The value SV is removed from the hash @@ -1572,6 +1566,13 @@ structure if you need to store it somewhere. HE* hv_fetch_ent _((HV* tb, SV* key, I32 lval, U32 hash)); +=item hv_free_ent + +Releases a hash entry, such as while iterating though the hash. See +C<hv_iternext> and C<hv_delayfree_ent>. + + void hv_free_ent _((HV* hv, HE* entry)); + =item hv_iterinit Prepares a starting point to traverse a hash table. @@ -1821,7 +1822,7 @@ SV is B<not> incremented. =item newSV Creates a new SV. The C<len> parameter indicates the number of bytes of -pre-allocated string space the SV should have. The reference count for the +preallocated string space the SV should have. The reference count for the new SV is set to 1. SV* newSV _((STRLEN len)); @@ -2909,4 +2910,4 @@ API Listing by Dean Roehrich <F<roehrich@cray.com>>. =head1 DATE -Version 31.2: 1997/3/5 +Version 31.3: 1997/3/14 diff --git a/pod/perlipc.pod b/pod/perlipc.pod index d289ad380c..ab4a912bc6 100644 --- a/pod/perlipc.pod +++ b/pod/perlipc.pod @@ -258,6 +258,57 @@ handle. Consider: print FH "bang\n"; close FH; +=head2 Filehandles + +Both the main process and the child process share the same STDIN, +STDOUT and STDERR filehandles. If both processes try to access them +at once, strange things can happen. You may want to close or reopen +the filehandles for the child. You can get around this by opening +your pipe with open(), but on some systems this means that the child +process cannot outlive the parent. + +=head2 Background Processes + +You can run a command in the background with: + + system("cmd&"); + +The command's STDOUT and STDERR (and possibly STDIN, depending on your +shell) will be the same as the parent's. You won't need to catch +SIGCHLD because of the double-fork taking place (see below for more +details). + +=head2 Complete Dissociation of Child from Parent + +In some cases (starting server processes, for instance) you'll want to +complete dissociate the child process from the parent. The following +process is reported to work on most Unixish systems. Non-Unix users +should check their Your_OS::Process module for other solutions. + +=over 4 + +=item * + +Open /dev/tty and use the the TIOCNOTTY ioctl on it. See L<tty(4)> +for details. + +=item * + +Change directory to / + +=item * + +Reopen STDIN, STDOUT, and STDERR so they're not connected to the old +tty. + +=item * + +Background yourself like this: + + fork && exit; + +=back + =head2 Safe Pipe Opens Another interesting approach to IPC is making your single program go @@ -428,6 +479,14 @@ setting C<$AF_INET = 2>, you know you're in for big trouble: An immeasurably superior approach is to use the C<Socket> module, which more reliably grants access to various constants and functions you'll need. +If you're not writing a server/client for an existing protocol like +NNTP or SMTP, you should give some thought to how your server will +know when the client has finished talking, and vice-versa. Most +protocols are based on one-line messages and responses (so one party +knows the other has finished when a "\n" is received) or multiline +messages and responses that end with a period on an empty line +("\n.\n" terminates a message/response). + =head2 Internet TCP Clients and Servers Use Internet-domain sockets when you want to do client-server diff --git a/pod/perllocale.pod b/pod/perllocale.pod index d393b81483..31ab40a58d 100644 --- a/pod/perllocale.pod +++ b/pod/perllocale.pod @@ -5,7 +5,7 @@ perllocale - Perl locale handling (internationalization and localization) =head1 DESCRIPTION Perl supports language-specific notions of data such as "is this a -letter", "what is the upper-case equivalent of this letter", and "which +letter", "what is the uppercase equivalent of this letter", and "which of these letters comes first". These are important issues, especially for languages other than English - but also for English: it would be very naE<iuml>ve to think that C<A-Za-z> defines all the "letters". Perl @@ -371,7 +371,7 @@ setting, characters like 'E<aelig>', 'E<eth>', 'E<szlig>', and 'E<oslash>' may be understood as C<\w> characters. The C<LC_CTYPE> locale also provides the map used in translating -characters between lower- and upper-case. This affects the case-mapping +characters between lower and uppercase. This affects the case-mapping functions - lc(), lcfirst, uc() and ucfirst(); case-mapping interpolation with C<\l>, C<\L>, C<\u> or <\U> in double-quoted strings and in C<s///> substitutions; and case-independent regular expression diff --git a/pod/perlobj.pod b/pod/perlobj.pod index c8b85b4b7d..07a71dc203 100644 --- a/pod/perlobj.pod +++ b/pod/perlobj.pod @@ -283,7 +283,7 @@ are inherited by all other classes: =item isa(CLASS) -C<isa> returns I<true> if its object is blessed into a sub-class of C<CLASS> +C<isa> returns I<true> if its object is blessed into a subclass of C<CLASS> C<isa> is also exportable and can be called as a sub with two arguments. This allows the ability to check what a reference points to. Example diff --git a/pod/perlop.pod b/pod/perlop.pod index 71794fa759..c4a342be7b 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -767,12 +767,13 @@ Here is the output (split into several lines): =item C<'STRING'> -A single-quoted, literal string. Backslashes are ignored, unless -followed by the delimiter or another backslash, in which case the -delimiter or backslash is interpolated. +A single-quoted, literal string. A backslash represents a backslash +unless followed by the delimiter or another backslash, in which case +the delimiter or backslash is interpolated. $foo = q!I said, "You said, 'She said it.'"!; $bar = q('This is it.'); + $baz = '\n'; # a two-character string =item qq/STRING/ @@ -783,6 +784,7 @@ A double-quoted, interpolated string. $_ .= qq (*** The previous line contains the naughty word "$1".\n) if /(tcl|rexx|python)/; # :-) + $baz = "\n"; # a one-character string =item qx/STRING/ @@ -1190,3 +1192,23 @@ for them. By default, their results are interpreted as unsigned integers. However, if C<use integer> is in effect, their results are interpreted as signed integers. For example, C<~0> usually evaluates to a large integral value. However, C<use integer; ~0> is -1. + +=head2 Floating-point Arithmetic + +While C<use integer> provides integer-only arithmetic, there is no +similar ways to provide rounding or truncation at a certain number of +decimal places. For rounding to a certain number of digits, sprintf() +or printf() is usually the easiest route. + +The POSIX module (part of the standard perl distribution) implements +ceil(), floor(), and a number of other mathematical and trigonometric +functions. The Math::Complex module (part of the standard perl +distribution) defines a number of mathematical functions that can also +work on real numbers. Math::Complex not as efficient as POSIX, but +POSIX can't work with complex numbers. + +Rounding in financial applications can have serious implications, and +the rounding method used should be specified precisely. In these +cases, it probably pays not to trust whichever system rounding is +being used by Perl, but to instead implement the rounding function you +need yourself. diff --git a/pod/perlre.pod b/pod/perlre.pod index cb3ce032d0..74a8bd9fd5 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -9,9 +9,10 @@ description of how to I<use> regular expressions in matching operations, plus various examples of the same, see C<m//> and C<s///> in L<perlop>. -The matching operations can -have various modifiers, some of which relate to the interpretation of -the regular expression inside. These are: +The matching operations can have various modifiers. The modifiers +which relate to the interpretation of the regular expression inside +are listed below. For the modifiers that alter the behaviour of the +operation, see L<perlop/"m//"> and L<perlop/"s//">. =over 4 @@ -167,7 +168,7 @@ Perl defines the following zero-width assertions: \G Match only where previous m//g left off A word boundary (C<\b>) is defined as a spot between two characters that -has a C<\w> on one side of it and and a C<\W> on the other side of it (in +has a C<\w> on one side of it and a C<\W> on the other side of it (in either order), counting the imaginary characters off the beginning and end of the string as matching a C<\W>. (Within character classes C<\b> represents backspace rather than a word boundary.) The C<\A> and C<\Z> are @@ -214,6 +215,17 @@ everything after the matched string. Examples: $seconds = $3; } +Once perl sees that you need one of C<$&>, C<$`> or C<$'> anywhere in +the program, it has to provide them on each and every pattern match. +This can slow your program down. The same mechanism that handles +these provides for the use of $1, $2, etc., so you pay the same price +for each regexp that contains capturing parentheses. But if you never +use $&, etc., in your script, then regexps I<without> capturing +parentheses won't be penalized. So avoid $&, $', and $` if you can, +but if you can't (and some algorithms really appreciate them), once +you've used them once, use them at will, because you've already paid +the price. + You will note that all backslashed metacharacters in Perl are alphanumeric, such as C<\b>, C<\w>, C<\n>. Unlike some other regular expression languages, there are no backslashed symbols that aren't alphanumeric. @@ -326,7 +338,7 @@ When the match runs, the first part of the regular expression (C<\b(foo)>) finds a possible match right at the beginning of the string, and loads up $1 with "Foo". However, as soon as the matching engine sees that there's no whitespace following the "Foo" that it had saved in $1, it realizes its -mistake and starts over again one character after where it had had the +mistake and starts over again one character after where it had the tentative match. This time it goes all the way until the next occurrence of "foo". The complete regular expression matches this time, and you get the expected output of "table follows foo." diff --git a/pod/perlrun.pod b/pod/perlrun.pod index f90e642d40..a2e0764c7b 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -87,6 +87,84 @@ If the script is syntactically correct, it is executed. If the script runs off the end without hitting an exit() or die() operator, an implicit C<exit(0)> is provided to indicate successful completion. +=head2 #! and quoting on non-Unix systems + +Unix's #! technique can be simulated on other systems: + +=over 4 + +=item OS/2 + +Put + + extproc perl -S -your_switches + +as the first line in C<*.cmd> file (C<-S> due to a bug in cmd.exe's +`extproc' handling). + +=item DOS + +Create a batch file to run your script, and codify it in +C<ALTERNATIVE_SHEBANG> (see the F<dosish.h> file in the source +distribution for more information). + +=item Win95/NT + +The Win95/NT installation, when using the Activeware port of Perl, +will modify the Registry to associate the .pl extension with the perl +interpreter. If you install another port of Perl, including the one +in the win32 directory of the Perl distribution, then you'll have to +modify the Registry yourself. + +=item Macintosh + +Macintosh perl scripts will have the the appropriate Creator and +Type, so that double-clicking them will invoke the perl application. + +=back + +Command-interpreters on non-Unix systems have rather different ideas +on quoting than Unix shells. You'll need to learn the special +characters in your command-interpreter (C<*>, C<\> and C<"> are +common) and how to protect whitespace and these characters to run +one-liners (see C<-e> below). + +On some systems, you may have to change single-quotes to double ones, +which you must I<NOT> do on Unix or Plan9 systems. You might also +have to change a single % to a %%. + +For example: + + # Unix + perl -e 'print "Hello world\n"' + + # DOS, etc. + perl -e "print \"Hello world\n\"" + + # Mac + print "Hello world\n" + (then Run "Myscript" or Shift-Command-R) + + # VMS + perl -e "print ""Hello world\n""" + +The problem is that none of this is reliable: it depends on the command +tirely possible neither works. If 4DOS was the command shell, this would +probably work better: + + perl -e "print <Ctrl-x>"Hello world\n<Ctrl-x>"" + +CMD.EXE in Windows NT slipped a lot of standard Unix functionality in +when nobody was looking, but just try to find documentation for its +quoting rules. + +Under the Mac, it depends which environment you are using. The MacPerl +shell, or MPW, is much like Unix shells in its support for several +quoting variants, except that it makes free use of the Mac's non-ASCII +characters as control characters. + +There is no general solution to all of this. It's just a mess. + =head2 Switches A single-character switch may be combined with the following switch, if diff --git a/pod/perlsec.pod b/pod/perlsec.pod index 6089431a2a..0d72cf0ca6 100644 --- a/pod/perlsec.pod +++ b/pod/perlsec.pod @@ -287,3 +287,38 @@ SysVr4 and BSD 4.4 use this approach to avoid the kernel race condition. Prior to release 5.003 of Perl, a bug in the code of B<suidperl> could introduce a security hole in systems compiled with strict POSIX compliance. + +=head2 Protecting Your Programs + +There are a number of ways to hide the source to your Perl programs, +with varying levels of "security". + +First of all, however, you I<can't> take away read permission, because +the source code has to be readable in order to be compiled and +interpreted. (That doesn't mean that a CGI script's source is +readable by people on the web, though.) So you have to leave the +permissions at the socially friendly 0755 level. + +Some people regard this as a security problem. If your program does +insecure things, and relies on people not knowing how to exploit those +insecurities, it is not secure. It is often possible for someone to +determine the insecure things and exploit them without viewing the +source. Security through obscurity, the name for hiding your bugs +instead of fixing them, is little security indeed. + +You can try using encryption via source filters (Filter::* from CPAN). +But crackers might be able to decrypt it. You can try using the +byte-code compiler and interpreter described below, but crackers might +be able to de-compile it. You can try using the native-code compiler +described below, but crackers might be able to disassemble it. These +pose varying degrees of difficulty to people wanting to get at your +code, but none can definitively conceal it (this is true of every +language, not just Perl). + +If you're concerned about people profiting from your code, then the +bottom line is that nothing but a restrictive licence will give you +legal security. License your software and pepper it with threatening +statements like "This is unpublished proprietary software of XYZ Corp. +Your access to it does not give you permission to use it blah blah +blah." You should see a lawyer to be sure your licence's wording will +stand up in court. diff --git a/pod/perltoc.pod b/pod/perltoc.pod index eb59cda02e..4e412bd7b8 100644 --- a/pod/perltoc.pod +++ b/pod/perltoc.pod @@ -38,6 +38,769 @@ expression enhancements, Innumerable Unbundled Modules, Compilability =item NOTES +=head2 perlfaq - frequently asked questions about Perl ($Date: 1997/03/17 +22:17:56 $) + +=item DESCRIPTION + +perlfaq: Structural overview of the FAQ, L<perlfaq1>: General Questions +About Perl, L<perlfaq2>: Obtaining and Learning about Perl, L<perlfaq3>: +Programming Tools, L<perlfaq4>: Data Manipulation, L<perlfaq5>: Files and +Formats, L<perlfaq6>: Regexps, L<perlfaq7>: General Perl Language Issues, +L<perlfaq8>: System Interaction, L<perlfaq9>: Networking + +=over + +=item Where to get this document + +=item How to contribute to this document + +=item What will happen if you mail your Perl programming problems to the +authors + +=back + +=item Credits + +=item Author and Copyright Information + +=over + +=item Non-commercial Reproduction + +=item Commercial Reproduction + +=item Disclaimer + +=back + +=item Changes + +17/March/97 Version, Initial Release: 11/March/97 + +=head2 perlfaq1 - General Questions About Perl ($Revision: 1.10 $) + +=item DESCRIPTION + +=over + +=item What is Perl? + +=item Who supports Perl? Who develops it? Why is it free? + +=item Which version of Perl should I use? + +=item What are perl4 and perl5? + +=item How stable is Perl? + +=item Is Perl difficult to learn? + +=item How does Perl compare with other languages like Java, Python, REXX, +Scheme, or Tcl? + +=item Can I do [task] in Perl? + +=item When shouldn't I program in Perl? + +=item What's the difference between "perl" and "Perl"? + +=item Is it a Perl program or a Perl script? + +=item What is a JAPH? + +=item Where can I get a list of Larry Wall witticisms? + +=item How can I convince my sysadmin/supervisor/employees to use version +(5/5.004/Perl instead of some other language)? + +=back + +=item AUTHOR AND COPYRIGHT + +=head2 perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.13 $) + +=item DESCRIPTION + +=over + +=item What machines support Perl? Where do I get it? + +=item How can I get a binary version of Perl? + +=item I copied the Perl binary from one machine to another, but scripts +don't work. + +=item I grabbed the sources and tried to compile but gdbm/dynamic +loading/malloc/linking/... failed. How do I make it work? + +=item What modules and extensions are available for Perl? What is CPAN? +What does CPAN/src/... mean? + +=item Is there an ISO or ANSI certified version of Perl? + +=item Where can I get information on Perl? + +=item What are the Perl newsgroups on USENET? Where do I post questions? + +=item Where should I post source code? + +=item Perl Books + +=item Perl in Magazines + +=item Perl on the Net: FTP and WWW Access + +=item What mailing lists are there for perl? + +MacPerl, Perl5-Porters, NTPerl, Perl-Packrats + +=item Archives of comp.lang.perl.misc + +=item Perl Training + +=item Where can I buy a commercial version of Perl? + +=item Where do I send bug reports? + +=item What is perl.com? perl.org? The Perl Institute? + +=item How do I learn about object-oriented Perl programming? + +=back + +=item AUTHOR AND COPYRIGHT + +=head2 perlfaq3 - Programming Tools ($Revision: 1.19 $) + +=item DESCRIPTION + +=over + +=item How do I do (anything)? + +=item How can I use Perl interactively? + +=item Is there a Perl shell? + +=item How do I debug my Perl programs? + +=item How do I profile my Perl programs? + +=item How do I cross-reference my Perl programs? + +=item Is there a pretty-printer (formatter) for Perl? + +=item Is there a ctags for Perl? + +=item Where can I get Perl macros for vi? + +=item Where can I get perl-mode for emacs? + +=item How can I use curses with Perl? + +=item How can I use X or Tk with Perl? + +=item How can I generate simple menus without using CGI or Tk? + +=item Can I dynamically load C routines into Perl? + +=item What is undump? + +=item How can I make my Perl program run faster? + +=item How can I make my Perl program take less memory? + +=item Is it unsafe to return a pointer to local data? + +=item How can I free an array or hash so my program shrinks? + +=item How can I make my CGI script more efficient? + +=item How can I hide the source for my Perl program? + +=item How can I compile my Perl program into byte-code or C? + +=item How can I get '#!perl' to work on [MSDOS,NT,...]? + +=item Can I write useful perl programs on the command line? + +=item Why don't perl one-liners work on my DOS/Mac/VMS system? + +=item Where can I learn about CGI or Web programming in Perl? + +=item Where can I learn about object-oriented Perl programming? + +=item Where can I learn about linking C with Perl? [h2xs, xsubpp] + +=item I've read perlembed, perlguts, etc., but I can't embed perl in +my C program, what am I doing wrong? + +=item When I tried to run my script, I got this message. What does it +mean? + +=item What's MakeMaker? + +=back + +=item AUTHOR AND COPYRIGHT + +=head2 perlfaq4 - Data Manipulation ($Revision: 1.15 $) + +=item DESCRIPTION + +=item Data: Numbers + +=over + +=item Why isn't my octal data interpreted correctly? + +=item Does perl have a round function? What about ceil() and floor()? +Trig functions? + +=item How do I convert bits into ints? + +=item How do I multiply matrices? + +=item How do I perform an operation on a series of integers? + +=item How can I output Roman numerals? + +=item Why aren't my random numbers random? + +=back + +=item Data: Dates + +=over + +=item How do I find the week-of-the-year/day-of-the-year? + +=item How can I compare two date strings? + +=item How can I take a string and turn it into epoch seconds? + +=item How can I find the Julian Day? + +=item Does Perl have a year 2000 problem? + +=back + +=item Data: Strings + +=over + +=item How do I validate input? + +=item How do I unescape a string? + +=item How do I remove consecutive pairs of characters? + +=item How do I expand function calls in a string? + +=item How do I find matching/nesting anything? + +=item How do I reverse a string? + +=item How do I expand tabs in a string? + +=item How do I reformat a paragraph? + +=item How can I access/change the first N letters of a string? + +=item How do I change the Nth occurrence of something? + +=item How can I count the number of occurrences of a substring within a +string? + +=item How do I capitalize all the words on one line? + +=item How can I split a [character] delimited string except when inside +[character]? (Comma-separated files) + +=item How do I strip blank space from the beginning/end of a string? + +=item How do I extract selected columns from a string? + +=item How do I find the soundex value of a string? + +=item How can I expand variables in text strings? + +=item What's wrong with always quoting "$vars"? + +=item Why don't my <<HERE documents work? + +1. There must be no space after the << part, 2. There (probably) should be +a semicolon at the end, 3. You can't (easily) have any space in front of +the tag + +=back + +=item Data: Arrays + +=over + +=item What is the difference between $array[1] and @array[1]? + +=item How can I extract just the unique elements of an array? + +a) If @in is sorted, and you want @out to be sorted:, b) If you don't know +whether @in is sorted:, c) Like (b), but @in contains only small integers:, +d) A way to do (b) without any loops or greps:, e) Like (d), but @in +contains only small positive integers: + +=item How can I tell whether an array contains a certain element? + +=item How do I compute the difference of two arrays? How do I compute the +intersection of two arrays? + +=item How do I find the first array element for which a condition is true? + +=item How do I handle linked lists? + +=item How do I handle circular lists? + +=item How do I shuffle an array randomly? + +=item How do I process/modify each element of an array? + +=item How do I select a random element from an array? + +=item How do I permute N elements of a list? + +=item How do I sort an array by (anything)? + +=item How do I manipulate arrays of bits? + +=item Why does defined() return true on empty arrays and hashes? + +=back + +=item Data: Hashes (Associative Arrays) + +=over + +=item How do I process an entire hash? + +=item What happens if I add or remove keys from a hash while iterating over +it? + +=item How do I look up a hash element by value? + +=item How can I know how many entries are in a hash? + +=item How do I sort a hash (optionally by value instead of key)? + +=item How can I always keep my hash sorted? + +=item What's the difference between "delete" and "undef" with hashes? + +=item Why don't my tied hashes make the defined/exists distinction? + +=item How do I reset an each() operation part-way through? + +=item How can I get the unique keys from two hashes? + +=item How can I store a multidimensional array in a DBM file? + +=item How can I make my hash remember the order I put elements into it? + +=item Why does passing a subroutine an undefined element in a hash create +it? + +=item How can I make the Perl equivalent of a C structure/C++ class/hash +or array of hashes or arrays? + +=item How can I use a reference as a hash key? + +=back + +=item Data: Misc + +=over + +=item How do I handle binary data correctly? + +=item How do I determine whether a scalar is a number/whole/integer/float? + +=item How do I keep persistent data across program calls? + +=item How do I print out or copy a recursive data structure? + +=item How do I define methods for every class/object? + +=item How do I verify a credit card checksum? + +=back + +=item AUTHOR AND COPYRIGHT + +=head2 perlfaq5 - Files and Formats ($Revision: 1.19 $) + +=item DESCRIPTION + +=over + +=item How do I flush/unbuffer a filehandle? Why must I do this? + +=item How do I change one line in a file/delete a line in a file/insert a +line in the middle of a file/append to the beginning of a file? + +=item How do I count the number of lines in a file? + +=item How do I make a temporary file name? + +=item How can I manipulate fixed-record-length files? + +=item How can I make a filehandle local to a subroutine? How do I pass +filehandles between subroutines? How do I make an array of filehandles? + +=item How can I set up a footer format to be used with write()? + +=item How can I write() into a string? + +=item How can I output my numbers with commas added? + +=item How can I translate tildes (~) in a filename? + +=item How come when I open the file read-write it wipes it out? + +=item Why do I sometimes get an "Argument list too long" when I use <*>? + +=item Is there a leak/bug in glob()? + +=item How can I open a file with a leading "E<gt>" or trailing blanks? + +=item How can I reliably rename a file? + +=item How can I lock a file? + +=item What can't I just open(FH, ">file.lock")? + +=item I still don't get locking. I just want to increment the number +in the file. How can I do this? + +=item How do I randomly update a binary file? + +=item How do I get a file's timestamp in perl? + +=item How do I set a file's timestamp in perl? + +=item How do I print to more than one file at once? + +=item How can I read in a file by paragraphs? + +=item How can I read a single character from a file? From the keyboard? + +=item How can I tell if there's a character waiting on a filehandle? + +=item How do I open a file without blocking? + +=item How do I create a file only if it doesn't exist? + +=item How do I do a C<tail -f> in perl? + +=item How do I dup() a filehandle in Perl? + +=item How do I close a file descriptor by number? + +=item Why can't I use "C:\temp\foo" in DOS paths? What doesn't +`C:\temp\foo.exe` work? + +=item Why doesn't glob("*.*") get all the files? + +=item Why does Perl let me delete read-only files? Why does C<-i> clobber +protected files? Isn't this a bug in Perl? + +=item How do I select a random line from a file? + +=back + +=item AUTHOR AND COPYRIGHT + +=head2 perlfaq6 - Regexps ($Revision: 1.14 $) + +=item DESCRIPTION + +=over + +=item How can I hope to use regular expressions without creating illegible +and unmaintainable code? + +Comments Outside the Regexp, Comments Inside the Regexp, Different +Delimiters + +=item I'm having trouble matching over more than one line. What's wrong? + +=item How can I pull out lines between two patterns that are themselves on +different lines? + +=item I put a regular expression into $/ but it didn't work. What's wrong? + +=item How do I substitute case insensitively on the LHS, but preserving +case on the RHS? + +=item How can I make C<\w> match accented characters? + +=item How can I match a locale-smart version of C</[a-zA-Z]/>? + +=item How can I quote a variable to use in a regexp? + +=item What is C</o> really for? + +=item How do I use a regular expression to strip C style comments from a +file? + +=item Can I use Perl regular expressions to match balanced text? + +=item What does it mean that regexps are greedy? How can I get around it? + +=item How do I process each word on each line? + +=item How can I print out a word-frequency or line-frequency summary? + +=item How can I do approximate matching? + +=item How do I efficiently match many regular expressions at once? + +=item Why don't word-boundary searches with C<\b> work for me? + +=item Why does using $&, $`, or $' slow my program down? + +=item What good is C<\G> in a regular expression? + +=item Are Perl regexps DFAs or NFAs? Are they POSIX compliant? + +=item What's wrong with using grep or map in a void context? + +=item How can I match strings with multi-byte characters? + +=back + +=item AUTHOR AND COPYRIGHT + +=head2 perlfaq7 - Perl Language Issues ($Revision: 1.15 $) + +=item DESCRIPTION + +=over + +=item Can I get a BNF/yacc/RE for the Perl language? + +=item What are all these $@%* punctuation signs, and how do I know when to +use them? + +=item Do I always/never have to quote my strings or use semicolons and +commas? + +=item How do I skip some return values? + +=item How do I temporarily block warnings? + +=item What's an extension? + +=item Why do Perl operators have different precedence than C operators? + +=item How do I declare/create a structure? + +=item How do I create a module? + +=item How do I create a class? + +=item How can I tell if a variable is tainted? + +=item What's a closure? + +=item How can I pass/return a {Function, FileHandle, Array, Hash, Method, +Regexp}? + +Passing Variables and Functions, Passing Filehandles, Passing Regexps, +Passing Methods + +=item How do I create a static variable? + +=item What's the difference between dynamic and lexical (static) scoping? +Between local() and my()? + +=item How can I access a dynamic variable while a similarly named lexical +is in scope? + +=item What's the difference between deep and shallow binding? + +=item Why doesn't "local($foo) = <FILE>;" work right? + +=item How do I redefine a built-in function, operator, or method? + +=item What's the difference between calling a function as &foo and foo()? + +=item How do I create a switch or case statement? + +=item How can I catch accesses to undefined variables/functions/methods? + +=item Why can't a method included in this same file be found? + +=item How can I find out my current package? + +=back + +=item AUTHOR AND COPYRIGHT + +=head2 perlfaq8 - System Interaction ($Revision: 1.15 $) + +=item DESCRIPTION + +=over + +=item How do I find out which operating system I'm running under? + +=item How come exec() doesn't return? + +=item How do I do fancy stuff with the keyboard/screen/mouse? + +Keyboard, Screen, Mouse + +=item How do I ask the user for a password? + +=item How do I read and write the serial port? + +lockfiles, open mode, end of line, flushing output, non-blocking input + +=item How do I decode encrypted password files? + +=item How do I start a process in the background? + +STDIN, STDOUT and STDERR are shared, Signals, Zombies + +=item How do I trap control characters/signals? + +=item How do I modify the shadow password file on a Unix system? + +=item How do I set the time and date? + +=item How can I sleep() or alarm() for under a second? + +=item How can I measure time under a second? + +=item How can I do an atexit() or setjmp()/longjmp()? (Exception handling) + +=item Why doesn't my sockets program work under System V (Solaris)? What +does the error message "Protocol not supported" mean? + +=item How can I call my system's unique C functions from Perl? + +=item Where do I get the include files to do ioctl() or syscall()? + +=item Why do setuid perl scripts complain about kernel problems? + +=item How can I open a pipe both to and from a command? + +=item How can I capture STDERR from an external command? + +=item Why doesn't open() return an error when a pipe open fails? + +=item What's wrong with using backticks in a void context? + +=item How can I call backticks without shell processing? + +=item Why can't my script read from STDIN after I gave it EOF (^D on Unix, +^Z on MSDOS)? + +=item How can I convert my shell script to perl? + +=item Can I use perl to run a telnet or ftp session? + +=item How can I write expect in Perl? + +=item Is there a way to hide perl's command line from programs such as +"ps"? + +=item I {changed directory, modified my environment} in a perl script. How +come the change disappeared when I exited the script? How do I get my +changes to be visible? + +Unix, VMS + +=item How do I close a process's filehandle without waiting for it to +complete? + +=item How do I fork a daemon process? + +=item How do I make my program run with sh and csh? + +=item How do I keep my own module/library directory? + +=item How do I find out if I'm running interactively or not? + +=item How do I timeout a slow event? + +=item How do I set CPU limits? + +=item How do I avoid zombies on a Unix system? + +=item How do I use an SQL database? + +=item How do I make a system() exit on control-C? + +=item How do I open a file without blocking? + +=item How do I install a CPAN module? + +=back + +=item AUTHOR AND COPYRIGHT + +=head2 perlfaq9 - Networking ($Revision: 1.13 $) + +=item DESCRIPTION + +=over + +=item My CGI script runs from the command line but not the browser. Can +you help me fix it? + +=item How do I remove HTML from a string? + +=item How do I extract URLs? + +=item How do I download a file from the user's machine? How do I open a +file on another machine? + +=item How do I make a pop-up menu in HTML? + +=item How do I fetch an HTML file? + +=item how do I decode or create those %-encodings on the web? + +=item How do I redirect to another page? + +=item How do I put a password on my web pages? + +=item How do I edit my .htpasswd and .htgroup files with Perl? + +=item How do I parse an email header? + +=item How do I decode a CGI form? + +=item How do I check a valid email address? + +=item How do I decode a MIME/BASE64 string? + +=item How do I return the user's email address? + +=item How do I send/read mail? + +=item How do I find out my hostname/domainname/IP address? + +=item How do I fetch a news article or the active newsgroups? + +=item How do I fetch/put an FTP file? + +=item How can I do RPC in Perl? + +=back + +=item AUTHOR AND COPYRIGHT + =head2 perldelta - what's new for perl5.004 =item DESCRIPTION @@ -50,14 +813,18 @@ expression enhancements, Innumerable Unbundled Modules, Compilability =item Compilation Option: Binary Compatibility With 5.003 -=item Subroutine Parameters Are Not Autovivified +=item No Autovivification of Subroutine Parameters =item Fixed Parsing of $$<digit>, &$<digit>, etc. +=item No Resetting of $. on Implicit Close + =item Changes to Tainting Checks =item New Opcode Module and Revised Safe Module +=item Embedding Improvements + =item Internal Change: FileHandle Class Based on IO::* Classes =item Internal Change: PerlIO internal IO abstraction interface @@ -285,6 +1052,8 @@ y/SEARCHLIST/REPLACEMENTLIST/cds =item Integer Arithmetic +=item Floating-point Arithmetic + =back =head2 perlre - Perl regular expressions @@ -315,6 +1084,10 @@ i, m, s, x =over +=item #! and quoting on non-Unix systems + +OS/2, DOS, Win95/NT, Macintosh + =item Switches B<-0>[I<digits>], B<-a>, B<-c>, B<-d>, B<-d:>I<foo>, B<-D>I<number>, @@ -452,7 +1225,7 @@ $EFFECTIVE_USER_ID, $EUID, $>, $REAL_GROUP_ID, $GID, $(, $EFFECTIVE_GROUP_ID, $EGID, $), $PROGRAM_NAME, $0, $[, $PERL_VERSION, $], $DEBUGGING, $^D, $SYSTEM_FD_MAX, $^F, $^H, $INPLACE_EDIT, $^I, $OSNAME, $^O, $PERLDB, $^P, $BASETIME, $^T, $WARNING, $^W, $EXECUTABLE_NAME, $^X, -$ARGV, @ARGV, @INC, %INC, $ENV{expr}, $SIG{expr} +$ARGV, @ARGV, @INC, %INC, $ENV{expr}, $SIG{expr}, $^M =back @@ -1017,6 +1790,12 @@ safe subprocesses, sockets, and semaphores) =over +=item Filehandles + +=item Background Processes + +=item Complete Dissociation of Child from Parent + =item Safe Pipe Opens =item Bidirectional Communication @@ -1115,6 +1894,8 @@ Prompt, Multi-line commands, Stack backtrace, Listing, Frame listing =item Security Bugs +=item Protecting Your Programs + =back =head2 perltrap - Perl traps for the unwary @@ -1144,7 +1925,7 @@ Subroutine, Signal, Sorting Traps, OS Traps, DBM Traps, Unclassified Traps Discontinuance, Deprecation, BugFix, Discontinuance, Discontinuance, Discontinuance, BugFix, Discontinuance, Discontinuance, BugFix, -Discontinuance, Deprecation, Discontinuance +Discontinuance, Discontinuance, Deprecation, Discontinuance =item Parsing Traps @@ -1172,7 +1953,7 @@ Precedence Regular Expression, Regular Expression, Regular Expression, Regular Expression, Regular Expression, Regular Expression, Regular Expression, -Regular Expression +Regular Expression, Regular Expression =item Subroutine, Signal, Sorting Traps @@ -1471,7 +2252,7 @@ B<PerlIO_get_base(f)>, B<PerlIO_get_bufsiz(f)> =over -=item XSUB's and the Argument Stack +=item XSUBs and the Argument Stack =item Calling Perl Routines from within C Programs @@ -1512,10 +2293,10 @@ av_shift, av_store, av_undef, av_unshift, CLASS, Copy, croak, CvSTASH, DBsingle, DBsub, DBtrace, dMARK, dORIGMARK, dowarn, dSP, dXSARGS, dXSI32, dXSI32, ENTER, EXTEND, FREETMPS, G_ARRAY, G_DISCARD, G_EVAL, GIMME, G_NOARGS, G_SCALAR, gv_fetchmeth, gv_fetchmethod, gv_stashpv, gv_stashsv, -GvSV, he_delayfree, HEf_SVKEY, he_free, HeHASH, HeKEY, HeKLEN, HePV, -HeSVKEY, HeSVKEY_force, HeSVKEY_set, HeVAL, hv_clear, hv_delete, -hv_delete_ent, hv_exists, hv_exists_ent, hv_fetch, hv_fetch_ent, -hv_iterinit, hv_iterkey, hv_iterkeysv +GvSV, HEf_SVKEY, HeHASH, HeKEY, HeKLEN, HePV, HeSVKEY, HeSVKEY_force, +HeSVKEY_set, HeVAL, hv_clear, hv_delayfree_ent, hv_delete, hv_delete_ent, +hv_exists, hv_exists_ent, hv_fetch, hv_fetch_ent, hv_free_ent, hv_iterinit, +hv_iterkey, hv_iterkeysv Returns the key as an C<SV*> from the current position of the hash iterator. The return value will always be a mortal copy of the key. Also see C<hv_iterinit>, hv_iternext, hv_iternextsv, hv_iterval, @@ -1632,6 +2413,20 @@ callback =head1 PRAGMA DOCUMENTATION +=head2 autouse - postpone load of modules until a function is used + +=item SYNOPSIS + +=item DESCRIPTION + +=item WARNING + +=item BUGS + +=item AUTHOR + +=item SEE ALSO + =head2 blib - Use MakeMaker's uninstalled version of a package =item SYNOPSIS @@ -2030,7 +2825,7 @@ B<DB_HASH>, B<DB_BTREE>, B<DB_RECNO> =over -=item How does DB_File interface to Berkeley DB? +=item Interface to Berkeley DB =item Opening a Berkeley DB Database File @@ -2044,7 +2839,7 @@ B<DB_HASH>, B<DB_BTREE>, B<DB_RECNO> =over -=item A Simple Example. +=item A Simple Example =back @@ -2054,9 +2849,9 @@ B<DB_HASH>, B<DB_BTREE>, B<DB_RECNO> =item Changing the BTREE sort order -=item Handling duplicate keys +=item Handling Duplicate Keys -=item The get_dup method. +=item The get_dup() Method =item Matching Partial Keys @@ -2066,7 +2861,7 @@ B<DB_HASH>, B<DB_BTREE>, B<DB_RECNO> =over -=item The bval option +=item The 'bval' Option =item A Simple Example @@ -2092,9 +2887,9 @@ $value, $flags) ;>, B<$status = $X-E<gt>sync([$flags]) ;> =item Locking Databases -=item Sharing databases with C applications +=item Sharing Databases With C Applications -=item The untie gotcha +=item The untie() Gotcha =back @@ -2183,6 +2978,23 @@ variables =back +=head2 ExtUtils::Command - utilities to replace common UNIX commands in +Makefiles etc. + +=item SYNOPSYS + +=item DESCRIPTION + +cat, eqtime src dst, rm_f files..., rm_f files..., touch files .., mv +source... destination, cp source... destination, chmod mode files.., mkpath +directory.., test_f file + +=item BUGS + +=item SEE ALSO + +=item AUTHOR + =head2 ExtUtils::Embed - Utilities for embedding Perl in C/C++ applications =item SYNOPSIS @@ -2276,7 +3088,7 @@ post_initialize (o), postamble (o), prefixify, processPL (o), realclean (o), replace_manpage_separator, static (o), static_lib (o), staticmake (o), subdir_x (o), subdirs (o), test (o), test_via_harness (o), test_via_script (o), tool_autosplit (o), tools_other (o), tool_xsubpp (o), top_targets (o), -writedoc, xs_c (o), xs_o (o) +writedoc, xs_c (o), xs_o (o), perl_archive, export_list =back @@ -2316,6 +3128,17 @@ dist_dir (override), dist_test (override), install (override), perldepend =back +=head2 ExtUtils::MM_Win32 - methods to override UN*X behaviour in +ExtUtils::MakeMaker + +=item SYNOPSIS + +=item DESCRIPTION + +catfile, static_lib (o), dynamic_lib (o), canonpath, perl_script, +pm_to_blib, test_via_harness (o), tool_autosplit (override), tools_other +(o), manifypods (o), dist_ci (o), dist_core (o), pasthru (o) + =head2 ExtUtils::MakeMaker - create an extension Makefile =item SYNOPSIS @@ -2951,7 +3774,7 @@ functions =item BUGS -=item AUTHOR +=item AUTHORS =head2 NDBM_File - Tied access to ndbm files diff --git a/pod/perltoot.pod b/pod/perltoot.pod index 41a9a5fd11..a8a77f1c68 100644 --- a/pod/perltoot.pod +++ b/pod/perltoot.pod @@ -268,7 +268,7 @@ Destruction happens automatically via Perl's garbage collection (GC) system, which is a quick but somewhat lazy reference-based GC system. To know what to call, Perl insists that the destructor be named DESTROY. -Why is DESTROY in all caps? Perl on occasion uses purely upper-case +Why is DESTROY in all caps? Perl on occasion uses purely uppercase function names as a convention to indicate that the function will be automatically called by Perl in some way. Others that are called implicitly include BEGIN, END, AUTOLOAD, plus all methods used by @@ -886,7 +886,7 @@ This is a form of Laziness. (Getting polymorphed is also what happens when the wizard decides you'd look better as a frog.) Every now and then you'll want to have a method call trigger both its -derived class (also know as "subclass") version as well as its base class +derived class (also known as "subclass") version as well as its base class (also known as "superclass") version. In practice, constructors and destructors are likely to want to do this, and it probably also makes sense in the debug() method we showed previously. @@ -1112,7 +1112,7 @@ class) has a package global called $VERSION that's high enough, as in: $his_vers = $ob->VERSION(); However, we don't usually call VERSION ourselves. (Remember that an all -upper-case function name is a Perl convention that indicates that the +uppercase function name is a Perl convention that indicates that the function will be automatically used by Perl in some way.) In this case, it happens when you say @@ -1163,7 +1163,7 @@ instead of a hash reference to represent the object. sub new { my $self = []; $self->[$NAME] = undef; # this is unnecessary - $self->[$AGE] = undef; # as it this + $self->[$AGE] = undef; # as is this $self->[$PEERS] = []; # but this isn't, really bless($self); return $self; @@ -1623,7 +1623,7 @@ You can look at other object-based, struct-like overrides of core functions in the 5.004 release of Perl in File::stat, Net::hostent, Net::netent, Net::protoent, Net::servent, Time::gmtime, Time::localtime, User::grent, and User::pwent. These modules have a final component -that's all lower-case, by convention reserved for compiler pragmas, +that's all lowercase, by convention reserved for compiler pragmas, because they affect the compilation and change a built-in function. They also have the type names that a C programmer would most expect. diff --git a/pod/perltrap.pod b/pod/perltrap.pod index 17c576df2f..fd91182d1e 100644 --- a/pod/perltrap.pod +++ b/pod/perltrap.pod @@ -273,7 +273,7 @@ context than they do in a scalar one. See L<perldata> for details. =item * -Avoid barewords if you can, especially all lower-case ones. +Avoid barewords if you can, especially all lowercase ones. You can't tell by just looking at it whether a bareword is a function or a string. By using quotes on strings and parentheses on function calls, you won't ever get them confused. @@ -578,6 +578,24 @@ number of elements in the resulting list. # perl4 prints: second new # perl5 prints: 3 +=item * Discontinuance + +In Perl 4 (and versions of Perl 5 before 5.004), C<'\r'> characters in +Perl code were silently allowed, although they could cause (mysterious!) +failures in certain constructs, particularly here documents. Now, +C<'\r'> characters cause an immediate fatal error. (Note: In this +example, the notation B<\015> represents the incorrect line +ending. Depending upon your text viewer, it will look different.) + + print "foo";\015 + print "bar"; + + # perl4 prints: foobar + # perl5.003 prints: foobar + # perl5.004 dies: Illegal character \015 (carriage return) + +See L<perldiag> for full details. + =item * Deprecation Some error messages will be different. @@ -1031,6 +1049,24 @@ state of the searched string is lost) =item * Regular Expression +Currently, if you use the C<m//o> qualifier on a regular expression +within an anonymous sub, I<all> closures generated from that anonymous +sub will use the regular expression as it was compiled when it was used +the very first time in any such closure. For instance, if you say + + sub build_match { + my($left,$right) = @_; + return sub { $_[0] =~ /$left stuff $right/o; }; + } + +build_match() will always return a sub which matches the contents of +C<$left> and C<$right> as they were the I<first> time that build_match() +was called, not as they are in the current call. + +This is probably a bug, and may change in future versions of Perl. + +=item * Regular Expression + If no parentheses are used in a match, Perl4 sets C<$+> to the whole match, just like C<$&>. Perl5 does not. diff --git a/pod/perlvar.pod b/pod/perlvar.pod index d072d25df9..1406858331 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -213,6 +213,9 @@ delimit line boundaries when quoting poetry.) $_ = <FH>; # whole file now here s/\n[ \t]+/ /g; +Remember: the value of $/ is a string, not a regexp. AWK has to be +better for something :-) + =item autoflush HANDLE EXPR =item $OUTPUT_AUTOFLUSH @@ -740,4 +743,18 @@ The C<__DIE__> handler is explicitly disabled during the call, so that you can die from a C<__DIE__> handler. Similarly for C<__WARN__>. See L<perlfunc/die>, L<perlfunc/warn> and L<perlfunc/eval>. +=item $^M + +By default, running out of memory it is not trappable. However, if +compiled for this, Perl may use the contents of C<$^M> as an emergency +pool after die()ing with this message. Suppose that your Perl were +compiled with -DEMERGENCY_SBRK and used Perl's malloc. Then + + $^M = 'a' x (1<<16); + +would allocate a 64K buffer for use when in emergency. See the F<INSTALL> +file for information on how to enable this option. As a disincentive to +casual use of this advanced feature, there is no L<English> long name for +this variable. + =back diff --git a/pod/perlxs.pod b/pod/perlxs.pod index bc2cce1cfa..ebead849dc 100644 --- a/pod/perlxs.pod +++ b/pod/perlxs.pod @@ -731,7 +731,7 @@ prototypes. =head2 The ALIAS: Keyword -The ALIAS: keyword allows an XSUB to have two more more unique Perl names +The ALIAS: keyword allows an XSUB to have two more unique Perl names and to know which of those names was used when it was invoked. The Perl names may be fully-qualified with package names. Each alias is given an index. The compiler will setup a variable called C<ix> which contain the diff --git a/pod/perlxstut.pod b/pod/perlxstut.pod index 7b9b7c60f5..e31de334a8 100644 --- a/pod/perlxstut.pod +++ b/pod/perlxstut.pod @@ -452,7 +452,7 @@ this behavior is tolerated. The next example will show how to do this. =head2 EXAMPLE 4 -In this example, we'll now begin to write XSUB's that will interact with +In this example, we'll now begin to write XSUBs that will interact with pre-defined C libraries. To begin with, we will build a small library of our own, then let h2xs write our .pm and .xs files for us. diff --git a/pod/roffitall b/pod/roffitall index 2d00bdc666..817a8cfe3b 100755 --- a/pod/roffitall +++ b/pod/roffitall @@ -63,6 +63,16 @@ toroff=` $mandir/perlembed.1 \ $mandir/perlpod.1 \ $mandir/perlbook.1 \ + $mandir/perlfaq.1 \ + $mandir/perlfaq1.1 \ + $mandir/perlfaq2.1 \ + $mandir/perlfaq3.1 \ + $mandir/perlfaq4.1 \ + $mandir/perlfaq5.1 \ + $mandir/perlfaq6.1 \ + $mandir/perlfaq7.1 \ + $mandir/perlfaq8.1 \ + $mandir/perlfaq9.1 \ \ $libdir/blib.3 \ $libdir/diagnostics.3 \ @@ -198,7 +198,7 @@ PP(pp_rv2sv) if (op->op_private & OPpLVAL_INTRO) sv = save_scalar((GV*)TOPs); else if (op->op_private & OPpDEREF) - provide_ref(op, sv); + vivify_ref(sv, op->op_private & OPpDEREF); } SETs(sv); RETURN; @@ -321,9 +321,9 @@ SV* sv; if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y') { if (LvTARGLEN(sv)) - vivify_itervar(sv); - if (LvTARG(sv)) - sv = LvTARG(sv); + vivify_defelem(sv); + if (!(sv = LvTARG(sv))) + sv = &sv_undef; } else if (SvPADTMP(sv)) sv = newSVsv(sv); @@ -578,7 +578,7 @@ PP(pp_undef) PP(pp_predec) { dSP; - if (SvREADONLY(TOPs)) + if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) croak(no_modify); if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && SvIVX(TOPs) != IV_MIN) @@ -595,7 +595,7 @@ PP(pp_predec) PP(pp_postinc) { dSP; dTARGET; - if (SvREADONLY(TOPs)) + if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) croak(no_modify); sv_setsv(TARG, TOPs); if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && @@ -616,7 +616,7 @@ PP(pp_postinc) PP(pp_postdec) { dSP; dTARGET; - if(SvREADONLY(TOPs)) + if(SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) croak(no_modify); sv_setsv(TARG, TOPs); if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && @@ -686,26 +686,36 @@ PP(pp_modulo) { dSP; dATARGET; tryAMAGICbin(mod,opASSIGN); { - register UV right; + UV left; + UV right; + bool negate; + UV ans; - right = POPu; - if (!right) - DIE("Illegal modulus zero"); + if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) { + IV i = SvIVX(POPs); + right = (i < 0) ? -i : i; + } + else { + double n = POPn; + right = U_V((n < 0) ? -n : n); + } if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) { - register IV left = SvIVX(TOPs); - if (left < 0) - SETu( (right - ((UV)(-left) - 1) % right) - 1 ); - else - SETi( left % right ); + IV i = SvIVX(POPs); + left = (negate = (i < 0)) ? -i : i; } else { - register double left = TOPn; - if (left < 0.0) - SETu( (right - (U_V(-left) - 1) % right) - 1 ); - else - SETu( U_V(left) % right ); + double n = POPn; + left = U_V((negate = (n < 0)) ? -n : n); } + + if (!right) + DIE("Illegal modulus zero"); + + ans = left % right; + if (negate && ans) + ans = right - ans; + PUSHu(ans); RETURN; } } @@ -1521,8 +1531,11 @@ PP(pp_substr) pos = POPi - arybase; sv = POPs; tmps = SvPV(sv, curlen); - if (pos < 0) + if (pos < 0) { pos += curlen + arybase; + if (pos < 0 && MAXARG < 3) + pos = 0; + } if (pos < 0 || pos > curlen) { if (dowarn || lvalue) warn("substr outside of string"); @@ -798,11 +798,11 @@ char *label; case CXt_LOOP: if (!cx->blk_loop.label || strNE(label, cx->blk_loop.label) ) { - DEBUG_l(deb("(Skipping label #%d %s)\n", - i, cx->blk_loop.label)); + DEBUG_l(deb("(Skipping label #%ld %s)\n", + (long)i, cx->blk_loop.label)); continue; } - DEBUG_l( deb("(Found label #%d %s)\n", i, label)); + DEBUG_l( deb("(Found label #%ld %s)\n", (long)i, label)); return i; } } @@ -837,7 +837,7 @@ I32 startingblock; continue; case CXt_EVAL: case CXt_SUB: - DEBUG_l( deb("(Found sub #%d)\n", i)); + DEBUG_l( deb("(Found sub #%ld)\n", (long)i)); return i; } } @@ -856,7 +856,7 @@ I32 startingblock; default: continue; case CXt_EVAL: - DEBUG_l( deb("(Found eval #%d)\n", i)); + DEBUG_l( deb("(Found eval #%ld)\n", (long)i)); return i; } } @@ -889,7 +889,7 @@ I32 startingblock; warn("Exiting pseudo-block via %s", op_name[op->op_type]); return -1; case CXt_LOOP: - DEBUG_l( deb("(Found loop #%d)\n", i)); + DEBUG_l( deb("(Found loop #%ld)\n", (long)i)); return i; } } @@ -1369,7 +1369,6 @@ PP(pp_return) break; default: DIE("panic: return"); - break; } if (gimme == G_SCALAR) { @@ -1442,7 +1441,6 @@ PP(pp_last) break; default: DIE("panic: last"); - break; } if (gimme == G_SCALAR) { @@ -1791,12 +1789,10 @@ PP(pp_goto) break; case CXt_NULL: DIE("Can't \"goto\" outside a block"); - break; default: if (ix) DIE("panic: goto"); - else - gotoprobe = main_root; + gotoprobe = main_root; break; } retop = dofindlabel(gotoprobe, label, enterops); @@ -204,7 +204,10 @@ PP(pp_concat) s = SvPV_force(TARG, len); } s = SvPV(right,len); - sv_catpvn(TARG,s,len); + if (SvOK(TARG)) + sv_catpvn(TARG,s,len); + else + sv_setpvn(TARG,s,len); /* suppress warning */ SETTARG; RETURN; } @@ -218,7 +221,7 @@ PP(pp_padsv) if (op->op_private & OPpLVAL_INTRO) SAVECLEARSV(curpad[op->op_targ]); else if (op->op_private & OPpDEREF) - provide_ref(op, curpad[op->op_targ]); + vivify_ref(curpad[op->op_targ], op->op_flags & OPpDEREF); } RETURN; } @@ -242,7 +245,7 @@ PP(pp_eq) PP(pp_preinc) { dSP; - if (SvREADONLY(TOPs)) + if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) croak(no_modify); if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && SvIVX(TOPs) != IV_MAX) @@ -330,17 +333,22 @@ PP(pp_print) else gv = defoutgv; if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) { - SV *sv; - - PUSHMARK(MARK-1); + if (MARK == ORIGMARK) { + EXTEND(SP, 1); + ++MARK; + Move(MARK, MARK + 1, (SP - MARK) + 1, SV*); + ++SP; + } + PUSHMARK(MARK - 1); *MARK = mg->mg_obj; + PUTBACK; ENTER; perl_call_method("PRINT", G_SCALAR); LEAVE; SPAGAIN; - sv = POPs; - SP = ORIGMARK; - PUSHs(sv); + MARK = ORIGMARK + 1; + *MARK = *SP; + SP = MARK; RETURN; } if (!(io = GvIO(gv))) { @@ -1247,14 +1255,28 @@ PP(pp_helem) HE* he; SV *keysv = POPs; HV *hv = (HV*)POPs; - I32 lval = op->op_flags & OPf_MOD; + U32 lval = op->op_flags & OPf_MOD; + U32 defer = op->op_private & OPpLVAL_DEFER; if (SvTYPE(hv) != SVt_PVHV) RETPUSHUNDEF; - he = hv_fetch_ent(hv, keysv, lval, 0); + he = hv_fetch_ent(hv, keysv, lval && !defer, 0); if (lval) { - if (!he || HeVAL(he) == &sv_undef) - DIE(no_helem, SvPV(keysv, na)); + if (!he || HeVAL(he) == &sv_undef) { + SV* lv; + SV* key2; + if (!defer) + DIE(no_helem, SvPV(keysv, na)); + lv = sv_newmortal(); + sv_upgrade(lv, SVt_PVLV); + LvTYPE(lv) = 'y'; + sv_magic(lv, key2 = newSVsv(keysv), 'y', Nullch, 0); + SvREFCNT_dec(key2); /* sv_magic() increments refcount */ + LvTARG(lv) = SvREFCNT_inc(hv); + LvTARGLEN(lv) = 1; + PUSHs(lv); + RETURN; + } if (op->op_private & OPpLVAL_INTRO) { if (HvNAME(hv) && isGV(HeVAL(he))) save_gp((GV*)HeVAL(he), !(op->op_flags & OPf_SPECIAL)); @@ -1262,7 +1284,7 @@ PP(pp_helem) save_svref(&HeVAL(he)); } else if (op->op_private & OPpDEREF) - provide_ref(op, HeVAL(he)); + vivify_ref(HeVAL(he), op->op_private & OPpDEREF); } PUSHs(he ? HeVAL(he) : &sv_undef); RETURN; @@ -1352,14 +1374,14 @@ PP(pp_iter) if (lv) SvREFCNT_dec(LvTARG(lv)); else { - lv = cx->blk_loop.iterlval = newSVsv(sv); + lv = cx->blk_loop.iterlval = NEWSV(26, 0); sv_upgrade(lv, SVt_PVLV); - sv_magic(lv, Nullsv, 'y', Nullch, 0); LvTYPE(lv) = 'y'; + sv_magic(lv, Nullsv, 'y', Nullch, 0); } LvTARG(lv) = SvREFCNT_inc(av); LvTARGOFF(lv) = cx->blk_loop.iterix; - LvTARGLEN(lv) = 1; + LvTARGLEN(lv) = -1; sv = (SV*)lv; } @@ -1399,8 +1421,12 @@ PP(pp_subst) TARG = GvSV(defgv); EXTEND(SP,1); } + if (SvREADONLY(TARG) + || (SvTYPE(TARG) > SVt_PVLV + && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG)))) + croak(no_modify); s = SvPV(TARG, len); - if (!SvPOKp(TARG) || SvREADONLY(TARG) || (SvTYPE(TARG) == SVt_PVGV)) + if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV) force_on_match = 1; TAINT_NOT; @@ -1969,30 +1995,43 @@ PP(pp_aelem) dSP; SV** svp; I32 elem = POPi; - AV *av = (AV*)POPs; - I32 lval = op->op_flags & OPf_MOD; + AV* av = (AV*)POPs; + U32 lval = op->op_flags & OPf_MOD; + U32 defer = (op->op_private & OPpLVAL_DEFER) && (elem > AvFILL(av)); if (elem > 0) elem -= curcop->cop_arybase; if (SvTYPE(av) != SVt_PVAV) RETPUSHUNDEF; - svp = av_fetch(av, elem, lval); + svp = av_fetch(av, elem, lval && !defer); if (lval) { - if (!svp || *svp == &sv_undef) - DIE(no_aelem, elem); + if (!svp || *svp == &sv_undef) { + SV* lv; + if (!defer) + DIE(no_aelem, elem); + lv = sv_newmortal(); + sv_upgrade(lv, SVt_PVLV); + LvTYPE(lv) = 'y'; + sv_magic(lv, Nullsv, 'y', Nullch, 0); + LvTARG(lv) = SvREFCNT_inc(av); + LvTARGOFF(lv) = elem; + LvTARGLEN(lv) = 1; + PUSHs(lv); + RETURN; + } if (op->op_private & OPpLVAL_INTRO) save_svref(svp); else if (op->op_private & OPpDEREF) - provide_ref(op, *svp); + vivify_ref(*svp, op->op_private & OPpDEREF); } PUSHs(svp ? *svp : &sv_undef); RETURN; } void -provide_ref(op, sv) -OP* op; +vivify_ref(sv, to_what) SV* sv; +U32 to_what; { if (SvGMAGICAL(sv)) mg_get(sv); @@ -2006,8 +2045,7 @@ SV* sv; Safefree(SvPVX(sv)); SvLEN(sv) = SvCUR(sv) = 0; } - switch (op->op_private & OPpDEREF) - { + switch (to_what) { case OPpDEREF_SV: SvRV(sv) = newSV(0); break; @@ -1520,6 +1520,7 @@ PP(pp_flock) else fp = Nullfp; if (fp) { + (void)PerlIO_flush(fp); value = (I32)(FLOCK(PerlIO_fileno(fp), argtype) >= 0); } else @@ -31,7 +31,7 @@ OP* bind_match _((I32 type, OP* left, OP* pat)); OP* block_end _((I32 floor, OP* seq)); int block_start _((int full)); void boot_core_UNIVERSAL _((void)); -void calllist _((I32 oldscope, AV* list)); +void call_list _((I32 oldscope, AV* list)); I32 cando _((I32 bit, I32 effective, struct stat* statbufp)); #ifndef CASTNEGFLOAT U32 cast_ulong _((double f)); @@ -139,16 +139,16 @@ void gv_init _((GV *gv, HV *stash, char *name, STRLEN len, int multi)); HV* gv_stashpv _((char* name, I32 create)); HV* gv_stashpvn _((char* name, U32 namelen, I32 create)); HV* gv_stashsv _((SV* sv, I32 create)); -void he_delayfree _((HV* hv, HE* hent)); -void he_free _((HV* hv, HE* hent)); void hoistmust _((PMOP* pm)); void hv_clear _((HV* tb)); +void hv_delayfree_ent _((HV* hv, HE* entry)); SV* hv_delete _((HV* tb, char* key, U32 klen, I32 flags)); SV* hv_delete_ent _((HV* tb, SV* key, I32 flags, U32 hash)); bool hv_exists _((HV* tb, char* key, U32 klen)); bool hv_exists_ent _((HV* tb, SV* key, U32 hash)); SV** hv_fetch _((HV* tb, char* key, U32 klen, I32 lval)); HE* hv_fetch_ent _((HV* tb, SV* key, I32 lval, U32 hash)); +void hv_free_ent _((HV* hv, HE* entry)); I32 hv_iterinit _((HV* tb)); char* hv_iterkey _((HE* entry, I32* retlen)); SV* hv_iterkeysv _((HE* entry)); @@ -181,12 +181,12 @@ int magic_clearenv _((SV* sv, MAGIC* mg)); int magic_clearpack _((SV* sv, MAGIC* mg)); int magic_clearsig _((SV* sv, MAGIC* mg)); int magic_existspack _((SV* sv, MAGIC* mg)); -int magic_freeitervar _((SV* sv, MAGIC* mg)); +int magic_freedefelem _((SV* sv, MAGIC* mg)); int magic_get _((SV* sv, MAGIC* mg)); int magic_getarylen _((SV* sv, MAGIC* mg)); -int magic_getpack _((SV* sv, MAGIC* mg)); +int magic_getdefelem _((SV* sv, MAGIC* mg)); int magic_getglob _((SV* sv, MAGIC* mg)); -int magic_getitervar _((SV* sv, MAGIC* mg)); +int magic_getpack _((SV* sv, MAGIC* mg)); int magic_getpos _((SV* sv, MAGIC* mg)); int magic_getsig _((SV* sv, MAGIC* mg)); int magic_gettaint _((SV* sv, MAGIC* mg)); @@ -203,10 +203,10 @@ int magic_setdbline _((SV* sv, MAGIC* mg)); #ifdef USE_LOCALE_COLLATE int magic_setcollxfrm _((SV* sv, MAGIC* mg)); #endif +int magic_setdefelem _((SV* sv, MAGIC* mg)); int magic_setenv _((SV* sv, MAGIC* mg)); int magic_setfm _((SV* sv, MAGIC* mg)); int magic_setisa _((SV* sv, MAGIC* mg)); -int magic_setitervar _((SV* sv, MAGIC* mg)); int magic_setglob _((SV* sv, MAGIC* mg)); int magic_setmglob _((SV* sv, MAGIC* mg)); int magic_setnkeys _((SV* sv, MAGIC* mg)); @@ -354,7 +354,6 @@ OP* pmtrans _((OP* op, OP* expr, OP* repl)); OP* pop_return _((void)); void pop_scope _((void)); OP* prepend_elem _((I32 optype, OP* head, OP* tail)); -void provide_ref _((OP* op, SV* sv)); void push_return _((OP* op)); void push_scope _((void)); regexp* pregcomp _((char* exp, char* xend, PMOP* pm)); @@ -498,7 +497,8 @@ I32 unlnk _((char* f)); void unsharepvn _((char* sv, I32 len, U32 hash)); void unshare_hek _((HEK* hek)); void utilize _((int aver, I32 floor, OP* version, OP* id, OP* arg)); -void vivify_itervar _((SV* sv)); +void vivify_defelem _((SV* sv)); +void vivify_ref _((SV* sv, U32 to_what)); I32 wait4pid _((int pid, int* statusp, int flags)); void warn _((const char* pat,...)) __attribute__((format(printf,1,2))); void watch _((char **addr)); @@ -888,8 +888,8 @@ char *prog; #ifdef DEBUGGING if (regnarrate) - PerlIO_printf(Perl_debug_log, "%*s %d %lx\n", regindent*2, "", - n, (long)cc); + PerlIO_printf(Perl_debug_log, "%*s %ld %lx\n", regindent*2, "", + (long)n, (long)cc); #endif /* If degenerate scan matches "", assume scan done. */ @@ -1965,17 +1965,19 @@ register SV *sstr; if (GvCVGEN(dstr) && GvCV(dstr) != (CV*)sref) { SvREFCNT_dec(GvCV(dstr)); GvCV(dstr) = Nullcv; - GvCVGEN(dstr) = 0; + GvCVGEN(dstr) = 0; /* Switch off cacheness. */ + sub_generation++; } SAVESPTR(GvCV(dstr)); } - else { + else + dref = (SV*)GvCV(dstr); + if (GvCV(dstr) != (CV*)sref) { CV* cv = GvCV(dstr); if (cv) { - dref = (SV*)cv; - if (sref != dref && - !GvCVGEN((GV*)dstr) && - (CvROOT(cv) || CvXSUB(cv)) ) { + if (!GvCVGEN((GV*)dstr) && + (CvROOT(cv) || CvXSUB(cv))) + { if (cv_const_sv(cv)) warn("Constant subroutine %s redefined", GvENAME((GV*)dstr)); @@ -1983,9 +1985,14 @@ register SV *sstr; warn("Subroutine %s redefined", GvENAME((GV*)dstr)); } + if (SvPOK(cv) != SvPOK(sref) + || (SvPOK(cv) + && strNE(SvPVX(cv), SvPVX(sref)))) { + warn("Prototype mismatch: (%s) vs (%s)", + SvPOK(cv) ? SvPVX(cv) : "none", + SvPOK(sref) ? SvPVX(sref) : "none"); + } } - } - if (GvCV(dstr) != (CV*)sref) { GvCV(dstr) = (CV*)sref; GvCVGEN(dstr) = 0; /* Switch off cacheness. */ GvASSUMECV_on(dstr); @@ -2429,7 +2436,7 @@ I32 namlen; mg->mg_virtual = &vtbl_substr; break; case 'y': - mg->mg_virtual = &vtbl_itervar; + mg->mg_virtual = &vtbl_defelem; break; case '*': mg->mg_virtual = &vtbl_glob; @@ -3088,11 +3095,11 @@ I32 append; bp = (STDCHAR*)SvPVX(sv) + append; /* move these two too to registers */ ptr = (STDCHAR*)PerlIO_get_ptr(fp); DEBUG_P(PerlIO_printf(Perl_debug_log, - "Screamer: entering, ptr=%d, cnt=%d\n",ptr,cnt)); + "Screamer: entering, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt)); DEBUG_P(PerlIO_printf(Perl_debug_log, - "Screamer: entering: FILE * thinks ptr=%d, cnt=%d, base=%d\n", - PerlIO_get_ptr(fp), PerlIO_get_cnt(fp), - PerlIO_has_base(fp) ? PerlIO_get_base(fp) : 0)); + "Screamer: entering: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n", + (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp), + (long)(PerlIO_has_base(fp) ? PerlIO_get_base(fp) : 0))); for (;;) { screamer: if (cnt > 0) { @@ -3122,24 +3129,24 @@ I32 append; } DEBUG_P(PerlIO_printf(Perl_debug_log, - "Screamer: going to getc, ptr=%d, cnt=%d\n",ptr,cnt)); + "Screamer: going to getc, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt)); PerlIO_set_ptrcnt(fp, ptr, cnt); /* deregisterize cnt and ptr */ DEBUG_P(PerlIO_printf(Perl_debug_log, - "Screamer: pre: FILE * thinks ptr=%d, cnt=%d, base=%d\n", - PerlIO_get_ptr(fp), PerlIO_get_cnt(fp), - PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)); + "Screamer: pre: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n", + (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp), + (long)(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0))); /* This used to call 'filbuf' in stdio form, but as that behaves like getc when cnt <= 0 we use PerlIO_getc here to avoid introducing another abstraction. */ i = PerlIO_getc(fp); /* get more characters */ DEBUG_P(PerlIO_printf(Perl_debug_log, - "Screamer: post: FILE * thinks ptr=%d, cnt=%d, base=%d\n", - PerlIO_get_ptr(fp), PerlIO_get_cnt(fp), - PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)); + "Screamer: post: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n", + (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp), + (long)(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0))); cnt = PerlIO_get_cnt(fp); ptr = (STDCHAR*)PerlIO_get_ptr(fp); /* reregisterize cnt and ptr */ DEBUG_P(PerlIO_printf(Perl_debug_log, - "Screamer: after getc, ptr=%d, cnt=%d\n",ptr,cnt)); + "Screamer: after getc, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt)); if (i == EOF) /* all done for ever? */ goto thats_really_all_folks; @@ -3163,12 +3170,12 @@ thats_really_all_folks: if (shortbuffered) cnt += shortbuffered; DEBUG_P(PerlIO_printf(Perl_debug_log, - "Screamer: quitting, ptr=%d, cnt=%d\n",ptr,cnt)); + "Screamer: quitting, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt)); PerlIO_set_ptrcnt(fp, ptr, cnt); /* put these back or we're in trouble */ DEBUG_P(PerlIO_printf(Perl_debug_log, - "Screamer: end: FILE * thinks ptr=%d, cnt=%d, base=%d\n", - PerlIO_get_ptr(fp), PerlIO_get_cnt(fp), - PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)); + "Screamer: end: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n", + (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp), + (long)(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0))); *bp = '\0'; SvCUR_set(sv, bp - (STDCHAR*)SvPVX(sv)); /* set length */ DEBUG_P(PerlIO_printf(Perl_debug_log, @@ -3804,6 +3811,10 @@ int sv_isobject(sv) SV *sv; { + if (!sv) + return 0; + if (SvGMAGICAL(sv)) + mg_get(sv); if (!SvROK(sv)) return 0; sv = (SV*)SvRV(sv); @@ -3817,6 +3828,10 @@ sv_isa(sv, name) SV *sv; char *name; { + if (!sv) + return 0; + if (SvGMAGICAL(sv)) + mg_get(sv); if (!SvROK(sv)) return 0; sv = (SV*)SvRV(sv); diff --git a/t/comp/cpp.t b/t/comp/cpp.t index 00a9e6806a..86e7359524 100755 --- a/t/comp/cpp.t +++ b/t/comp/cpp.t @@ -8,7 +8,8 @@ BEGIN { } use Config; -if ( ($Config{'cppstdin'} =~ /\bcppstdin\b/) and +if ( $^O eq 'MSWin32' or + ($Config{'cppstdin'} =~ /\bcppstdin\b/) and ( ! -x $Config{'binexp'} . "/cppstdin") ) { print "1..0\n"; exit; # Cannot test till after install, alas. diff --git a/t/comp/script.t b/t/comp/script.t index f37e46bb66..d0c12e9552 100755 --- a/t/comp/script.t +++ b/t/comp/script.t @@ -4,7 +4,8 @@ print "1..3\n"; -$x = `./perl -e 'print "ok\n";'`; +$PERL = ($^O eq 'MSWin32') ? '.\perl' : './perl'; +$x = `$PERL -le "print 'ok';"`; if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. -e "print ""ok\n""";`; } if ($x eq "ok\n") {print "ok 1\n";} else {print "not ok 1\n";} @@ -13,12 +14,12 @@ open(try,">Comp.script") || (die "Can't open temp file."); print try 'print "ok\n";'; print try "\n"; close try; -$x = `./perl Comp.script`; +$x = `$PERL Comp.script`; if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. Comp.script`; } if ($x eq "ok\n") {print "ok 2\n";} else {print "not ok 2\n";} -$x = `./perl <Comp.script`; +$x = `$PERL <Comp.script`; if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. <Comp.script`; } if ($x eq "ok\n") {print "ok 3\n";} else {print "not ok 3\n";} @@ -15,5 +15,5 @@ $Test::Harness::switches = ""; # Too much noise otherwise $Test::Harness::verbose = shift if @ARGV && $ARGV[0] eq '-v'; @tests = @ARGV; -@tests = <*/*.t> unless @tests; +@tests = <base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t lib/*.t> unless @tests; Test::Harness::runtests @tests; diff --git a/t/io/argv.t b/t/io/argv.t index 02cdc27536..d99865e142 100755 --- a/t/io/argv.t +++ b/t/io/argv.t @@ -8,16 +8,28 @@ open(try, '>Io.argv.tmp') || (die "Can't open temp file."); print try "a line\n"; close try; -$x = `./perl -e 'while (<>) {print \$.,\$_;}' Io.argv.tmp Io.argv.tmp`; - +if ($^O eq 'MSWin32') { + $x = `.\\perl -e "while (<>) {print \$.,\$_;}" Io.argv.tmp Io.argv.tmp`; +} +else { + $x = `./perl -e 'while (<>) {print \$.,\$_;}' Io.argv.tmp Io.argv.tmp`; +} if ($x eq "1a line\n2a line\n") {print "ok 1\n";} else {print "not ok 1\n";} -$x = `echo foo|./perl -e 'while (<>) {print $_;}' Io.argv.tmp -`; - +if ($^O eq 'MSWin32') { + $x = `.\\perl -le "print 'foo'" | .\\perl -e "while (<>) {print \$_;}" Io.argv.tmp -`; +} +else { + $x = `echo foo|./perl -e 'while (<>) {print $_;}' Io.argv.tmp -`; +} if ($x eq "a line\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";} -$x = `echo foo|./perl -e 'while (<>) {print $_;}'`; - +if ($^O eq 'MSWin32') { + $x = `.\\perl -le "print 'foo'" |.\\perl -e "while (<>) {print \$_;}"`; +} +else { + $x = `echo foo|./perl -e 'while (<>) {print $_;}'`; +} if ($x eq "foo\n") {print "ok 3\n";} else {print "not ok 3 :$x:\n";} @ARGV = ('Io.argv.tmp', 'Io.argv.tmp', '/dev/null', 'Io.argv.tmp'); diff --git a/t/io/dup.t b/t/io/dup.t index 901642d8f6..f312671e56 100755 --- a/t/io/dup.t +++ b/t/io/dup.t @@ -17,8 +17,14 @@ select(STDOUT); $| = 1; print STDOUT "ok 2\n"; print STDERR "ok 3\n"; -system 'echo ok 4'; -system 'echo ok 5 1>&2'; +if ($^O eq 'MSWin32') { + print `echo ok 4`; + print `echo ok 5 1>&2`; # does this work? +} +else { + system 'echo ok 4'; + system 'echo ok 5 1>&2'; +} close(STDOUT); close(STDERR); @@ -26,7 +32,8 @@ close(STDERR); open(STDOUT,">&dupout"); open(STDERR,">&duperr"); -system 'cat Io.dup'; +if ($^O eq 'MSWin32') { print `type Io.dup` } +else { system 'cat Io.dup' } unlink 'Io.dup'; print STDOUT "ok 6\n"; @@ -11,10 +11,11 @@ use Config; print "1..26\n"; -$wd = `pwd`; +$wd = (($^O eq 'MSWin32') ? `cd` : `pwd`); chop($wd); -`rm -f tmp 2>/dev/null; mkdir tmp 2>/dev/null`; +if ($^O eq 'MSWin32') { `del tmp`; `mkdir tmp`; } +else { `rm -f tmp 2>/dev/null; mkdir tmp 2>/dev/null`; } chdir './tmp'; `/bin/rm -rf a b c x` if -x '/bin/rm'; @@ -87,7 +88,8 @@ chdir $wd || die "Can't cd back to $wd"; rmdir 'tmp'; unlink 'c'; -if (`ls -l perl 2>/dev/null` =~ /^l.*->/) { # we have symbolic links +if ($^O ne 'MSWin32' and `ls -l perl 2>/dev/null` =~ /^l.*->/) { + # we have symbolic links if (symlink("TEST","c")) {print "ok 21\n";} else {print "not ok 21\n";} $foo = `grep perl c`; if ($foo) {print "ok 22\n";} else {print "not ok 22\n";} diff --git a/t/io/inplace.t b/t/io/inplace.t index 477add1942..2652c8bebe 100755 --- a/t/io/inplace.t +++ b/t/io/inplace.t @@ -7,7 +7,16 @@ $^I = '.bak'; print "1..2\n"; @ARGV = ('.a','.b','.c'); -`echo foo | tee .a .b .c`; +if ($^O eq 'MSWin32') { + $CAT = '.\perl -e "print<>"'; + `.\\perl -le "print 'foo'" > .a`; + `.\\perl -le "print 'foo'" > .b`; + `.\\perl -le "print 'foo'" > .c`; +} +else { + $CAT = 'cat'; + `echo foo | tee .a .b .c`; +} while (<>) { s/foo/bar/; } @@ -15,7 +24,7 @@ continue { print; } -if (`cat .a .b .c` eq "bar\nbar\nbar\n") {print "ok 1\n";} else {print "not ok 1\n";} -if (`cat .a.bak .b.bak .c.bak` eq "foo\nfoo\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";} +if (`$CAT .a .b .c` eq "bar\nbar\nbar\n") {print "ok 1\n";} else {print "not ok 1\n";} +if (`$CAT .a.bak .b.bak .c.bak` eq "foo\nfoo\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";} unlink '.a', '.b', '.c', '.a.bak', '.b.bak', '.c.bak'; diff --git a/t/lib/filehand.t b/t/lib/filehand.t index 20b2ee0bb0..c23a7e0475 100755 --- a/t/lib/filehand.t +++ b/t/lib/filehand.t @@ -66,7 +66,7 @@ print "ok 10\n"; ($rd,$wr) = FileHandle::pipe; -if ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'amigaos') { +if ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'MSWin32') { $wr->autoflush; $wr->printf("ok %d\n",11); print $rd->getline; diff --git a/t/lib/io_dup.t b/t/lib/io_dup.t index f5d4544490..6b0caf14fa 100755 --- a/t/lib/io_dup.t +++ b/t/lib/io_dup.t @@ -39,8 +39,14 @@ $stderr->fdopen($stdout,"w"); print $stdout "ok 2\n"; print $stderr "ok 3\n"; -system 'echo ok 4'; -system 'echo ok 5 1>&2'; +if ($^O eq 'MSWin32') { + print `echo ok 4`; + print `echo ok 5 1>&2`; # does this *really* work? +} +else { + system 'echo ok 4'; + system 'echo ok 5 1>&2'; +} $stderr->close; $stdout->close; @@ -48,7 +54,8 @@ $stdout->close; $stdout->fdopen($dupout,"w"); $stderr->fdopen($duperr,"w"); -system 'cat Io.dup'; +if ($^O eq 'MSWin32') { print `type Io.dup` } +else { system 'cat Io.dup' } unlink 'Io.dup'; print STDOUT "ok 6\n"; diff --git a/t/lib/io_sel.t b/t/lib/io_sel.t index 44d9757093..b9c1097404 100755 --- a/t/lib/io_sel.t +++ b/t/lib/io_sel.t @@ -49,6 +49,13 @@ $sel->remove([\*STDOUT, 5]); print "not " unless $sel->count == 0 && !defined($sel->bits); print "ok 9\n"; +if ($^O eq 'MSWin32') { # 4-arg select is only valid on sockets + print "# skipping tests 10..15\n"; + for (10 .. 15) { print "ok $_\n" } + $sel->add(\*STDOUT); # update + goto POST_SOCKET; +} + @a = $sel->can_read(); # should return imediately print "not " unless @a == 0; print "ok 10\n"; @@ -77,6 +84,7 @@ print "ok 14\n"; $fd = $w->[0]; print $fd "ok 15\n"; +POST_SOCKET: # Test new exists() method $sel->exists(\*STDIN) and print "not "; print "ok 16\n"; diff --git a/t/lib/io_taint.t b/t/lib/io_taint.t index 698db45c72..0ef2cfd63f 100755 --- a/t/lib/io_taint.t +++ b/t/lib/io_taint.t @@ -29,7 +29,7 @@ $x->close; $x = new IO::File "< ./__taint__$$" || die("Cannot open ./__taint__$$\n"); chop($unsafe = <$x>); eval { kill 0 * $unsafe }; -print "not " if ($@ !~ /^Insecure/o); +print "not " if $^O ne 'MSWin32' and ($@ !~ /^Insecure/o); print "ok 1\n"; $x->close; diff --git a/t/op/closure.t b/t/op/closure.t index 7af3abb291..1220998b6b 100755 --- a/t/op/closure.t +++ b/t/op/closure.t @@ -377,7 +377,7 @@ END $test++; } - if ($Config{d_fork} and $^O ne 'VMS') { + if ($Config{d_fork} and $^O ne 'VMS' and $^O ne 'MSWin32') { # Fork off a new perl to run the tests. # (This is so we can catch spurious warnings.) $| = 1; print ""; $| = 0; # flush output before forking @@ -411,9 +411,11 @@ END my $errfile = "terr$$"; $errfile++ while -e $errfile; my @tmpfiles = ($cmdfile, $errfile); open CMD, ">$cmdfile"; print CMD $code; close CMD; - my $cmd = ($^O eq 'VMS') ? "MCR $^X" : "./perl"; + my $cmd = (($^O eq 'VMS') ? "MCR $^X" + : ($^O eq 'MSWin32') ? '.\perl' + : './perl'); $cmd .= " -w $cmdfile 2>$errfile"; - if ($^O eq 'VMS') { + if ($^O eq 'VMS' or $^O eq 'MSWin32') { # Use pipe instead of system so we don't inherit STD* from # this process, and then foul our pipe back to parent by # redirecting output in the child. diff --git a/t/op/exec.t b/t/op/exec.t index 1103a1a464..7dfcd6177f 100755 --- a/t/op/exec.t +++ b/t/op/exec.t @@ -3,6 +3,13 @@ # $RCSfile: exec.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:49 $ $| = 1; # flush stdout + +if ($^O eq 'MSWin32') { + print "# exec is unsupported on Win32\n"; + print "1..0\n"; + exit(0); +} + print "1..8\n"; print "not ok 1\n" if system "echo ok \\1"; # shell interpreted diff --git a/t/op/glob.t b/t/op/glob.t index cc60a17a72..dd95e980d5 100755 --- a/t/op/glob.t +++ b/t/op/glob.t @@ -7,7 +7,12 @@ print "1..6\n"; @oops = @ops = <op/*>; map { $files{$_}++ } <op/*>; -map { delete $files{$_} } split /[\s\n]/, `echo op/*`; +if ($^O eq 'MSWin32') { + map { delete $files{"op/$_"} } split /[\s\n]/, `cmd /c "dir /b /l op"`; +} +else { + map { delete $files{$_} } split /[\s\n]/, `echo op/*`; +} if (keys %files) { print "not ok 1\t(",join(' ', sort keys %files),"\n"; } else { print "ok 1\n"; } diff --git a/t/op/goto.t b/t/op/goto.t index 087331907e..1b34acda39 100755 --- a/t/op/goto.t +++ b/t/op/goto.t @@ -31,7 +31,8 @@ label4: print "#2\t:$foo: == 4\n"; if ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";} -$x = `./perl -e 'goto foo;' 2>&1`; +$PERL = ($^O eq 'MSWin32') ? '.\perl' : './perl'; +$x = `$PERL -e "goto foo;" 2>&1`; if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. -e "goto foo;"`; } if ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";} diff --git a/t/op/magic.t b/t/op/magic.t index 70f2bec2c3..fa19716c14 100755 --- a/t/op/magic.t +++ b/t/op/magic.t @@ -19,10 +19,14 @@ sub ok { } } +$Is_MSWin32 = ($^O eq 'MSWin32'); +$PERL = ($Is_MSWin32 ? '.\perl' : './perl'); + print "1..28\n"; eval '$ENV{"foo"} = "hi there";'; # check that ENV is inited inside eval -ok 1, `echo \$foo` eq "hi there\n"; +if ($Is_MSWin32) { ok 1, `set foo` eq "foo=hi there\n"; } +else { ok 1, `echo \$foo` eq "hi there\n"; } unlink 'ajslkdfpqjsjfk'; $! = 0; @@ -30,10 +34,14 @@ open(FOO,'ajslkdfpqjsjfk'); ok 2, $!, $!; close FOO; # just mention it, squelch used-only-once -# the next tests are embedded inside system simply because sh spits out -# a newline onto stderr when a child process kills itself with SIGINT. - -system './perl', '-e', <<'END'; +if ($Is_MSWin32) { + ok 3,1; + ok 4,1; +} +else { + # the next tests are embedded inside system simply because sh spits out + # a newline onto stderr when a child process kills itself with SIGINT. + system './perl', '-e', <<'END'; $| = 1; # command buffering @@ -51,8 +59,10 @@ system './perl', '-e', <<'END'; } END +} -@val1 = @ENV{keys(%ENV)}; # can we slice ENV? +# can we slice ENV? +@val1 = @ENV{keys(%ENV)}; @val2 = values(%ENV); ok 5, join(':',@val1) eq join(':',@val2); ok 6, @val1 > 1; @@ -84,9 +94,9 @@ ok 13, (keys %h)[0] eq "foo\034bar", (keys %h)[0]; } # $?, $@, $$ -system 'true'; +system "$PERL -e 'exit(0)'"; ok 15, $? == 0, $?; -system 'false'; +system "$PERL -e 'exit(1)'"; ok 16, $? != 0, $?; eval { die "foo\n" }; @@ -95,33 +105,38 @@ ok 17, $@ eq "foo\n", $@; ok 18, $$ > 0, $$; # $^X and $0 -if ($^O eq 'qnx' || $^O eq 'amigaos') { - chomp($wd = `pwd`); +if ($Is_MSWin32) { + for (19 .. 25) { ok $_, 1 } } else { - $wd = '.'; -} -$script = "$wd/show-shebang"; -$s1 = $s2 = "\$^X is $wd/perl, \$0 is $script\n"; -if ($^O eq 'os2') { - # Started by ksh, which adds suffixes '.exe' and '.' to perl and script - $s2 = "\$^X is $wd/perl.exe, \$0 is $script.\n"; -} -ok 19, open(SCRIPT, ">$script"), $!; -ok 20, print(SCRIPT <<EOB . <<'EOF'), $!; + if ($^O eq 'qnx' || $^O eq 'amigaos') { + chomp($wd = `pwd`); + } + else { + $wd = '.'; + } + $script = "$wd/show-shebang"; + $s1 = $s2 = "\$^X is $wd/perl, \$0 is $script\n"; + if ($^O eq 'os2') { + # Started by ksh, which adds suffixes '.exe' and '.' to perl and script + $s2 = "\$^X is $wd/perl.exe, \$0 is $script.\n"; + } + ok 19, open(SCRIPT, ">$script"), $!; + ok 20, print(SCRIPT <<EOB . <<'EOF'), $!; #!$wd/perl EOB print "\$^X is $^X, \$0 is $0\n"; EOF -ok 21, close(SCRIPT), $!; -ok 22, chmod(0755, $script), $!; -$_ = `$script`; -s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl -s{is perl}{is $wd/perl}; # for systems where $^X is only a basename -ok 23, $_ eq $s2, ":$_:!=:$s2:"; -$_ = `$wd/perl $script`; -ok 24, $_ eq $s1, ":$_:!=:$s1: after `$wd/perl $script`"; -ok 25, unlink($script), $!; + ok 21, close(SCRIPT), $!; + ok 22, chmod(0755, $script), $!; + $_ = `$script`; + s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl + s{is perl}{is $wd/perl}; # for systems where $^X is only a basename + ok 23, $_ eq $s2, ":$_:!=:$s2:"; + $_ = `$wd/perl $script`; + ok 24, $_ eq $s1, ":$_:!=:$s1: after `$wd/perl $script`"; + ok 25, unlink($script), $!; +} # $], $^O, $^T ok 26, $] >= 5.00319, $]; diff --git a/t/op/misc.t b/t/op/misc.t index 0f251ea354..02d32bd5c5 100755 --- a/t/op/misc.t +++ b/t/op/misc.t @@ -14,17 +14,24 @@ $tmpfile = "misctmp000"; 1 while -f ++$tmpfile; END { unlink $tmpfile if $tmpfile; } +$CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : 'cat'); + for (@prgs){ my $switch; if (s/^\s*-\w+//){ $switch = $&; } my($prog,$expected) = split(/\nEXPECT\n/, $_); - open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1"; + if ($^O eq 'MSWin32') { + open TEST, "| .\\perl -I../lib $switch >$tmpfile 2>&1"; + } + else { + open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1"; + } print TEST $prog, "\n"; close TEST; $status = $?; - $results = `cat $tmpfile`; + $results = `$CAT $tmpfile`; $results =~ s/\n+$//; $expected =~ s/\n+$//; if ( $results ne $expected){ @@ -74,7 +81,7 @@ EXPECT ######## eval {sub bar {print "In bar";}} ######## -system "./perl -ne 'print if eof' /dev/null" +system './perl -ne "print if eof" /dev/null' ######## chop($file = <>); ######## diff --git a/t/op/rand.t b/t/op/rand.t index 4eeca6b10c..23a09b7388 100755 --- a/t/op/rand.t +++ b/t/op/rand.t @@ -329,12 +329,10 @@ AUTOSRAND: my($pid, $first); for (1..5) { - if ($^O eq 'VMS') { - $pid = open PERL, qq[MCR $^X -e "print rand"|]; - } - else { - $pid = open PERL, "./perl -e 'print rand'|"; - } + my $PERL = (($^O eq 'VMS') ? "MCR $^X" + : ($^O eq 'MSWin32') ? '.\perl' + : './perl'); + $pid = open PERL, qq[$PERL -e "print rand"|]; die "Couldn't pipe from perl: $!" unless defined $pid; if (defined $first) { if ($first ne <PERL>) { diff --git a/t/op/split.t b/t/op/split.t index 4144bbb88f..90bb436550 100755 --- a/t/op/split.t +++ b/t/op/split.t @@ -47,7 +47,8 @@ $_ = join(':', split(/:/,'1:2:3:4:5:6:::', 999)); print $_ eq '1:2:3:4:5:6:::' ? "ok 10\n" : "not ok 10 $_\n"; # Does assignment to a list imply split to one more field than that? -$foo = `./perl -D1024 -e '(\$a,\$b) = split;' 2>&1`; +if ($^O eq 'MSWin32') { $foo = `.\\perl -D1024 -e "(\$a,\$b) = split;" 2>&1` } +else { $foo = `./perl -D1024 -e '(\$a,\$b) = split;' 2>&1` } if ($foo =~ /DCL-W-NOCOMD/) { $foo = `\$ mcr sys\$disk:[]perl. "-D1024" -e "(\$a,\$b) = split;"`; } diff --git a/t/op/stat.t b/t/op/stat.t index f0fd9a00b1..d7271522c2 100755 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -13,14 +13,16 @@ use Config; print "1..56\n"; -chop($cwd = `pwd`); +$Is_MSWin32 = $^O eq 'MSWin32'; +chop($cwd = ($Is_MSWin32 ? `cd` : `pwd`)); -$DEV = `ls -l /dev`; +$DEV = `ls -l /dev` unless $Is_MSWin32; unlink "Op.stat.tmp"; open(FOO, ">Op.stat.tmp"); -$junk = `ls Op.stat.tmp`; # hack to make Apollo update link count +# hack to make Apollo update link count: +$junk = `ls Op.stat.tmp` unless $Is_MSWin32; ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, $blksize,$blocks) = stat(FOO); @@ -86,7 +88,7 @@ if (! -d 'Op.stat.tmp') {print "ok 22\n";} else {print "not ok 22\n";} if (-d '.') {print "ok 23\n";} else {print "not ok 23\n";} if (! -f '.') {print "ok 24\n";} else {print "not ok 24\n";} -if (`ls -l perl` =~ /^l.*->/) { +if (!$Is_MSWin32 and `ls -l perl` =~ /^l.*->/) { if (-l 'perl') {print "ok 25\n";} else {print "not ok 25\n";} } else { @@ -99,7 +101,9 @@ if (-e 'Op.stat.tmp') {print "ok 27\n";} else {print "not ok 27\n";} `rm -f Op.stat.tmp Op.stat.tmp2`; if (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\n";} -if ($DEV !~ /\nc.* (\S+)\n/) +if ($Is_MSWin32) + {print "ok 29\n";} +elsif ($DEV !~ /\nc.* (\S+)\n/) {print "ok 29\n";} elsif (-c "/dev/$1") {print "ok 29\n";} @@ -107,7 +111,9 @@ else {print "not ok 29\n";} if (! -c '.') {print "ok 30\n";} else {print "not ok 30\n";} -if ($DEV !~ /\ns.* (\S+)\n/) +if ($Is_MSWin32) + {print "ok 31\n";} +elsif ($DEV !~ /\ns.* (\S+)\n/) {print "ok 31\n";} elsif (-S "/dev/$1") {print "ok 31\n";} @@ -115,7 +121,9 @@ else {print "not ok 31\n";} if (! -S '.') {print "ok 32\n";} else {print "not ok 32\n";} -if ($DEV !~ /\nb.* (\S+)\n/) +if ($Is_MSWin32) + {print "ok 33\n";} +elsif ($DEV !~ /\nb.* (\S+)\n/) {print "ok 33\n";} elsif (-b "/dev/$1") {print "ok 33\n";} @@ -123,7 +131,7 @@ else {print "not ok 33\n";} if (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";} -if ($^O eq 'amigaos') {print "ok 35\n"; goto tty_test;} +if ($^O eq 'amigaos' or $Is_MSWin32) {print "ok 35\n"; goto tty_test;} $cnt = $uid = 0; @@ -147,12 +155,18 @@ else tty_test: -unless (open(tty,"/dev/tty")) { - print STDERR "Can't open /dev/tty--run t/TEST outside of make.\n"; +if ($Is_MSWin32) { + print "ok 36\n"; + print "ok 37\n"; +} +else { + unless (open(tty,"/dev/tty")) { + print STDERR "Can't open /dev/tty--run t/TEST outside of make.\n"; + } + if (-t tty) {print "ok 36\n";} else {print "not ok 36\n";} + if (-c tty) {print "ok 37\n";} else {print "not ok 37\n";} + close(tty); } -if (-t tty) {print "ok 36\n";} else {print "not ok 36\n";} -if (-c tty) {print "ok 37\n";} else {print "not ok 37\n";} -close(tty); if (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";} open(null,"/dev/null"); if (! -t null || -e '/xenix' || -e '/MachTen') diff --git a/t/op/sysio.t b/t/op/sysio.t index 0f546b270f..ee274c1692 100755 --- a/t/op/sysio.t +++ b/t/op/sysio.t @@ -6,7 +6,7 @@ chdir('op') || die "sysio.t: cannot look for myself: $!"; open(I, 'sysio.t') || die "sysio.t: cannot find myself: $!"; -$reopen = ($^O eq 'VMS' || $^O eq 'os2'); +$reopen = ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'MSWin32'); $x = 'abc'; diff --git a/t/op/taint.t b/t/op/taint.t index 56765fb71d..66e26d82c9 100755 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -16,14 +16,18 @@ use strict; use Config; my $Is_VMS = $^O eq 'VMS'; -my $Invoke_Perl = $Is_VMS ? 'MCR Sys$Disk:[]Perl.' : './perl'; +my $Is_MSWin32 = $^O eq 'MSWin32'; +my $Invoke_Perl = $Is_VMS ? 'MCR Sys$Disk:[]Perl.' : + $Is_MSWin32 ? '.\perl' : './perl'; if ($Is_VMS) { + my ($olddcl) = $ENV{'DCL$PATH'} =~ /^(.*)$/; + my ($oldifs) = $ENV{IFS} =~ /^(.*)$/; eval <<EndOfCleanup; END { \$ENV{PATH} = ''; warn "# Note: logical name 'PATH' may have been deleted\n"; - \$ENV{IFS} = "$ENV{IFS}"; - \$ENV{'DCL\$PATH'} = "$ENV{'DCL$PATH'}"; + \$ENV{IFS} = \$oldifs; + \$ENV{'DCL\$PATH'} = \$olddcl; } EndOfCleanup } diff --git a/t/pragma/strict.t b/t/pragma/strict.t index 75856971fa..fc3282089f 100755 --- a/t/pragma/strict.t +++ b/t/pragma/strict.t @@ -9,6 +9,7 @@ BEGIN { $| = 1; my $Is_VMS = $^O eq 'VMS'; +my $Is_MSWin32 = $^O eq 'MSWin32'; my $tmpfile = "tmp0000"; my $i = 0 ; 1 while -f ++$tmpfile; @@ -66,6 +67,8 @@ for (@prgs){ close TEST; my $results = $Is_VMS ? `MCR $^X $switch $tmpfile` : + $Is_MSWin32 ? + `.\\perl -I../lib $switch $tmpfile 2>&1` : `sh -c './perl $switch $tmpfile' 2>&1`; my $status = $?; $results =~ s/\n+$//; diff --git a/t/pragma/subs.t b/t/pragma/subs.t index 33180066e0..056c4bd7cf 100755 --- a/t/pragma/subs.t +++ b/t/pragma/subs.t @@ -12,6 +12,7 @@ my @prgs = split "\n########\n", <DATA>; print "1..", scalar @prgs, "\n"; my $Is_VMS = $^O eq 'VMS'; +my $Is_MSWin32 = $^O eq 'MSWin32'; my $tmpfile = "tmp0000"; my $i = 0 ; 1 while -f ++$tmpfile; @@ -46,6 +47,8 @@ for (@prgs){ close TEST; my $results = $Is_VMS ? `MCR $^X $switch $tmpfile` : + $Is_MSWin32 ? + `.\\perl -I../lib $switch $tmpfile 2>&1` : `sh -c './perl $switch $tmpfile' 2>&1`; my $status = $?; $results =~ s/\n+$//; @@ -89,7 +92,7 @@ EXPECT Number found where operator expected at - line 3, near "Fred 1" (Do you need to predeclare Fred?) syntax error at - line 3, near "Fred 1" -Execution of - aborted due to compilation errors. +BEGIN not safe after errors--compilation aborted at - line 4. ######## # AOK diff --git a/t/pragma/warning.t b/t/pragma/warning.t index 3bb70e3ce8..fa0301ea6a 100755 --- a/t/pragma/warning.t +++ b/t/pragma/warning.t @@ -9,6 +9,7 @@ BEGIN { $| = 1; my $Is_VMS = $^O eq 'VMS'; +my $Is_MSWin32 = $^O eq 'MSWin32'; my $tmpfile = "tmp0000"; my $i = 0 ; 1 while -f ++$tmpfile; @@ -67,6 +68,8 @@ for (@prgs){ close TEST; my $results = $Is_VMS ? `MCR $^X $switch $tmpfile` : + $Is_MSWin32 ? + `.\\perl -I../lib $switch $tmpfile 2>&1` : `sh -c './perl $switch $tmpfile' 2>&1`; my $status = $?; $results =~ s/\n+$//; @@ -157,12 +157,15 @@ no_op(what, s) char *what; char *s; { - char tmpbuf[128]; char *oldbp = bufptr; bool is_first = (oldbufptr == linestart); + char *msg; + bufptr = s; - sprintf(tmpbuf, "%s found where operator expected", what); - yywarn(tmpbuf); + New(890, msg, strlen(what) + 40, char); + sprintf(msg, "%s found where operator expected", what); + yywarn(msg); + Safefree(msg); if (is_first) warn("\t(Missing semicolon on previous line?)\n"); else if (oldoldbufptr && isIDFIRST(*oldoldbufptr)) { @@ -1385,9 +1388,7 @@ yylex() s = bufptr; Aop(OP_CONCAT); } - else - return yylex(); - break; + return yylex(); case LEX_INTERPENDMAYBE: if (intuit_more(bufptr)) { @@ -1920,7 +1921,6 @@ yylex() else lex_brackstack[lex_brackets++] = XOPERATOR; OPERATOR(HASHBRACK); - break; case XOPERATOR: while (s < bufend && (*s == ' ' || *s == '\t')) s++; @@ -2233,6 +2233,17 @@ yylex() expect = XTERM; /* e.g. print $fh "foo" */ else if (strchr("&*<%", *s) && isIDFIRST(s[1])) expect = XTERM; /* e.g. print $fh &sub */ + else if (isIDFIRST(*s)) { + char tmpbuf[1024]; + scan_word(s, tmpbuf, TRUE, &len); + if (keyword(tmpbuf, len)) + expect = XTERM; /* e.g. print $fh length() */ + else { + GV *gv = gv_fetchpv(tmpbuf, FALSE, SVt_PVCV); + if (gv && GvCVu(gv)) + expect = XTERM; /* e.g. print $fh subr() */ + } + } else if (isDIGIT(*s)) expect = XTERM; /* e.g. print $fh 3 */ else if (*s == '.' && isDIGIT(s[1])) @@ -2641,15 +2652,21 @@ yylex() TOKEN(WORD); } + case KEY___FILE__: case KEY___LINE__: - case KEY___FILE__: { if (tokenbuf[2] == 'L') (void)sprintf(tokenbuf,"%ld",(long)curcop->cop_line); else strcpy(tokenbuf, SvPVX(GvSV(curcop->cop_filegv))); yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0)); TERM(THING); - } + + case KEY___PACKAGE__: + yylval.opval = (OP*)newSVOP(OP_CONST, 0, + (curstash + ? newSVsv(curstname) + : &sv_undef)); + TERM(THING); case KEY___DATA__: case KEY___END__: { @@ -3432,6 +3449,8 @@ yylex() /* Look for a prototype */ if (*s == '(') { + char *p; + s = scan_str(s); if (!s) { if (lex_stuff) @@ -3439,6 +3458,16 @@ yylex() lex_stuff = Nullsv; croak("Prototype not terminated"); } + /* strip spaces */ + d = SvPVX(lex_stuff); + tmp = 0; + for (p = d; *p; ++p) { + if (!isSPACE(*p)) + d[tmp++] = *p; + } + d[tmp] = '\0'; + SvCUR(lex_stuff) = tmp; + nexttoke++; nextval[1] = nextval[0]; nexttype[1] = nexttype[0]; @@ -3613,8 +3642,9 @@ I32 len; switch (*d) { case '_': if (d[1] == '_') { - if (strEQ(d,"__LINE__")) return -KEY___LINE__; if (strEQ(d,"__FILE__")) return -KEY___FILE__; + if (strEQ(d,"__LINE__")) return -KEY___LINE__; + if (strEQ(d,"__PACKAGE__")) return -KEY___PACKAGE__; if (strEQ(d,"__DATA__")) return KEY___DATA__; if (strEQ(d,"__END__")) return KEY___END__; } @@ -5136,40 +5166,52 @@ int yyerror(s) char *s; { - char tmpbuf[258]; - char *tname = tmpbuf; + char wbuf[40]; + char *where = NULL; + char *context = NULL; + int contlen = -1; if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 && oldoldbufptr != oldbufptr && oldbufptr != bufptr) { while (isSPACE(*oldoldbufptr)) oldoldbufptr++; - sprintf(tname,"near \"%.*s\"",bufptr - oldoldbufptr, oldoldbufptr); + context = oldoldbufptr; + contlen = bufptr - oldoldbufptr; } else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 && oldbufptr != bufptr) { while (isSPACE(*oldbufptr)) oldbufptr++; - sprintf(tname,"near \"%.*s\"",bufptr - oldbufptr, oldbufptr); + context = oldbufptr; + contlen = bufptr - oldbufptr; } else if (yychar > 255) - tname = "next token ???"; + where = "next token ???"; else if (!yychar || (yychar == ';' && !rsfp)) - (void)strcpy(tname,"at EOF"); + where = "at EOF"; else if ((yychar & 127) == 127) { if (lex_state == LEX_NORMAL || (lex_state == LEX_KNOWNEXT && lex_defer == LEX_NORMAL)) - (void)strcpy(tname,"at end of line"); + where = "at end of line"; else if (lex_inpat) - (void)strcpy(tname,"within pattern"); + where = "within pattern"; else - (void)strcpy(tname,"within string"); + where = "within string"; } else if (yychar < 32) - (void)sprintf(tname,"next char ^%c",toCTRL(yychar)); + (void)sprintf(where = wbuf, "next char ^%c", toCTRL(yychar)); + else if (isPRINT_LC(yychar)) + (void)sprintf(where = wbuf, "next char %c", yychar); + else + (void)sprintf(where = wbuf, "next char \\%03o", yychar & 255); + if (contlen == -1) + contlen = strlen(where); + (void)sprintf(buf, "%s at %s line %d, ", + s, SvPVX(GvSV(curcop->cop_filegv)), curcop->cop_line); + if (context) + (void)sprintf(buf+strlen(buf), "near \"%.*s\"\n", contlen, context); else - (void)sprintf(tname,"next char %c",yychar); - (void)sprintf(buf, "%s at %s line %d, %s\n", - s,SvPVX(GvSV(curcop->cop_filegv)),curcop->cop_line,tname); + (void)sprintf(buf+strlen(buf), "%s\n", where); if (multi_start < multi_end && (U32)(curcop->cop_line - multi_end) <= 1) { sprintf(buf+strlen(buf), " (Might be a runaway multi-line %c%c string starting on line %ld)\n", @@ -1329,6 +1329,7 @@ warn(pat,va_alist) } #ifndef VMS /* VMS' my_setenv() is in VMS.c */ +#ifndef _WIN32 void my_setenv(nam,val) char *nam, *val; @@ -1387,6 +1388,36 @@ char *nam; } /* potential SEGV's */ return i; } + +#else /* if _WIN32 */ + +void +my_setenv(nam,val) +char *nam, *val; +{ + register char *envstr; + STRLEN namlen = strlen(nam); + STRLEN vallen = strlen(val ? val : ""); + + New(9040, envstr, namlen + vallen + 3, char); + (void)sprintf(envstr,"%s=%s",nam,val); + if (!vallen) { + /* An attempt to delete the entry. + * We try to fix a Win32 process handling goof: Children + * of the current process will end up seeing the + * grandparent's entry if the current process has never + * modified the entry being deleted. So we call _putenv() + * twice: once to pretend to modify the entry, and the + * second time to actually delete it. GSAR 97-03-19 + */ + envstr[namlen+1] = 'X'; envstr[namlen+2] = '\0'; + (void)_putenv(envstr); + envstr[namlen+1] = '\0'; + } + (void)_putenv(envstr); +} + +#endif /* _WIN32 */ #endif /* !VMS */ #ifdef UNLINK_ALL_VERSIONS diff --git a/utils/perlbug.PL b/utils/perlbug.PL index 064d71d652..2b676a4ae5 100644 --- a/utils/perlbug.PL +++ b/utils/perlbug.PL @@ -504,8 +504,8 @@ EOF tryagain: if(!$usefile and !$body) { - my($sts) = system("$ed $filename"); - if( $Is_VMS ? !($sts & 1) : $sts ) { + my $sts = system("$ed $filename"); + if($sts) { #print "\nUnable to run editor!\n"; paraprint <<EOF; @@ -683,7 +683,7 @@ sub Send { } $subject =~ s/"/""/g; $address =~ s/"/""/g; $cc =~ s/"/""/g; my($sts) = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]); - if (!($sts & 1)) { die "Can't spawn off mail\n\t(leaving bug report in $filename): $sts\n;" } + if ($sts) { die "Can't spawn off mail\n\t(leaving bug report in $filename): $sts\n;" } } else { my($sendmail) = ""; diff --git a/vms/config.vms b/vms/config.vms index 040895d957..5a362c9d50 100644 --- a/vms/config.vms +++ b/vms/config.vms @@ -76,7 +76,7 @@ * when Perl is built. Please do not change it by hand; make * any changes to FndVers.Com instead. */ -#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00393" /**/ +#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00394" /**/ #define ARCHLIB ARCHLIB_EXP /*config-skip*/ /* ARCHNAME: diff --git a/vms/descrip.mms b/vms/descrip.mms index c22dcdea16..06c523eb48 100644 --- a/vms/descrip.mms +++ b/vms/descrip.mms @@ -1,5 +1,5 @@ # Descrip.MMS for perl5 on VMS -# Last revised 22-Mar-1996 by Charles Bailey bailey@genetics.upenn.edu +# Last revised 20-Mar-1997 by Charles Bailey bailey@genetics.upenn.edu # #: This file uses MMS syntax, and can be processed using DEC's MMS product, #: or the free MMK clone (available by ftp at ftp.spc.edu). If you want to @@ -65,7 +65,7 @@ OBJVAL = $(MMS$TARGET_NAME)$(O) .endif # Updated by fndvers.com -- do not edit by hand -PERL_VERSION = 5_00393# +PERL_VERSION = 5_00394# ARCHDIR = [.lib.$(ARCH).$(PERL_VERSION)] @@ -810,7 +810,10 @@ perly$(O) : perly.c, perly.h, $(h) [.t.lib]vmsfspec.t : [.vms.ext]filespec.t Copy/Log/NoConfirm $(MMS$SOURCE) $(MMS$TARGET) -test : all [.t.lib]vmsfspec.t +[.t.lib]vmsish.t : [.vms.ext]vmsish.t + Copy/Log/NoConfirm $(MMS$SOURCE) $(MMS$TARGET) + +test : all [.t.lib]vmsfspec.t [.t.lib]vmsish.t - @[.VMS]Test.Com "$(E)" archify : all @@ -935,6 +938,10 @@ $(ARCHAUTO)time.stamp : .ifdef LINK_ONLY .else +# We need an action line here for broken older versions of MMS which +# otherwise conclude that they should be compiling [.x2p]utils.c :-( +util$(O) : util.c + $(CC) $(CFLAGS) util.c # AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE av$(O) : EXTERN.h av$(O) : av.c @@ -1628,9 +1635,7 @@ globals$(O) : util.h [.x2p]str$(O) : [.x2p]str.h [.x2p]str$(O) : handy.h [.x2p]str$(O) : [.x2p]util.h -.ifdef __MMK__ [.x2p]util$(O) : [.x2p]util.c -.endif [.x2p]util$(O) : [.x2p]EXTERN.h [.x2p]util$(O) : [.x2p]a2p.h [.x2p]util$(O) : [.x2p]hash.h @@ -1696,7 +1701,7 @@ tidy : cleanlis - If F$Search("[.lib]*.com;-1").nes."" Then Purge/NoConfirm/Log [.lib]*.com - If F$Search("[.utils]*.com;-1").nes."" Then Purge/NoConfirm/Log [.utils]*.com - If F$Search("[.x2p]*.com;-1").nes."" Then Purge/NoConfirm/Log [.x2p]*.com - - If F$Search("[.lib.pod]*.;-1").nes."" Then Purge/NoConfirm/Log [.lib.pod]*. + - If F$Search("[.lib.pod]*.com;-1").nes."" Then Purge/NoConfirm/Log [.lib.pod]*.com clean : tidy Set Default [.ext.Fcntl] @@ -1763,7 +1768,7 @@ realclean : clean - If F$Search("[.lib.pod]*.pod").nes."" Then Delete/NoConfirm/Log [.lib.pod]*.pod;* - If F$Search("[.lib.pod]perldoc.com").nes."" Then Delete/NoConfirm/Log [.lib.pod]perldoc.com;* - If F$Search("[.lib.pod]pod2*.com").nes."" Then Delete/NoConfirm/Log [.lib.pod]pod2*.com;* - - If F$Search("[.t.lib]vmsfspec.t").nes."" Then Delete/NoConfirm/Log [.t.lib]vmsfspec.t;* + - If F$Search("[.t.lib]vms*.t").nes."" Then Delete/NoConfirm/Log [.t.lib]vms*.t;* - If F$Search("[...]*$(E)").nes."" Then Delete/NoConfirm/Log [...]*$(E);* cleansrc : clean diff --git a/vms/ext/vmsish.t b/vms/ext/vmsish.t new file mode 100644 index 0000000000..f68b3ac89c --- /dev/null +++ b/vms/ext/vmsish.t @@ -0,0 +1,122 @@ + +BEGIN { unshift @INC, '[-.lib]'; } + +my $Invoke_Perl = qq(MCR $^X "-I[-.lib]"); + +print "1..16\n"; + +#========== vmsish status ========== +`$Invoke_Perl -e 1`; # Avoid system() from a pipe from harness. Mutter. +if ($?) { print "not ok 1 # POSIX status is $?\n"; } +else { print "ok 1\n"; } +{ + use vmsish qw(status); + if (not ($? & 1)) { print "not ok 2 # vmsish status is $?\n"; } + else { print "ok 2\n"; } + { + no vmsish '$?'; # check unimport function + if ($?) { print "not ok 3 # POSIX status is $?\n"; } + else { print "ok 3\n"; } + } + # and lexical scoping + if (not ($? & 1)) { print "not ok 4 # vmsish status is $?\n"; } + else { print "ok 4\n"; } +} +if ($?) { print "not ok 5 # POSIX status is $?\n"; } +else { print "ok 5\n"; } +{ + use vmsish qw(exit); # check import function + if ($?) { print "not ok 6 # POSIX status is $?\n"; } + else { print "ok 6\n"; } +} + +#========== vmsish exit ========== +{ + use vmsish qw(status); + my $msg = `$Invoke_Perl "-I[-.lib]" -e "exit 1"`; + if ($msg !~ /ABORT/) { + $msg =~ s/\n/\\n/g; # keep output on one line + print "not ok 7 # subprocess output: |$msg|\n"; + } + else { print "ok 7\n"; } + if ($? & 1) { print "not ok 8 # subprocess VMS status: $?\n"; } + else { print "ok 8\n"; } + + $msg = `$Invoke_Perl "-I[-.lib]" -e "use vmsish qw(exit); exit 1"`; + if (length $msg) { + $msg =~ s/\n/\\n/g; # keep output on one line + print "not ok 9 # subprocess output: |$msg|\n"; + } + else { print "ok 9\n"; } + if (not ($? & 1)) { print "not ok 10 # subprocess VMS status: $?\n"; } + else { print "ok 10\n"; } + + $msg = `$Invoke_Perl "-I[-.lib]" -e "use vmsish qw(exit); exit 44"`; + if ($msg !~ /ABORT/) { + $msg =~ s/\n/\\n/g; # keep output on one line + print "not ok 11 # subprocess output: |$msg|\n"; + } + else { print "ok 11\n"; } + if ($? & 1) { print "not ok 12 # subprocess VMS status: $?\n"; } + else { print "ok 12\n"; } +} + + +#========== vmsish time ========== +{ + my($utctime, @utclocal, @utcgmtime, $utcmtime, + $vmstime, @vmslocal, @vmsgmtime, $vmsmtime, + $utcval, $vmaval, $offset); + # Make sure apparent local time isn't GMT + if (not $ENV{'SYS$TIMEZONE_DIFFERENTIAL'}) { + $oldtz = $ENV{'SYS$TIMEZONE_DIFFERENTIAL'}; + $ENV{'SYS$TIMEZONE_DIFFERENTIAL'} = 3600; + eval "END { \$ENV{'SYS\$TIMEZONE_DIFFERENTIAL'} = $oldtz; }"; + gmtime(0); # Force reset of tz offset + } + { + use vmsish qw(time); + $vmstime = time; + @vmslocal = localtime($vmstime); + @vmsgmtime = gmtime($vmstime); + $vmsmtime = (stat $0)[9]; + } + $utctime = time; + @utclocal = localtime($vmstime); + @utcgmtime = gmtime($vmstime); + $utcmtime = (stat $0)[9]; + + $offset = $ENV{'SYS$TIMEZONE_DIFFERENTIAL'}; + + # We allow lots of leeway (10 sec) difference for these tests, + # since it's unlikely local time will differ from UTC by so small + # an amount, and it renders the test resistant to delays from + # things like stat() on a file mounted over a slow network link. + if ($utctime - $vmstime + $offset > 10) { + print "not ok 13 # (time) UTC: $utctime VMS: $vmstime\n"; + } + else { print "ok 13\n"; } + + $utcval = $utclocal[5] * 31536000 + $utclocal[7] * 86400 + + $utclocal[2] * 3600 + $utclocal[1] * 60 + $utclocal[0]; + $vmsval = $vmslocal[5] * 31536000 + $vmslocal[7] * 86400 + + $vmslocal[2] * 3600 + $vmslocal[1] * 60 + $vmslocal[0]; + if ($vmsval - $utcval + $offset > 10) { + print "not ok 14 # (localtime)\n# UTC: @utclocal\n# VMS: @vmslocal\n"; + } + else { print "ok 14\n"; } + + $utcval = $utcgmtime[5] * 31536000 + $utcgmtime[7] * 86400 + + $utcgmtime[2] * 3600 + $utcgmtime[1] * 60 + $utcgmtime[0]; + $vmsval = $vmsgmtime[5] * 31536000 + $vmsgmtime[7] * 86400 + + $vmsgmtime[2] * 3600 + $vmsgmtime[1] * 60 + $vmsgmtime[0]; + if ($vmsval - $utcval + $offset > 10) { + print "not ok 15 # (gmtime)\n# UTC: @utcgmtime\n# VMS: @vmsgmtime\n"; + } + else { print "ok 15\n"; } + + if ($utcmtime - $vmsmtime + $offset > 10) { + print "not ok 16 # (stat) UTC: $utcmtime VMS: $vmsmtime\n"; + } + else { print "ok 16\n"; } +} @@ -3172,6 +3172,11 @@ my_gmtime(const time_t *timep) char *p; time_t when; + if (timep == NULL) { + set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG); + return NULL; + } + if (*timep == 0) gmtime_emulation_type = 0; /* possibly reset TZ */ if (gmtime_emulation_type == 0) (void) my_time(NULL); /* Init UTC */ when = *timep; @@ -3191,6 +3196,11 @@ my_localtime(const time_t *timep) { time_t when; + if (timep == NULL) { + set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG); + return NULL; + } + if (*timep == 0) gmtime_emulation_type = 0; /* possibly reset TZ */ if (gmtime_emulation_type == 0) (void) my_time(NULL); /* Init UTC */ when = *timep; diff --git a/win32/Fcntl.mak b/win32/Fcntl.mak index 4e07efbb2a..accea9ece7 100644 --- a/win32/Fcntl.mak +++ b/win32/Fcntl.mak @@ -60,9 +60,9 @@ CLEAN : "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MT /W3 /GX /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c -CPP_PROJ=/nologo /MT /W3 /GX /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D\ +# ADD BASE CPP /nologo /MT /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c +CPP_PROJ=/nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D\ "NDEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/Fcntl.pch" /YX /Fo"$(INTDIR)/" /c CPP_OBJS=.\Release/ CPP_SBRS= @@ -123,9 +123,9 @@ CLEAN : "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /MTd /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MTd /W3 /Gm /GX /Zi /Od /I ".\include" /I "." /I ".." /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c -CPP_PROJ=/nologo /MTd /W3 /Gm /GX /Zi /Od /I ".\include" /I "." /I ".." /D\ +# ADD BASE CPP /nologo /MTd /W3 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MTd /W3 /Gm /Zi /Od /I ".\include" /I "." /I ".." /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +CPP_PROJ=/nologo /MTd /W3 /Gm /Zi /Od /I ".\include" /I "." /I ".." /D\ "WIN32" /D "_DEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/Fcntl.pch" /YX /Fo"$(INTDIR)/"\ /Fd"$(INTDIR)/" /c CPP_OBJS=.\Debug/ diff --git a/win32/IO.mak b/win32/IO.mak index 7cd744ee07..304a4065cf 100644 --- a/win32/IO.mak +++ b/win32/IO.mak @@ -60,9 +60,9 @@ CLEAN : "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MT /W3 /GX /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c -CPP_PROJ=/nologo /MT /W3 /GX /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D\ +# ADD BASE CPP /nologo /MT /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c +CPP_PROJ=/nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D\ "NDEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/IO.pch" /YX /Fo"$(INTDIR)/" /c CPP_OBJS=.\Release/ CPP_SBRS= @@ -122,9 +122,9 @@ CLEAN : "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /MTd /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MTd /W3 /Gm /GX /Zi /Od /I ".\include" /I "." /I ".." /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c -CPP_PROJ=/nologo /MTd /W3 /Gm /GX /Zi /Od /I ".\include" /I "." /I ".." /D\ +# ADD BASE CPP /nologo /MTd /W3 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MTd /W3 /Gm /Zi /Od /I ".\include" /I "." /I ".." /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +CPP_PROJ=/nologo /MTd /W3 /Gm /Zi /Od /I ".\include" /I "." /I ".." /D\ "WIN32" /D "_DEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/IO.pch" /YX /Fo"$(INTDIR)/"\ /Fd"$(INTDIR)/" /c CPP_OBJS=.\Debug/ diff --git a/win32/Makefile b/win32/Makefile index 07e781efb5..05c2c48b36 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -1,126 +1,274 @@ +# +# Makefile to build perl on Windowns NT using Microsoft NMAKE. +# +# +# This is set up to build a perl.exe that runs off a shared library +# (perl.dll). Also makes individual DLLs for the XS extensions. +# +# There's no support for building an all-static perl yet. +# Doesn't build any of the stuff in ..\utils yet. +# No support for installing documentation, uh, yet. +# -LIBDIR=..\..\lib + +# +# Set this to wherever you want "nmake install" to put your +# newly built perl. If you change this, you better change +# all occurrences of this prefix in $(INST_TOP)\lib\Config.pm +# as well. + +INST_TOP=C:\perl + +#################### do not edit below this line ######################## +# +INST_BIN=$(INST_TOP)\bin +INST_LIB=$(INST_TOP)\lib +INST_POD=$(INST_TOP)\pod +INST_HTML=$(INST_POD)\html +LIBDIR=..\lib EXTDIR=..\ext +PODDIR=..\pod EXTUTILSDIR=$(LIBDIR)\extutils -XSUBPP=..\..\miniperl $(EXTUTILSDIR)\xsubpp -C++ -prototypes -AUTOSPLIT=..\..\miniperl ..\..\win32\autosplit.pl -DEST=..\ + +# +# various targets +PERLLIB=..\libperl.lib +MINIPERL=..\miniperl.exe +PERLDLL=..\perl.dll +PERLEXE=..\perl.exe +GLOBEXE=..\perlglob.exe + +PL2BAT=bin\PL2BAT.BAT +MAKE=nmake /nologo +XCOPY=xcopy /d /f /r +NULL= + +# +# filenames given to xsubpp must have forward slashes (since it puts +# full pathnames in #line strings) +XSUBPP=..\$(MINIPERL) ..\$(EXTUTILSDIR)\xsubpp -C++ -prototypes + +CORE_C= \ + ..\av.c \ + ..\deb.c \ + ..\doio.c \ + ..\doop.c \ + ..\dump.c \ + ..\globals.c \ + ..\gv.c \ + ..\hv.c \ + ..\mg.c \ + ..\op.c \ + ..\perl.c \ + ..\perlio.c \ + ..\perly.c \ + ..\pp.c \ + ..\pp_ctl.c \ + ..\pp_hot.c \ + ..\pp_sys.c \ + ..\regcomp.c \ + ..\regexec.c \ + ..\run.c \ + ..\scope.c \ + ..\sv.c \ + ..\taint.c \ + ..\toke.c \ + ..\universal.c \ + ..\util.c EXTENSIONS=DynaLoader Socket IO Fcntl Opcode SDBM_File -#STATICLINKMODUES=DynaLoader Socket Fcntl Opcode SDBM_File -STATICLINKMODUES= -#DYNALOADMODULES=IO.dll -DYNALOADMODULES=Socket.dll Fcntl.dll Opcode.dll SDBM_File.dll IO.dll -ALL: perl +DYNALOADER=$(EXTDIR)\DynaLoader\DynaLoader +SOCKET=$(EXTDIR)\Socket\Socket +FCNTL=$(EXTDIR)\Fcntl\Fcntl +OPCODE=$(EXTDIR)\Opcode\Opcode +SDBM_FILE=$(EXTDIR)\SDBM_File\SDBM_File +IO=$(EXTDIR)\IO\IO + +SOCKET_DLL=..\lib\auto\Socket\Socket.dll +FCNTL_DLL=..\lib\auto\Fcntl\Fcntl.dll +OPCODE_DLL=..\lib\auto\Opcode\Opcode.dll +SDBM_FILE_DLL=..\lib\auto\SDBM_File\SDBM_File.dll +IO_DLL=..\lib\auto\IO\IO.dll + +STATICLINKMODULES=DynaLoader +DYNALOADMODULES= \ + $(SOCKET_DLL) \ + $(FCNTL_DLL) \ + $(OPCODE_DLL) \ + $(SDBM_FILE_DLL)\ + $(IO_DLL) + +POD2HTML=$(PODDIR)\pod2html +POD2MAN=$(PODDIR)\pod2man +POD2LATEX=$(PODDIR)\pod2latex +POD2TEXT=$(PODDIR)\pod2text + +ALL: $(PERLEXE) $(GLOBEXE) $(DYNALOADMODULES) !IF "$(CFG)" =="" CFG=Release !ENDIF -modules : $(EXTENSIONS) - nmake -A -f modules.mak CFG="modules - Win32 $(CFG)" +modules.lib : $(DYNALOADER).c + $(MAKE) -A -f modules.mak CFG="modules - Win32 $(CFG)" -perlglob.exe: - nmake -f perlglob.mak CFG="perlglob - Win32 Release" +$(GLOBEXE): + $(MAKE) -f perlglob.mak CFG="perlglob - Win32 Release" -libperl.lib: +$(PERLLIB): $(CORE_C) attrib -r ..\*.h copy dosish.h .. copy EXTERN.h .. - nmake -f libperl.mak CFG="libperl - Win32 $(CFG)" + $(MAKE) -f libperl.mak CFG="libperl - Win32 $(CFG)" -miniperl.exe: libperl.lib - nmake -A -f miniperl.mak CFG="miniperl - Win32 $(CFG)" +$(MINIPERL): $(PERLLIB) + $(MAKE) -A -f miniperl.mak CFG="miniperl - Win32 $(CFG)" copy config.w32 ..\config.sh cd .. miniperl configpm cd win32 - if exist lib\* xcopy lib\*.* ..\lib\ /s/e + if exist lib\* $(XCOPY) /e lib\*.* ..\lib\$(NULL) copy bin\test.bat ..\t -perldll: miniperl.exe libperl.lib - ..\miniperl -w makedef.pl > perldll.def - nmake -A -f perldll.mak CFG="perldll - Win32 $(CFG)" +$(PERLDLL): $(MINIPERL) $(PERLLIB) + $(MINIPERL) -w makedef.pl > perldll.def + $(MAKE) -A -f perldll.mak CFG="perldll - Win32 $(CFG)" -dynamodules: $(DYNALOADMODULES) - -perl: miniperl.exe modules perldll perlglob.exe dynamodules - ..\miniperl makemain.pl $(STATICLINKMODUES) > perlmain.c - ..\miniperl makeperldef.pl $(STATICLINKMODUES) > perl.def +$(PERLEXE): $(MINIPERL) modules.lib $(PERLDLL) + attrib -r perlmain.c + attrib -r perl.def +# $(MINIPERL) makemain.pl $(STATICLINKMODUES) > perlmain.c +# $(MINIPERL) makeperldef.pl $(STATICLINKMODUES) > perl.def + $(MINIPERL) makeperldef.pl $(NULL) > perl.def copy runperl.c perlmain.c - nmake -A -f perl.mak CFG="perl - Win32 $(CFG)" - copy ..\_perl.exe ..\perl.exe + $(MAKE) -A -f perl.mak CFG="perl - Win32 $(CFG)" + copy ..\_perl.exe $(PERLEXE) del ..\_perl.exe del ..\*.exp copy splittree.pl .. - ..\miniperl ..\splittree.pl "../LIB" "../LIB/auto" + $(MINIPERL) ..\splittree.pl "../LIB" "../LIB/auto" attrib -r ..\t\*.* copy test ..\t - xcopy ..\perl.h ..\lib\CORE\*.* - -DynaLoader: - md ..\lib\auto - cd $(EXTDIR)\$* - copy ..\..\win32\dl_win32.xs . - copy $*.pm $(LIBDIR) - $(XSUBPP) dl_win32.xs > $*.c - cd ..\..\win32 + $(XCOPY) ..\*.h ..\lib\CORE\*.* + $(XCOPY) ..\perl.lib ..\lib\CORE + $(XCOPY) $(PERLLIB) ..\lib\CORE + $(XCOPY) *.h ..\lib\CORE + $(XCOPY) /S include ..\lib\CORE -Socket: - md ..\lib\auto\$* - ..\miniperl genxsdef.pl $* > $*.def - cd $(EXTDIR)\$* - copy $*.pm $(LIBDIR) - $(XSUBPP) $*.xs > $*.c +$(DYNALOADER).c: $(EXTDIR)\DynaLoader\dl_win32.xs + if not exist ..\lib\auto md ..\lib\auto + $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) + cd $(EXTDIR)\$(*B) + $(XSUBPP) dl_win32.xs > $(*B).c cd ..\..\win32 -Socket.dll: - nmake -f $*.mak CFG="$* - Win32 $(CFG)" +$(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs + copy dl_win32.xs $(EXTDIR)\DynaLoader\dl_win32.xs -IO: - md ..\lib\auto\$* - ..\miniperl genxsdef.pl $* > $*.def - cd $(EXTDIR)\$* - copy $*.pm $(LIBDIR) - xcopy lib\*.* $(LIBDIR) /s - $(XSUBPP) $*.xs > $*.c +$(SOCKET).c: $(SOCKET).xs + if not exist ..\lib\auto\$(*B) md ..\lib\auto\$(*B) + $(MINIPERL) genxsdef.pl $(*B) > $(*B).def + $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) + cd $(EXTDIR)\$(*B) + $(XSUBPP) $(*B).xs > $(*B).c cd ..\..\win32 -IO.dll: - nmake -f $*.mak CFG="$* - Win32 $(CFG)" +$(IO).c: $(IO).xs + if not exist ..\lib\auto\$(*B) md ..\lib\auto\$(*B) + $(MINIPERL) genxsdef.pl $(*B) > $(*B).def + $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) + $(XCOPY) /s $(EXTDIR)\$(*B)\lib\*.* $(LIBDIR) + cd $(EXTDIR)\$(*B) + $(XSUBPP) $(*B).xs > $(*B).c + cd ..\..\win32 -SDBM_File: - md ..\lib\auto\$* - ..\miniperl genxsdef.pl $* > $*.def - cd $(EXTDIR)\$* - copy $*.pm $(LIBDIR) - $(XSUBPP) -typemap ./typemap $*.xs > $*.c +$(SDBM_FILE).c: $(SDBM_FILE).xs + if not exist ..\lib\auto\$(*B) md ..\lib\auto\$(*B) + $(MINIPERL) genxsdef.pl $(*B) > $(*B).def + $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) + cd $(EXTDIR)\$(*B) + $(XSUBPP) -typemap ./typemap $(*B).xs > $(*B).c cd ..\..\win32 -SDBM_File.dll: - nmake -f $*.mak CFG="$* - Win32 $(CFG)" +$(FCNTL).c: $(FCNTL).xs + if not exist ..\lib\auto\$(*B) md ..\lib\auto\$(*B) + $(MINIPERL) genxsdef.pl $(*B) > $(*B).def + $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) + cd $(EXTDIR)\$(*B) + $(XSUBPP) $(*B).xs > $(*B).c + cd ..\..\win32 -Fcntl: - md ..\lib\auto\$* - ..\miniperl genxsdef.pl $* > $*.def - cd $(EXTDIR)\$* - copy $*.pm $(LIBDIR) - $(XSUBPP) $*.xs > $*.c +$(OPCODE).c: $(OPCODE).xs + if not exist ..\lib\auto\$(*B) md ..\lib\auto\$(*B) + $(MINIPERL) genxsdef.pl $(*B) > $(*B).def + $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) + $(XCOPY) $(EXTDIR)\$(*B)\*.pm $(LIBDIR)\$(NULL) + cd $(EXTDIR)\$(*B) + $(XSUBPP) $(*B).xs > $(*B).c cd ..\..\win32 -Fcntl.dll: - nmake -f $*.mak CFG="$* - Win32 $(CFG)" +$(SOCKET_DLL): $(SOCKET).c $(PERLDLL) + $(MAKE) -f $(*B).mak CFG="$(*B) - Win32 $(CFG)" -Opcode: - md ..\lib\auto\$* - ..\miniperl genxsdef.pl $* > $*.def - cd $(EXTDIR)\$* - xcopy *.pm $(LIBDIR) - $(XSUBPP) $*.xs > $*.c - cd ..\..\win32 +$(IO_DLL): $(IO).c $(PERLDLL) + $(MAKE) -f $(*B).mak CFG="$(*B) - Win32 $(CFG)" + +$(SDBM_FILE_DLL): $(SDBM_FILE).c $(PERLDLL) + $(MAKE) -f $(*B).mak CFG="$(*B) - Win32 $(CFG)" -Opcode.dll: - nmake -f $*.mak CFG="$* - Win32 $(CFG)" +$(FCNTL_DLL): $(FCNTL).c $(PERLDLL) + $(MAKE) -f $(*B).mak CFG="$(*B) - Win32 $(CFG)" +$(OPCODE_DLL): $(OPCODE).c $(PERLDLL) + $(MAKE) -f $(*B).mak CFG="$(*B) - Win32 $(CFG)" + +doc: $(PERLEXE) + $(PERLEXE) $(POD2HTML).PL + $(PERLEXE) $(POD2MAN).PL + $(PERLEXE) $(POD2LATEX).PL + $(PERLEXE) $(POD2TEXT).PL + $(PERLEXE) $(PL2BAT) $(POD2HTML) + $(PERLEXE) $(PL2BAT) $(POD2MAN) + $(PERLEXE) $(PL2BAT) $(POD2LATEX) + $(PERLEXE) $(PL2BAT) $(POD2TEXT) + cd $(PODDIR) + $(PERLEXE) pod2html.bat *.pod + cd ..\win32 + +distclean: + -del /f $(MINIPERL) $(PERLEXE) $(PERLDLL) $(GLOBEXE) \ + $(PERLLIB) modules.lib + -del /f *.def + -del /f $(SOCKET_DLL) $(IO_DLL) $(SDBM_FILE_DLL) \ + $(FCNTL_DLL) $(OPCODE_DLL) + -del /f $(SOCKET).c $(IO).c $(SDBM_FILE).c $(FCNTL).c \ + $(OPCODE).c $(DYNALOADER).c + -del /f $(PODDIR)\*.html + -del /f $(PODDIR)\*.bat + -rmdir /s /q release + -rmdir /s /q debug + +install : ALL doc + if not exist $(INST_TOP) mkdir $(INST_TOP) + echo I $(INST_TOP) L $(LIBDIR) + $(XCOPY) $(PERLEXE) $(INST_BIN)\*.* + $(XCOPY) $(GLOBEXE) $(INST_BIN)\*.* + $(XCOPY) $(PERLDLL) $(INST_BIN)\*.* + $(XCOPY) /e ..\lib $(INST_LIB)\*.* + $(XCOPY) ..\pod\*.bat $(INST_BIN)\*.* + $(XCOPY) ..\pod\*.pod $(INST_POD)\*.* + $(XCOPY) ..\pod\*.html $(INST_HTML)\*.* + +inst_lib : + copy splittree.pl .. + $(MINIPERL) ..\splittree.pl "../LIB" "../LIB/auto" + $(XCOPY) /e ..\lib $(INST_LIB)\*.* +test : all + $(XCOPY) $(PERLEXE) ..\t\$(NULL) + $(XCOPY) $(PERLDLL) ..\t\$(NULL) + $(XCOPY) $(GLOBEXE) ..\t\$(NULL) + cd ..\t + $(PERLEXE) test + cd ..\win32 diff --git a/win32/Opcode.mak b/win32/Opcode.mak index 6e40b32e7a..d4ff2070bb 100644 --- a/win32/Opcode.mak +++ b/win32/Opcode.mak @@ -60,9 +60,9 @@ CLEAN : "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MT /W3 /GX /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c -CPP_PROJ=/nologo /MT /W3 /GX /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D\ +# ADD BASE CPP /nologo /MT /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c +CPP_PROJ=/nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D\ "NDEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/Opcode.pch" /YX /Fo"$(INTDIR)/" /c CPP_OBJS=.\Release/ CPP_SBRS= @@ -123,9 +123,9 @@ CLEAN : "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /MTd /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MTd /W3 /Gm /GX /Zi /Od /I ".\include" /I "." /I ".." /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c -CPP_PROJ=/nologo /MTd /W3 /Gm /GX /Zi /Od /I ".\include" /I "." /I ".." /D\ +# ADD BASE CPP /nologo /MTd /W3 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MTd /W3 /Gm /Zi /Od /I ".\include" /I "." /I ".." /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +CPP_PROJ=/nologo /MTd /W3 /Gm /Zi /Od /I ".\include" /I "." /I ".." /D\ "WIN32" /D "_DEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/Opcode.pch" /YX /Fo"$(INTDIR)/"\ /Fd"$(INTDIR)/" /c CPP_OBJS=.\Debug/ diff --git a/win32/SDBM_File.mak b/win32/SDBM_File.mak index 0bf5d1adf6..379ba26e2e 100644 --- a/win32/SDBM_File.mak +++ b/win32/SDBM_File.mak @@ -67,10 +67,10 @@ CLEAN : "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MT /W3 /GX /O2 /I ".\include" /I "." /I ".." /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" /YX /c -CPP_PROJ=/nologo /MT /W3 /GX /O2 /I ".\include" /I "." /I ".." /D "NDEBUG" /D\ - "WIN32" /D "_WINDOWS" /D "MSDOS" /Fp"$(INTDIR)/SDBM_File.pch" /YX\ +# ADD BASE CPP /nologo /MT /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /c +# ADD CPP /nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" /c +CPP_PROJ=/nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "NDEBUG" /D\ + "WIN32" /D "_WINDOWS" /D "MSDOS" \ /Fo"$(INTDIR)/" /c CPP_OBJS=.\Release/ CPP_SBRS= @@ -136,10 +136,10 @@ CLEAN : "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /MTd /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MTd /W3 /Gm /GX /Zi /Od /I ".\include" /I "." /I ".." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" /YX /c -CPP_PROJ=/nologo /MTd /W3 /Gm /GX /Zi /Od /I ".\include" /I "." /I ".." /D\ - "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" /Fp"$(INTDIR)/SDBM_File.pch" /YX\ +# ADD BASE CPP /nologo /MTd /W3 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /c +# ADD CPP /nologo /MTd /W3 /Gm /Zi /Od /I ".\include" /I "." /I ".." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" /c +CPP_PROJ=/nologo /MTd /W3 /Gm /Zi /Od /I ".\include" /I "." /I ".." /D\ + "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" \ /Fo"$(INTDIR)/" /Fd"$(INTDIR)/" /c CPP_OBJS=.\Debug/ CPP_SBRS= diff --git a/win32/Socket.mak b/win32/Socket.mak index f2a09dce95..fd26c99049 100644 --- a/win32/Socket.mak +++ b/win32/Socket.mak @@ -61,9 +61,9 @@ CLEAN : "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MT /W3 /GX /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c -CPP_PROJ=/nologo /MT /W3 /GX /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D\ +# ADD BASE CPP /nologo /MT /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c +CPP_PROJ=/nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D\ "NDEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/Socket.pch" /YX /Fo"$(INTDIR)/" /c CPP_OBJS=.\release/ CPP_SBRS= @@ -126,9 +126,9 @@ CLEAN : "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /MTd /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MTd /W3 /Gm /GX /Zi /Od /I ".\include" /I "." /I ".." /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c -CPP_PROJ=/nologo /MTd /W3 /Gm /GX /Zi /Od /I ".\include" /I "." /I ".." /D\ +# ADD BASE CPP /nologo /MTd /W3 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MTd /W3 /Gm /Zi /Od /I ".\include" /I "." /I ".." /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +CPP_PROJ=/nologo /MTd /W3 /Gm /Zi /Od /I ".\include" /I "." /I ".." /D\ "WIN32" /D "_DEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/Socket.pch" /YX /Fo"$(INTDIR)/"\ /Fd"$(INTDIR)/" /c CPP_OBJS=.\debug/ diff --git a/win32/TEST b/win32/TEST index bd9f7b7186..a7e074ed9c 100644 --- a/win32/TEST +++ b/win32/TEST @@ -25,8 +25,8 @@ if ($ARGV[0] eq '') { push( @ARGV, `dir/s/b cmd` ); push( @ARGV, `dir/s/b io` ); push( @ARGV, `dir/s/b op` ); + push( @ARGV, `dir/s/b pragma` ); push( @ARGV, `dir/s/b lib` ); - push( @ARGV, `dir/s/b nt` ); grep( chomp, @ARGV ); @ARGV = grep( /\.t$/, @ARGV ); @@ -35,7 +35,7 @@ if ($ARGV[0] eq '') { # `echo base/*.t comp/*.t cmd/*.t io/*.t; echo op/*.t pragma/*.t lib/*.t`); } -if ($^O eq 'os2' || $^O eq 'qnx' || 1) { +if ($^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'qnx' || 1) { $sharpbang = 0; } else { diff --git a/win32/VC-2.0/SDBM_File.mak b/win32/VC-2.0/SDBM_File.mak new file mode 100644 index 0000000000..6ebaa15f2f --- /dev/null +++ b/win32/VC-2.0/SDBM_File.mak @@ -0,0 +1,361 @@ +# Microsoft Developer Studio Generated NMAKE File, Format Version 4.00 +# ** DO NOT EDIT ** + +# TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102 + +!IF "$(CFG)" == "" +CFG=SDBM_File - Win32 Debug +!MESSAGE No configuration specified. Defaulting to SDBM_File - Win32 Debug. +!ENDIF + +!IF "$(CFG)" != "SDBM_File - Win32 Release" && "$(CFG)" !=\ + "SDBM_File - Win32 Debug" +!MESSAGE Invalid configuration "$(CFG)" specified. +!MESSAGE You can specify a configuration when running NMAKE on this makefile +!MESSAGE by defining the macro CFG on the command line. For example: +!MESSAGE +!MESSAGE NMAKE /f "SDBM_File.mak" CFG="SDBM_File - Win32 Debug" +!MESSAGE +!MESSAGE Possible choices for configuration are: +!MESSAGE +!MESSAGE "SDBM_File - Win32 Release" (based on\ + "Win32 (x86) Dynamic-Link Library") +!MESSAGE "SDBM_File - Win32 Debug" (based on\ + "Win32 (x86) Dynamic-Link Library") +!MESSAGE +!ERROR An invalid configuration is specified. +!ENDIF + +!IF "$(OS)" == "Windows_NT" +NULL= +!ELSE +NULL=nul +!ENDIF +################################################################################ +# Begin Project +# PROP Target_Last_Scanned "SDBM_File - Win32 Debug" +CPP=cl.exe +RSC=rc.exe +MTL=mktyplib.exe + +!IF "$(CFG)" == "SDBM_File - Win32 Release" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 0 +# PROP BASE Output_Dir "SDBM_Fil" +# PROP BASE Intermediate_Dir "SDBM_Fil" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 0 +# PROP Output_Dir "Release" +# PROP Intermediate_Dir "Release" +# PROP Target_Dir "" +OUTDIR=.\Release +INTDIR=.\Release + +ALL : "$(OUTDIR)\SDBM_File.dll" + +CLEAN : + -@erase "..\lib\auto\SDBM_File\SDBM_File.dll" + -@erase ".\Release\sdbm.obj" + -@erase ".\Release\pair.obj" + -@erase ".\Release\hash.obj" + -@erase ".\Release\SDBM_File.obj" + -@erase ".\Release\SDBM_File.lib" + -@erase ".\Release\SDBM_File.exp" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +# ADD BASE CPP /nologo /MT /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /c +# ADD CPP /nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" /c +CPP_PROJ=/nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "NDEBUG" /D\ + "WIN32" /D "_WINDOWS" /D "MSDOS" \ + /Fo"$(INTDIR)/" /c +CPP_OBJS=.\Release/ +CPP_SBRS= +# ADD BASE MTL /nologo /D "NDEBUG" /win32 +# ADD MTL /nologo /D "NDEBUG" /win32 +MTL_PROJ=/nologo /D "NDEBUG" /win32 +# ADD BASE RSC /l 0x409 /d "NDEBUG" +# ADD RSC /l 0x409 /d "NDEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +BSC32_FLAGS=/nologo /o"$(OUTDIR)/SDBM_File.bsc" +BSC32_SBRS= +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:windows /dll /machine:I386 +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:windows /dll /pdb:none /machine:I386 /out:"../lib/auto/SDBM_File/SDBM_File.dll" +LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ + advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo\ + /subsystem:windows /dll /pdb:none /machine:I386 /def:".\SDBM_File.def"\ + /out:"../lib/auto/SDBM_File/SDBM_File.dll" /implib:"$(OUTDIR)/SDBM_File.lib" +DEF_FILE= \ + ".\SDBM_File.def" +LINK32_OBJS= \ + "$(INTDIR)/sdbm.obj" \ + "$(INTDIR)/pair.obj" \ + "$(INTDIR)/hash.obj" \ + "$(INTDIR)/SDBM_File.obj" \ + "..\perl.lib" + +"$(OUTDIR)\SDBM_File.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) + $(LINK32) @<< + $(LINK32_FLAGS) $(LINK32_OBJS) +<< + +!ELSEIF "$(CFG)" == "SDBM_File - Win32 Debug" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 1 +# PROP BASE Output_Dir "Debug" +# PROP BASE Intermediate_Dir "Debug" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 1 +# PROP Output_Dir "Debug" +# PROP Intermediate_Dir "Debug" +# PROP Target_Dir "" +OUTDIR=.\Debug +INTDIR=.\Debug + +ALL : "$(OUTDIR)\SDBM_File.dll" + +CLEAN : + -@erase ".\Debug\vc40.pdb" + -@erase ".\Debug\vc40.idb" + -@erase "..\lib\auto\SDBM_File\SDBM_File.dll" + -@erase ".\Debug\hash.obj" + -@erase ".\Debug\pair.obj" + -@erase ".\Debug\SDBM_File.obj" + -@erase ".\Debug\sdbm.obj" + -@erase ".\Debug\SDBM_File.lib" + -@erase ".\Debug\SDBM_File.exp" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +# ADD BASE CPP /nologo /MTd /W3 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /c +# ADD CPP /nologo /MTd /W3 /Gm /Zi /Od /I ".\include" /I "." /I ".." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" /c +CPP_PROJ=/nologo /MTd /W3 /Gm /Zi /Od /I ".\include" /I "." /I ".." /D\ + "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" \ + /Fo"$(INTDIR)/" /Fd"$(INTDIR)/" /c +CPP_OBJS=.\Debug/ +CPP_SBRS= +# ADD BASE MTL /nologo /D "_DEBUG" /win32 +# ADD MTL /nologo /D "_DEBUG" /win32 +MTL_PROJ=/nologo /D "_DEBUG" /win32 +# ADD BASE RSC /l 0x409 /d "_DEBUG" +# ADD RSC /l 0x409 /d "_DEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +BSC32_FLAGS=/nologo /o"$(OUTDIR)/SDBM_File.bsc" +BSC32_SBRS= +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:windows /dll /debug /machine:I386 +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:windows /dll /pdb:none /debug /machine:I386 /out:"../lib/auto/SDBM_File/SDBM_File.dll" +LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ + advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo\ + /subsystem:windows /dll /pdb:none /debug /machine:I386 /def:".\SDBM_File.def"\ + /out:"../lib/auto/SDBM_File/SDBM_File.dll" /implib:"$(OUTDIR)/SDBM_File.lib" +DEF_FILE= \ + ".\SDBM_File.def" +LINK32_OBJS= \ + "$(INTDIR)/hash.obj" \ + "$(INTDIR)/pair.obj" \ + "$(INTDIR)/SDBM_File.obj" \ + "$(INTDIR)/sdbm.obj" \ + "..\perl.lib" + +"$(OUTDIR)\SDBM_File.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) + $(LINK32) @<< + $(LINK32_FLAGS) $(LINK32_OBJS) +<< + +!ENDIF + +.c{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.cpp{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.cxx{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.c{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +.cpp{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +.cxx{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +################################################################################ +# Begin Target + +# Name "SDBM_File - Win32 Release" +# Name "SDBM_File - Win32 Debug" + +!IF "$(CFG)" == "SDBM_File - Win32 Release" + +!ELSEIF "$(CFG)" == "SDBM_File - Win32 Debug" + +!ENDIF + +################################################################################ +# Begin Source File + +SOURCE=..\ext\SDBM_File\SDBM_File.c +DEP_CPP_SDBM_=\ + ".\EXTERN.h"\ + ".\..\perl.h"\ + ".\..\XSUB.h"\ + ".\..\ext\SDBM_File\sdbm\sdbm.h"\ + ".\..\embed.h"\ + ".\config.h"\ + "$(INCLUDE)\sys\Types.h"\ + ".\..\perlio.h"\ + "$(INCLUDE)\sys\Stat.h"\ + ".\include\dirent.h"\ + ".\..\handy.h"\ + ".\..\dosish.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\unixish.h"\ + ".\..\regexp.h"\ + ".\..\sv.h"\ + ".\..\util.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\cv.h"\ + ".\..\opcode.h"\ + ".\..\op.h"\ + ".\..\cop.h"\ + ".\..\av.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\scope.h"\ + ".\..\perly.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\win32.h"\ + ".\include\sys/socket.h"\ + ".\include\netdb.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\nostdio.h"\ + +NODEP_CPP_SDBM_=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +!IF "$(CFG)" == "SDBM_File - Win32 Release" + + +"$(INTDIR)\SDBM_File.obj" : $(SOURCE) $(DEP_CPP_SDBM_) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "SDBM_File - Win32 Debug" + + +"$(INTDIR)\SDBM_File.obj" : $(SOURCE) $(DEP_CPP_SDBM_) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\ext\SDBM_File\sdbm\sdbm.c +DEP_CPP_SDBM_C=\ + ".\config.h"\ + ".\..\ext\SDBM_File\sdbm\sdbm.h"\ + ".\..\ext\SDBM_File\sdbm\tune.h"\ + ".\win32.h"\ + ".\include\dirent.h"\ + ".\include\sys/socket.h"\ + ".\include\netdb.h"\ + "$(INCLUDE)\sys\Types.h"\ + "$(INCLUDE)\sys\Stat.h"\ + + +"$(INTDIR)\sdbm.obj" : $(SOURCE) $(DEP_CPP_SDBM_C) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\ext\SDBM_File\sdbm\pair.c +DEP_CPP_PAIR_=\ + ".\config.h"\ + ".\..\ext\SDBM_File\sdbm\sdbm.h"\ + ".\..\ext\SDBM_File\sdbm\tune.h"\ + ".\win32.h"\ + ".\include\dirent.h"\ + ".\include\sys/socket.h"\ + ".\include\netdb.h"\ + "$(INCLUDE)\sys\Types.h"\ + "$(INCLUDE)\sys\Stat.h"\ + + +"$(INTDIR)\pair.obj" : $(SOURCE) $(DEP_CPP_PAIR_) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\ext\SDBM_File\sdbm\hash.c +DEP_CPP_HASH_=\ + ".\config.h"\ + ".\..\ext\SDBM_File\sdbm\sdbm.h"\ + ".\win32.h"\ + ".\include\dirent.h"\ + ".\include\sys/socket.h"\ + ".\include\netdb.h"\ + "$(INCLUDE)\sys\Types.h"\ + "$(INCLUDE)\sys\Stat.h"\ + + +"$(INTDIR)\hash.obj" : $(SOURCE) $(DEP_CPP_HASH_) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=.\SDBM_File.def + +!IF "$(CFG)" == "SDBM_File - Win32 Release" + +!ELSEIF "$(CFG)" == "SDBM_File - Win32 Debug" + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\perl.lib + +!IF "$(CFG)" == "SDBM_File - Win32 Release" + +!ELSEIF "$(CFG)" == "SDBM_File - Win32 Debug" + +!ENDIF + +# End Source File +# End Target +# End Project +################################################################################ diff --git a/win32/VC-2.0/Socket.mak b/win32/VC-2.0/Socket.mak new file mode 100644 index 0000000000..69a774c279 --- /dev/null +++ b/win32/VC-2.0/Socket.mak @@ -0,0 +1,276 @@ +# Microsoft Developer Studio Generated NMAKE File, Format Version 4.00 +# ** DO NOT EDIT ** + +# TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102 + +!IF "$(CFG)" == "" +CFG=Socket - Win32 Debug +!MESSAGE No configuration specified. Defaulting to Socket - Win32 Debug. +!ENDIF + +!IF "$(CFG)" != "Socket - Win32 Release" && "$(CFG)" != "Socket - Win32 Debug" +!MESSAGE Invalid configuration "$(CFG)" specified. +!MESSAGE You can specify a configuration when running NMAKE on this makefile +!MESSAGE by defining the macro CFG on the command line. For example: +!MESSAGE +!MESSAGE NMAKE /f "Socket.mak" CFG="Socket - Win32 Debug" +!MESSAGE +!MESSAGE Possible choices for configuration are: +!MESSAGE +!MESSAGE "Socket - Win32 Release" (based on "Win32 (x86) Dynamic-Link Library") +!MESSAGE "Socket - Win32 Debug" (based on "Win32 (x86) Dynamic-Link Library") +!MESSAGE +!ERROR An invalid configuration is specified. +!ENDIF + +!IF "$(OS)" == "Windows_NT" +NULL= +!ELSE +NULL=nul +!ENDIF +################################################################################ +# Begin Project +# PROP Target_Last_Scanned "Socket - Win32 Debug" +CPP=cl.exe +RSC=rc.exe +MTL=mktyplib.exe + +!IF "$(CFG)" == "Socket - Win32 Release" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 0 +# PROP BASE Output_Dir "Socket__" +# PROP BASE Intermediate_Dir "Socket__" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 0 +# PROP Output_Dir "release" +# PROP Intermediate_Dir "release" +# PROP Target_Dir "" +OUTDIR=.\release +INTDIR=.\release + +ALL : "$(OUTDIR)\Socket.dll" + +CLEAN : + -@erase "..\lib\auto\Socket\Socket.dll" + -@erase ".\release\Socket.obj" + -@erase ".\release\Socket.lib" + -@erase ".\release\Socket.exp" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +# ADD BASE CPP /nologo /MT /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c +CPP_PROJ=/nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "WIN32" /D\ + "NDEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/Socket.pch" /YX /Fo"$(INTDIR)/" /c +CPP_OBJS=.\release/ +CPP_SBRS= +# ADD BASE MTL /nologo /D "NDEBUG" /win32 +# ADD MTL /nologo /D "NDEBUG" /win32 +MTL_PROJ=/nologo /D "NDEBUG" /win32 +# ADD BASE RSC /l 0x409 /d "NDEBUG" +# ADD RSC /l 0x409 /d "NDEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +BSC32_FLAGS=/nologo /o"$(OUTDIR)/Socket.bsc" +BSC32_SBRS= +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:windows /dll /machine:I386 +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:windows /dll /machine:I386 /out:"..\lib\auto\Socket\Socket.dll" +LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ + advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo\ + /subsystem:windows /dll /incremental:no /pdb:"$(OUTDIR)/Socket.pdb"\ + /machine:I386 /def:".\Socket.def" /out:"..\lib\auto\Socket\Socket.dll"\ + /implib:"$(OUTDIR)/Socket.lib" +DEF_FILE= \ + ".\Socket.def" +LINK32_OBJS= \ + "$(INTDIR)/Socket.obj" \ + "..\perl.lib" + +"$(OUTDIR)\Socket.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) + $(LINK32) @<< + $(LINK32_FLAGS) $(LINK32_OBJS) +<< + +!ELSEIF "$(CFG)" == "Socket - Win32 Debug" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 1 +# PROP BASE Output_Dir "Socket_0" +# PROP BASE Intermediate_Dir "Socket_0" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 1 +# PROP Output_Dir "debug" +# PROP Intermediate_Dir "debug" +# PROP Target_Dir "" +OUTDIR=.\debug +INTDIR=.\debug + +ALL : "$(OUTDIR)\Socket.dll" + +CLEAN : + -@erase ".\debug\vc40.pdb" + -@erase ".\debug\vc40.idb" + -@erase ".\debug\Socket.dll" + -@erase ".\debug\Socket.obj" + -@erase ".\debug\Socket.ilk" + -@erase ".\debug\Socket.lib" + -@erase ".\debug\Socket.exp" + -@erase ".\debug\Socket.pdb" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +# ADD BASE CPP /nologo /MTd /W3 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MTd /W3 /Gm /Zi /Od /I ".\include" /I "." /I ".." /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +CPP_PROJ=/nologo /MTd /W3 /Gm /Zi /Od /I ".\include" /I "." /I ".." /D\ + "WIN32" /D "_DEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/Socket.pch" /YX /Fo"$(INTDIR)/"\ + /Fd"$(INTDIR)/" /c +CPP_OBJS=.\debug/ +CPP_SBRS= +# ADD BASE MTL /nologo /D "_DEBUG" /win32 +# ADD MTL /nologo /D "_DEBUG" /win32 +MTL_PROJ=/nologo /D "_DEBUG" /win32 +# ADD BASE RSC /l 0x409 /d "_DEBUG" +# ADD RSC /l 0x409 /d "_DEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +BSC32_FLAGS=/nologo /o"$(OUTDIR)/Socket.bsc" +BSC32_SBRS= +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:windows /dll /debug /machine:I386 +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:windows /dll /debug /machine:I386 +LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ + advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo\ + /subsystem:windows /dll /incremental:yes /pdb:"$(OUTDIR)/Socket.pdb" /debug\ + /machine:I386 /def:".\Socket.def" /out:"$(OUTDIR)/Socket.dll"\ + /implib:"$(OUTDIR)/Socket.lib" +DEF_FILE= \ + ".\Socket.def" +LINK32_OBJS= \ + "$(INTDIR)/Socket.obj" \ + "..\perl.lib" + +"$(OUTDIR)\Socket.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) + $(LINK32) @<< + $(LINK32_FLAGS) $(LINK32_OBJS) +<< + +!ENDIF + +.c{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.cpp{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.cxx{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.c{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +.cpp{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +.cxx{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +################################################################################ +# Begin Target + +# Name "Socket - Win32 Release" +# Name "Socket - Win32 Debug" + +!IF "$(CFG)" == "Socket - Win32 Release" + +!ELSEIF "$(CFG)" == "Socket - Win32 Debug" + +!ENDIF + +################################################################################ +# Begin Source File + +SOURCE=..\ext\Socket\Socket.c +DEP_CPP_SOCKE=\ + ".\EXTERN.h"\ + ".\..\perl.h"\ + ".\..\XSUB.h"\ + "$(INCLUDE)\sys\Types.h"\ + ".\include\sys/socket.h"\ + ".\include\netdb.h"\ + ".\include\arpa/inet.h"\ + ".\..\embed.h"\ + ".\config.h"\ + ".\..\perlio.h"\ + "$(INCLUDE)\sys\Stat.h"\ + ".\include\dirent.h"\ + ".\..\handy.h"\ + ".\..\dosish.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\unixish.h"\ + ".\..\regexp.h"\ + ".\..\sv.h"\ + ".\..\util.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\cv.h"\ + ".\..\opcode.h"\ + ".\..\op.h"\ + ".\..\cop.h"\ + ".\..\av.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\scope.h"\ + ".\..\perly.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\win32.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\nostdio.h"\ + +NODEP_CPP_SOCKE=\ + ".\..\ext\Socket\sockadapt.h"\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\Socket.obj" : $(SOURCE) $(DEP_CPP_SOCKE) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\perl.lib + +!IF "$(CFG)" == "Socket - Win32 Release" + +!ELSEIF "$(CFG)" == "Socket - Win32 Debug" + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=.\Socket.def + +!IF "$(CFG)" == "Socket - Win32 Release" + +!ELSEIF "$(CFG)" == "Socket - Win32 Debug" + +!ENDIF + +# End Source File +# End Target +# End Project +################################################################################ diff --git a/win32/VC-2.0/libperl.mak b/win32/VC-2.0/libperl.mak new file mode 100644 index 0000000000..ab94be02e4 --- /dev/null +++ b/win32/VC-2.0/libperl.mak @@ -0,0 +1,2217 @@ +# Microsoft Developer Studio Generated NMAKE File, Format Version 4.20 +# ** DO NOT EDIT ** + +# TARGTYPE "Win32 (x86) Static Library" 0x0104 + +!IF "$(CFG)" == "" +CFG=libperl - Win32 Debug +!MESSAGE No configuration specified. Defaulting to libperl - Win32 Debug. +!ENDIF + +!IF "$(CFG)" != "libperl - Win32 Release" && "$(CFG)" !=\ + "libperl - Win32 Debug" +!MESSAGE Invalid configuration "$(CFG)" specified. +!MESSAGE You can specify a configuration when running NMAKE on this makefile +!MESSAGE by defining the macro CFG on the command line. For example: +!MESSAGE +!MESSAGE NMAKE /f "libperl.mak" CFG="libperl - Win32 Debug" +!MESSAGE +!MESSAGE Possible choices for configuration are: +!MESSAGE +!MESSAGE "libperl - Win32 Release" (based on "Win32 (x86) Static Library") +!MESSAGE "libperl - Win32 Debug" (based on "Win32 (x86) Static Library") +!MESSAGE +!ERROR An invalid configuration is specified. +!ENDIF + +!IF "$(OS)" == "Windows_NT" +NULL= +!ELSE +NULL=nul +!ENDIF +################################################################################ +# Begin Project +# PROP Target_Last_Scanned "libperl - Win32 Debug" +CPP=cl.exe + +!IF "$(CFG)" == "libperl - Win32 Release" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 0 +# PROP BASE Output_Dir "Release" +# PROP BASE Intermediate_Dir "Release" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 0 +# PROP Output_Dir "../" +# PROP Intermediate_Dir "Release" +# PROP Target_Dir "" +OUTDIR=.\.. +INTDIR=.\Release + +ALL : "$(OUTDIR)\libperl.lib" + +CLEAN : + -@erase "$(INTDIR)\av.obj" + -@erase "$(INTDIR)\deb.obj" + -@erase "$(INTDIR)\doio.obj" + -@erase "$(INTDIR)\doop.obj" + -@erase "$(INTDIR)\dump.obj" + -@erase "$(INTDIR)\globals.obj" + -@erase "$(INTDIR)\gv.obj" + -@erase "$(INTDIR)\hv.obj" + -@erase "$(INTDIR)\mg.obj" + -@erase "$(INTDIR)\op.obj" + -@erase "$(INTDIR)\perl.obj" + -@erase "$(INTDIR)\perlio.obj" + -@erase "$(INTDIR)\perly.obj" + -@erase "$(INTDIR)\pp.obj" + -@erase "$(INTDIR)\pp_ctl.obj" + -@erase "$(INTDIR)\pp_hot.obj" + -@erase "$(INTDIR)\pp_sys.obj" + -@erase "$(INTDIR)\regcomp.obj" + -@erase "$(INTDIR)\regexec.obj" + -@erase "$(INTDIR)\run.obj" + -@erase "$(INTDIR)\scope.obj" + -@erase "$(INTDIR)\sv.obj" + -@erase "$(INTDIR)\taint.obj" + -@erase "$(INTDIR)\toke.obj" + -@erase "$(INTDIR)\universal.obj" + -@erase "$(INTDIR)\util.obj" + -@erase "$(OUTDIR)\libperl.lib" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +"$(INTDIR)" : + if not exist "$(INTDIR)/$(NULL)" mkdir "$(INTDIR)" + +# ADD BASE CPP /nologo /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MT /W3 /Od /I ".\include" /I ".." /I "." /D "WIN32" /D "NDEBUG" /D "PERLDLL" /D "_WINDOWS" /YX /c +CPP_PROJ=/nologo /MT /W3 /Od /I ".\include" /I ".." /I "." /D "WIN32" /D\ + "NDEBUG" /D "PERLDLL" /D "_WINDOWS" /Fp"$(INTDIR)/libperl.pch" /YX\ + /Fo"$(INTDIR)/" /c +CPP_OBJS=.\Release/ +CPP_SBRS=.\. +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +BSC32_FLAGS=/nologo /o"$(OUTDIR)/libperl.bsc" +BSC32_SBRS= \ + +LIB32=link.exe -lib +# ADD BASE LIB32 /nologo +# ADD LIB32 /nologo +LIB32_FLAGS=/nologo /out:"$(OUTDIR)/libperl.lib" +LIB32_OBJS= \ + "$(INTDIR)\av.obj" \ + "$(INTDIR)\deb.obj" \ + "$(INTDIR)\doio.obj" \ + "$(INTDIR)\doop.obj" \ + "$(INTDIR)\dump.obj" \ + "$(INTDIR)\globals.obj" \ + "$(INTDIR)\gv.obj" \ + "$(INTDIR)\hv.obj" \ + "$(INTDIR)\mg.obj" \ + "$(INTDIR)\op.obj" \ + "$(INTDIR)\perl.obj" \ + "$(INTDIR)\perlio.obj" \ + "$(INTDIR)\perly.obj" \ + "$(INTDIR)\pp.obj" \ + "$(INTDIR)\pp_ctl.obj" \ + "$(INTDIR)\pp_hot.obj" \ + "$(INTDIR)\pp_sys.obj" \ + "$(INTDIR)\regcomp.obj" \ + "$(INTDIR)\regexec.obj" \ + "$(INTDIR)\run.obj" \ + "$(INTDIR)\scope.obj" \ + "$(INTDIR)\sv.obj" \ + "$(INTDIR)\taint.obj" \ + "$(INTDIR)\toke.obj" \ + "$(INTDIR)\universal.obj" \ + "$(INTDIR)\util.obj" + +"$(OUTDIR)\libperl.lib" : "$(OUTDIR)" $(DEF_FILE) $(LIB32_OBJS) + $(LIB32) @<< + $(LIB32_FLAGS) $(DEF_FLAGS) $(LIB32_OBJS) +<< + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 1 +# PROP BASE Output_Dir "Debug" +# PROP BASE Intermediate_Dir "Debug" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 1 +# PROP Output_Dir ".." +# PROP Intermediate_Dir "Debug" +# PROP Target_Dir "" +OUTDIR=.\.. +INTDIR=.\Debug + +ALL : "$(OUTDIR)\libperl.lib" + +CLEAN : + -@erase "$(INTDIR)\av.obj" + -@erase "$(INTDIR)\deb.obj" + -@erase "$(INTDIR)\doio.obj" + -@erase "$(INTDIR)\doop.obj" + -@erase "$(INTDIR)\dump.obj" + -@erase "$(INTDIR)\globals.obj" + -@erase "$(INTDIR)\gv.obj" + -@erase "$(INTDIR)\hv.obj" + -@erase "$(INTDIR)\mg.obj" + -@erase "$(INTDIR)\op.obj" + -@erase "$(INTDIR)\perl.obj" + -@erase "$(INTDIR)\perlio.obj" + -@erase "$(INTDIR)\perly.obj" + -@erase "$(INTDIR)\pp.obj" + -@erase "$(INTDIR)\pp_ctl.obj" + -@erase "$(INTDIR)\pp_hot.obj" + -@erase "$(INTDIR)\pp_sys.obj" + -@erase "$(INTDIR)\regcomp.obj" + -@erase "$(INTDIR)\regexec.obj" + -@erase "$(INTDIR)\run.obj" + -@erase "$(INTDIR)\scope.obj" + -@erase "$(INTDIR)\sv.obj" + -@erase "$(INTDIR)\taint.obj" + -@erase "$(INTDIR)\toke.obj" + -@erase "$(INTDIR)\universal.obj" + -@erase "$(INTDIR)\util.obj" + -@erase "$(OUTDIR)\libperl.lib" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +"$(INTDIR)" : + if not exist "$(INTDIR)/$(NULL)" mkdir "$(INTDIR)" + +# ADD BASE CPP /nologo /W3 /Z7 /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MTd /W3 /Z7 /Od /I ".\include" /I ".." /I "." /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +CPP_PROJ=/nologo /MTd /W3 /Z7 /Od /I ".\include" /I ".." /I "." /D "WIN32"\ + /D "_DEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/libperl.pch" /YX /Fo"$(INTDIR)/" /c +CPP_OBJS=.\Debug/ +CPP_SBRS=.\. +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +BSC32_FLAGS=/nologo /o"$(OUTDIR)/libperl.bsc" +BSC32_SBRS= \ + +LIB32=link.exe -lib +# ADD BASE LIB32 /nologo +# ADD LIB32 /nologo +LIB32_FLAGS=/nologo /out:"$(OUTDIR)/libperl.lib" +LIB32_OBJS= \ + "$(INTDIR)\av.obj" \ + "$(INTDIR)\deb.obj" \ + "$(INTDIR)\doio.obj" \ + "$(INTDIR)\doop.obj" \ + "$(INTDIR)\dump.obj" \ + "$(INTDIR)\globals.obj" \ + "$(INTDIR)\gv.obj" \ + "$(INTDIR)\hv.obj" \ + "$(INTDIR)\mg.obj" \ + "$(INTDIR)\op.obj" \ + "$(INTDIR)\perl.obj" \ + "$(INTDIR)\perlio.obj" \ + "$(INTDIR)\perly.obj" \ + "$(INTDIR)\pp.obj" \ + "$(INTDIR)\pp_ctl.obj" \ + "$(INTDIR)\pp_hot.obj" \ + "$(INTDIR)\pp_sys.obj" \ + "$(INTDIR)\regcomp.obj" \ + "$(INTDIR)\regexec.obj" \ + "$(INTDIR)\run.obj" \ + "$(INTDIR)\scope.obj" \ + "$(INTDIR)\sv.obj" \ + "$(INTDIR)\taint.obj" \ + "$(INTDIR)\toke.obj" \ + "$(INTDIR)\universal.obj" \ + "$(INTDIR)\util.obj" + +"$(OUTDIR)\libperl.lib" : "$(OUTDIR)" $(DEF_FILE) $(LIB32_OBJS) + $(LIB32) @<< + $(LIB32_FLAGS) $(DEF_FLAGS) $(LIB32_OBJS) +<< + +!ENDIF + +.c{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.cpp{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.cxx{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.c{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +.cpp{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +.cxx{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +################################################################################ +# Begin Target + +# Name "libperl - Win32 Release" +# Name "libperl - Win32 Debug" + +!IF "$(CFG)" == "libperl - Win32 Release" + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +!ENDIF + +################################################################################ +# Begin Source File + +SOURCE=..\av.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_AV_C0=\ + "..\EXTERN.h"\ + ".\..\perl.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\av.obj" : $(SOURCE) $(DEP_CPP_AV_C0) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_AV_C0=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_AV_C0=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\av.obj" : $(SOURCE) $(DEP_CPP_AV_C0) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\deb.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_DEB_C=\ + "..\EXTERN.h"\ + ".\..\perl.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\deb.obj" : $(SOURCE) $(DEP_CPP_DEB_C) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_DEB_C=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_DEB_C=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\deb.obj" : $(SOURCE) $(DEP_CPP_DEB_C) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\doio.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_DOIO_=\ + "..\EXTERN.h"\ + ".\..\perl.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\doio.obj" : $(SOURCE) $(DEP_CPP_DOIO_) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_DOIO_=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_DOIO_=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\doio.obj" : $(SOURCE) $(DEP_CPP_DOIO_) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\doop.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_DOOP_=\ + "..\EXTERN.h"\ + ".\..\perl.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\doop.obj" : $(SOURCE) $(DEP_CPP_DOOP_) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_DOOP_=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_DOOP_=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\doop.obj" : $(SOURCE) $(DEP_CPP_DOOP_) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\dump.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_DUMP_=\ + "..\EXTERN.h"\ + ".\..\perl.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\dump.obj" : $(SOURCE) $(DEP_CPP_DUMP_) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_DUMP_=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_DUMP_=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\dump.obj" : $(SOURCE) $(DEP_CPP_DUMP_) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\globals.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_GLOBA=\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\INTERN.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_GLOBA=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\globals.obj" : $(SOURCE) $(DEP_CPP_GLOBA) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_GLOBA=\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\INTERN.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_GLOBA=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\globals.obj" : $(SOURCE) $(DEP_CPP_GLOBA) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\gv.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_GV_Cc=\ + "..\EXTERN.h"\ + ".\..\perl.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\gv.obj" : $(SOURCE) $(DEP_CPP_GV_Cc) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_GV_Cc=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_GV_Cc=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\gv.obj" : $(SOURCE) $(DEP_CPP_GV_Cc) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\hv.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_HV_Ce=\ + "..\EXTERN.h"\ + ".\..\perl.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\hv.obj" : $(SOURCE) $(DEP_CPP_HV_Ce) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_HV_Ce=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_HV_Ce=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\hv.obj" : $(SOURCE) $(DEP_CPP_HV_Ce) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\mg.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_MG_C10=\ + "..\EXTERN.h"\ + ".\..\perl.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\mg.obj" : $(SOURCE) $(DEP_CPP_MG_C10) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_MG_C10=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_MG_C10=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\mg.obj" : $(SOURCE) $(DEP_CPP_MG_C10) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\op.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_OP_C12=\ + "..\EXTERN.h"\ + ".\..\perl.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\op.obj" : $(SOURCE) $(DEP_CPP_OP_C12) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_OP_C12=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_OP_C12=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\op.obj" : $(SOURCE) $(DEP_CPP_OP_C12) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\perl.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_PERL_=\ + "..\EXTERN.h"\ + ".\..\patchlevel.h"\ + ".\..\perl.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\perl.obj" : $(SOURCE) $(DEP_CPP_PERL_) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_PERL_=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\patchlevel.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_PERL_=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\perl.obj" : $(SOURCE) $(DEP_CPP_PERL_) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\perlio.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_PERLI=\ + "..\EXTERN.h"\ + ".\..\perl.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\perlio.obj" : $(SOURCE) $(DEP_CPP_PERLI) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_PERLI=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_PERLI=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\perlio.obj" : $(SOURCE) $(DEP_CPP_PERLI) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\perly.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_PERLY=\ + "..\EXTERN.h"\ + ".\..\perl.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\perly.obj" : $(SOURCE) $(DEP_CPP_PERLY) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_PERLY=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_PERLY=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\perly.obj" : $(SOURCE) $(DEP_CPP_PERLY) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\pp.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_PP_C1a=\ + "..\EXTERN.h"\ + ".\..\perl.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\pp.obj" : $(SOURCE) $(DEP_CPP_PP_C1a) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_PP_C1a=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_PP_C1a=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\pp.obj" : $(SOURCE) $(DEP_CPP_PP_C1a) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\pp_ctl.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_PP_CT=\ + "..\EXTERN.h"\ + ".\..\perl.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\pp_ctl.obj" : $(SOURCE) $(DEP_CPP_PP_CT) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_PP_CT=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_PP_CT=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\pp_ctl.obj" : $(SOURCE) $(DEP_CPP_PP_CT) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\pp_hot.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_PP_HO=\ + "..\EXTERN.h"\ + ".\..\perl.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\pp_hot.obj" : $(SOURCE) $(DEP_CPP_PP_HO) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_PP_HO=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_PP_HO=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\pp_hot.obj" : $(SOURCE) $(DEP_CPP_PP_HO) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\pp_sys.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_PP_SY=\ + "..\EXTERN.h"\ + ".\..\perl.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\pp_sys.obj" : $(SOURCE) $(DEP_CPP_PP_SY) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_PP_SY=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_PP_SY=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\pp_sys.obj" : $(SOURCE) $(DEP_CPP_PP_SY) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\regcomp.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_REGCO=\ + "..\EXTERN.h"\ + ".\..\INTERN.h"\ + ".\..\perl.h"\ + ".\..\regcomp.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\regcomp.obj" : $(SOURCE) $(DEP_CPP_REGCO) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_REGCO=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\INTERN.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regcomp.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_REGCO=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\regcomp.obj" : $(SOURCE) $(DEP_CPP_REGCO) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\regexec.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_REGEX=\ + "..\EXTERN.h"\ + ".\..\perl.h"\ + ".\..\regcomp.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\regexec.obj" : $(SOURCE) $(DEP_CPP_REGEX) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_REGEX=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regcomp.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_REGEX=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\regexec.obj" : $(SOURCE) $(DEP_CPP_REGEX) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\run.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_RUN_C=\ + "..\EXTERN.h"\ + ".\..\perl.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\run.obj" : $(SOURCE) $(DEP_CPP_RUN_C) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_RUN_C=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_RUN_C=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\run.obj" : $(SOURCE) $(DEP_CPP_RUN_C) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\scope.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_SCOPE=\ + "..\EXTERN.h"\ + ".\..\perl.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\scope.obj" : $(SOURCE) $(DEP_CPP_SCOPE) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_SCOPE=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_SCOPE=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\scope.obj" : $(SOURCE) $(DEP_CPP_SCOPE) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\sv.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_SV_C2a=\ + "..\EXTERN.h"\ + ".\..\perl.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\sv.obj" : $(SOURCE) $(DEP_CPP_SV_C2a) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_SV_C2a=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_SV_C2a=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\sv.obj" : $(SOURCE) $(DEP_CPP_SV_C2a) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\taint.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_TAINT=\ + "..\EXTERN.h"\ + ".\..\perl.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\taint.obj" : $(SOURCE) $(DEP_CPP_TAINT) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_TAINT=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_TAINT=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\taint.obj" : $(SOURCE) $(DEP_CPP_TAINT) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\toke.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_TOKE_=\ + "..\EXTERN.h"\ + ".\..\keywords.h"\ + ".\..\perl.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\toke.obj" : $(SOURCE) $(DEP_CPP_TOKE_) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_TOKE_=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\keywords.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_TOKE_=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\toke.obj" : $(SOURCE) $(DEP_CPP_TOKE_) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\universal.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_UNIVE=\ + "..\EXTERN.h"\ + ".\..\perl.h"\ + ".\..\XSUB.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\universal.obj" : $(SOURCE) $(DEP_CPP_UNIVE) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_UNIVE=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\..\XSUB.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_UNIVE=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\universal.obj" : $(SOURCE) $(DEP_CPP_UNIVE) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\util.c + +!IF "$(CFG)" == "libperl - Win32 Release" + +DEP_CPP_UTIL_=\ + "..\EXTERN.h"\ + ".\..\perl.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\util.obj" : $(SOURCE) $(DEP_CPP_UTIL_) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "libperl - Win32 Debug" + +DEP_CPP_UTIL_=\ + "..\EXTERN.h"\ + ".\..\av.h"\ + ".\..\cop.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\hv.h"\ + ".\..\mg.h"\ + ".\..\nostdio.h"\ + ".\..\op.h"\ + ".\..\opcode.h"\ + ".\..\perl.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\perly.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\pp.h"\ + ".\..\proto.h"\ + ".\..\regexp.h"\ + ".\..\scope.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_UTIL_=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\util.obj" : $(SOURCE) $(DEP_CPP_UTIL_) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +# End Target +# End Project +################################################################################ diff --git a/win32/VC-2.0/miniperl.mak b/win32/VC-2.0/miniperl.mak new file mode 100644 index 0000000000..3fce97fde1 --- /dev/null +++ b/win32/VC-2.0/miniperl.mak @@ -0,0 +1,393 @@ +# Microsoft Developer Studio Generated NMAKE File, Format Version 4.20 +# ** DO NOT EDIT ** + +# TARGTYPE "Win32 (x86) Console Application" 0x0103 + +!IF "$(CFG)" == "" +CFG=miniperl - Win32 Debug +!MESSAGE No configuration specified. Defaulting to miniperl - Win32 Debug. +!ENDIF + +!IF "$(CFG)" != "miniperl - Win32 Release" && "$(CFG)" !=\ + "miniperl - Win32 Debug" +!MESSAGE Invalid configuration "$(CFG)" specified. +!MESSAGE You can specify a configuration when running NMAKE on this makefile +!MESSAGE by defining the macro CFG on the command line. For example: +!MESSAGE +!MESSAGE NMAKE /f "miniperl.mak" CFG="miniperl - Win32 Debug" +!MESSAGE +!MESSAGE Possible choices for configuration are: +!MESSAGE +!MESSAGE "miniperl - Win32 Release" (based on\ + "Win32 (x86) Console Application") +!MESSAGE "miniperl - Win32 Debug" (based on "Win32 (x86) Console Application") +!MESSAGE +!ERROR An invalid configuration is specified. +!ENDIF + +!IF "$(OS)" == "Windows_NT" +NULL= +!ELSE +NULL=nul +!ENDIF +################################################################################ +# Begin Project +# PROP Target_Last_Scanned "miniperl - Win32 Debug" +CPP=cl.exe +RSC=rc.exe + +!IF "$(CFG)" == "miniperl - Win32 Release" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 0 +# PROP BASE Output_Dir "miniperl" +# PROP BASE Intermediate_Dir "miniperl" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 0 +# PROP Output_Dir "Release" +# PROP Intermediate_Dir "Release" +# PROP Target_Dir "" +OUTDIR=.\Release +INTDIR=.\Release + +ALL : "..\miniperl.exe" + +CLEAN : + -@erase "$(INTDIR)\miniperlmain.obj" + -@erase "$(INTDIR)\win32.obj" + -@erase "$(INTDIR)\win32aux.obj" + -@erase "$(INTDIR)\win32io.obj" + -@erase "$(INTDIR)\win32sck.obj" + -@erase "..\miniperl.exe" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +# ADD BASE CPP /nologo /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /YX /c +# ADD CPP /nologo /MT /W3 /Od /I "." /I ".\include" /I ".." /D "NDEBUG" /D "WIN32" /D "_CONSOLE" /D "PERLDLL" /YX /c +CPP_PROJ=/nologo /MT /W3 /Od /I "." /I ".\include" /I ".." /D "NDEBUG" /D\ + "WIN32" /D "_CONSOLE" /D "PERLDLL" /Fp"$(INTDIR)/miniperl.pch" /YX\ + /Fo"$(INTDIR)/" /c +CPP_OBJS=.\Release/ +CPP_SBRS=.\. +# ADD BASE RSC /l 0x409 /d "NDEBUG" +# ADD RSC /l 0x409 /d "NDEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +BSC32_FLAGS=/nologo /o"$(OUTDIR)/miniperl.bsc" +BSC32_SBRS= \ + +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:console /machine:I386 +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:console /machine:I386 /out:"../miniperl.exe" +# SUBTRACT LINK32 /incremental:yes /debug +LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ + advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo\ + /subsystem:console /incremental:no /pdb:"$(OUTDIR)/miniperl.pdb" /machine:I386\ + /out:"../miniperl.exe" +LINK32_OBJS= \ + "$(INTDIR)\miniperlmain.obj" \ + "$(INTDIR)\win32.obj" \ + "$(INTDIR)\win32aux.obj" \ + "$(INTDIR)\win32io.obj" \ + "$(INTDIR)\win32sck.obj" \ + "..\libperl.lib" + +"..\miniperl.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) + $(LINK32) @<< + $(LINK32_FLAGS) $(LINK32_OBJS) +<< + +!ELSEIF "$(CFG)" == "miniperl - Win32 Debug" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 1 +# PROP BASE Output_Dir "miniper0" +# PROP BASE Intermediate_Dir "miniper0" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 1 +# PROP Output_Dir "Debug" +# PROP Intermediate_Dir "Debug" +# PROP Target_Dir "" +OUTDIR=.\Debug +INTDIR=.\Debug + +ALL : "..\miniperl.exe" + +CLEAN : + -@erase "$(INTDIR)\miniperlmain.obj" + -@erase "$(INTDIR)\vc40.idb" + -@erase "$(INTDIR)\vc40.pdb" + -@erase "$(INTDIR)\win32.obj" + -@erase "$(INTDIR)\win32aux.obj" + -@erase "$(INTDIR)\win32io.obj" + -@erase "$(INTDIR)\win32sck.obj" + -@erase "$(OUTDIR)\miniperl.pdb" + -@erase "..\miniperl.exe" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +# ADD BASE CPP /nologo /W3 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c +# ADD CPP /nologo /MTd /W3 /Gm /Zi /Od /I "." /I ".\include" /I ".." /D "_DEBUG" /D "WIN32" /D "_CONSOLE" /D "PERLDLL" /YX /c +CPP_PROJ=/nologo /MTd /W3 /Gm /Zi /Od /I "." /I ".\include" /I ".." /D\ + "_DEBUG" /D "WIN32" /D "_CONSOLE" /D "PERLDLL" /Fp"$(INTDIR)/miniperl.pch" /YX\ + /Fo"$(INTDIR)/" /Fd"$(INTDIR)/" /c +CPP_OBJS=.\Debug/ +CPP_SBRS=.\. +# ADD BASE RSC /l 0x409 /d "_DEBUG" +# ADD RSC /l 0x409 /d "_DEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +BSC32_FLAGS=/nologo /o"$(OUTDIR)/miniperl.bsc" +BSC32_SBRS= \ + +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:console /debug /machine:I386 +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:console /incremental:no /debug /machine:I386 /out:"../miniperl.exe" +LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ + advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo\ + /subsystem:console /incremental:no /pdb:"$(OUTDIR)/miniperl.pdb" /debug\ + /machine:I386 /out:"../miniperl.exe" +LINK32_OBJS= \ + "$(INTDIR)\miniperlmain.obj" \ + "$(INTDIR)\win32.obj" \ + "$(INTDIR)\win32aux.obj" \ + "$(INTDIR)\win32io.obj" \ + "$(INTDIR)\win32sck.obj" \ + "..\libperl.lib" + +"..\miniperl.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) + $(LINK32) @<< + $(LINK32_FLAGS) $(LINK32_OBJS) +<< + +!ENDIF + +.c{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.cpp{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.cxx{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.c{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +.cpp{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +.cxx{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +################################################################################ +# Begin Target + +# Name "miniperl - Win32 Release" +# Name "miniperl - Win32 Debug" + +!IF "$(CFG)" == "miniperl - Win32 Release" + +!ELSEIF "$(CFG)" == "miniperl - Win32 Debug" + +!ENDIF + +################################################################################ +# Begin Source File + +SOURCE=..\miniperlmain.c +DEP_CPP_MINIP=\ + "..\av.h"\ + "..\cop.h"\ + "..\hv.h"\ + "..\mg.h"\ + "..\op.h"\ + "..\opcode.h"\ + "..\perl.h"\ + "..\perly.h"\ + "..\pp.h"\ + "..\proto.h"\ + "..\scope.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\EXTERN.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\nostdio.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\regexp.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_MINIP=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\miniperlmain.obj" : $(SOURCE) $(DEP_CPP_MINIP) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\libperl.lib + +!IF "$(CFG)" == "miniperl - Win32 Release" + +!ELSEIF "$(CFG)" == "miniperl - Win32 Debug" + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=.\win32.c +DEP_CPP_WIN32=\ + "..\av.h"\ + "..\cop.h"\ + "..\hv.h"\ + "..\mg.h"\ + "..\op.h"\ + "..\opcode.h"\ + "..\perl.h"\ + "..\perly.h"\ + "..\pp.h"\ + "..\proto.h"\ + "..\scope.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\nostdio.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\regexp.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\EXTERN.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_WIN32=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\win32.obj" : $(SOURCE) $(DEP_CPP_WIN32) "$(INTDIR)" + + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=.\win32sck.c +DEP_CPP_WIN32S=\ + "..\av.h"\ + "..\cop.h"\ + "..\hv.h"\ + "..\mg.h"\ + "..\op.h"\ + "..\opcode.h"\ + "..\perl.h"\ + "..\perly.h"\ + "..\pp.h"\ + "..\proto.h"\ + "..\scope.h"\ + ".\..\cv.h"\ + ".\..\dosish.h"\ + ".\..\embed.h"\ + ".\..\form.h"\ + ".\..\gv.h"\ + ".\..\handy.h"\ + ".\..\nostdio.h"\ + ".\..\perlio.h"\ + ".\..\perlsdio.h"\ + ".\..\perlsfio.h"\ + ".\..\plan9\plan9ish.h"\ + ".\..\regexp.h"\ + ".\..\sv.h"\ + ".\..\unixish.h"\ + ".\..\util.h"\ + ".\config.h"\ + ".\EXTERN.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + +NODEP_CPP_WIN32S=\ + ".\..\os2ish.h"\ + ".\..\vmsish.h"\ + + +"$(INTDIR)\win32sck.obj" : $(SOURCE) $(DEP_CPP_WIN32S) "$(INTDIR)" + + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=.\win32aux.c +DEP_CPP_WIN32A=\ + ".\include\sys/socket.h"\ + + +"$(INTDIR)\win32aux.obj" : $(SOURCE) $(DEP_CPP_WIN32A) "$(INTDIR)" + + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=.\win32io.c +DEP_CPP_WIN32I=\ + ".\include\sys/socket.h"\ + ".\win32io.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + + +"$(INTDIR)\win32io.obj" : $(SOURCE) $(DEP_CPP_WIN32I) "$(INTDIR)" + + +# End Source File +# End Target +# End Project +################################################################################ diff --git a/win32/VC-2.0/modules.mak b/win32/VC-2.0/modules.mak new file mode 100644 index 0000000000..198ca3120f --- /dev/null +++ b/win32/VC-2.0/modules.mak @@ -0,0 +1,828 @@ +# Microsoft Developer Studio Generated NMAKE File, Format Version 4.20 +# ** DO NOT EDIT ** + +# TARGTYPE "Win32 (x86) Static Library" 0x0104 + +!IF "$(CFG)" == "" +CFG=modules - Win32 Debug +!MESSAGE No configuration specified. Defaulting to modules - Win32 Debug. +!ENDIF + +!IF "$(CFG)" != "modules - Win32 Release" && "$(CFG)" !=\ + "modules - Win32 Debug" +!MESSAGE Invalid configuration "$(CFG)" specified. +!MESSAGE You can specify a configuration when running NMAKE on this makefile +!MESSAGE by defining the macro CFG on the command line. For example: +!MESSAGE +!MESSAGE NMAKE /f "modules.mak" CFG="modules - Win32 Debug" +!MESSAGE +!MESSAGE Possible choices for configuration are: +!MESSAGE +!MESSAGE "modules - Win32 Release" (based on "Win32 (x86) Static Library") +!MESSAGE "modules - Win32 Debug" (based on "Win32 (x86) Static Library") +!MESSAGE +!ERROR An invalid configuration is specified. +!ENDIF + +!IF "$(OS)" == "Windows_NT" +NULL= +!ELSE +NULL=nul +!ENDIF +################################################################################ +# Begin Project +# PROP Target_Last_Scanned "modules - Win32 Debug" +CPP=cl.exe + +!IF "$(CFG)" == "modules - Win32 Release" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 0 +# PROP BASE Output_Dir "modules_" +# PROP BASE Intermediate_Dir "modules_" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 0 +# PROP Output_Dir "Release" +# PROP Intermediate_Dir "Release" +# PROP Target_Dir "" +OUTDIR=.\Release +INTDIR=.\Release + +ALL : ".\modules.lib" + +CLEAN : + -@erase "$(INTDIR)\Dynaloader.obj" + -@erase ".\modules.lib" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +# ADD BASE CPP /nologo /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" /YX /c +CPP_PROJ=/nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "NDEBUG" /D\ + "WIN32" /D "_WINDOWS" /D "MSDOS" /Fp"$(INTDIR)/modules.pch" /YX /Fo"$(INTDIR)/"\ + /c +CPP_OBJS=.\Release/ +CPP_SBRS=.\. +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +BSC32_FLAGS=/nologo /o"$(OUTDIR)/modules.bsc" +BSC32_SBRS= \ + +LIB32=link.exe -lib +# ADD BASE LIB32 /nologo +# ADD LIB32 /nologo /out:"modules.lib" +LIB32_FLAGS=/nologo /out:"modules.lib" +LIB32_OBJS= \ + "$(INTDIR)\Dynaloader.obj" + +".\modules.lib" : "$(OUTDIR)" $(DEF_FILE) $(LIB32_OBJS) + $(LIB32) @<< + $(LIB32_FLAGS) $(DEF_FLAGS) $(LIB32_OBJS) +<< + +!ELSEIF "$(CFG)" == "modules - Win32 Debug" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 1 +# PROP BASE Output_Dir "modules0" +# PROP BASE Intermediate_Dir "modules0" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 1 +# PROP Output_Dir "Debug" +# PROP Intermediate_Dir "Debug" +# PROP Target_Dir "" +OUTDIR=.\Debug +INTDIR=.\Debug + +ALL : ".\modules.lib" + +CLEAN : + -@erase "$(INTDIR)\Dynaloader.obj" + -@erase ".\modules.lib" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +# ADD BASE CPP /nologo /W3 /Z7 /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MTd /W3 /Z7 /Od /I ".\include" /I "." /I ".." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" /YX /c +CPP_PROJ=/nologo /MTd /W3 /Z7 /Od /I ".\include" /I "." /I ".." /D "_DEBUG"\ + /D "WIN32" /D "_WINDOWS" /D "MSDOS" /Fp"$(INTDIR)/modules.pch" /YX\ + /Fo"$(INTDIR)/" /c +CPP_OBJS=.\Debug/ +CPP_SBRS=.\. +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +BSC32_FLAGS=/nologo /o"$(OUTDIR)/modules.bsc" +BSC32_SBRS= \ + +LIB32=link.exe -lib +# ADD BASE LIB32 /nologo +# ADD LIB32 /nologo /out:"modules.lib" +LIB32_FLAGS=/nologo /out:"modules.lib" +LIB32_OBJS= \ + "$(INTDIR)\Dynaloader.obj" + +".\modules.lib" : "$(OUTDIR)" $(DEF_FILE) $(LIB32_OBJS) + $(LIB32) @<< + $(LIB32_FLAGS) $(DEF_FLAGS) $(LIB32_OBJS) +<< + +!ENDIF + +.c{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.cpp{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.cxx{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.c{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +.cpp{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +.cxx{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +################################################################################ +# Begin Target + +# Name "modules - Win32 Release" +# Name "modules - Win32 Debug" + +!IF "$(CFG)" == "modules - Win32 Release" + +!ELSEIF "$(CFG)" == "modules - Win32 Debug" + +!ENDIF + +################################################################################ +# Begin Source File + +SOURCE=..\ext\DynaLoader\Dynaloader.c + +!IF "$(CFG)" == "modules - Win32 Release" + +DEP_CPP_DYNAL=\ + "..\av.h"\ + "..\cop.h"\ + "..\cv.h"\ + "..\dosish.h"\ + "..\embed.h"\ + "..\form.h"\ + "..\gv.h"\ + "..\handy.h"\ + "..\hv.h"\ + "..\mg.h"\ + "..\nostdio.h"\ + "..\op.h"\ + "..\opcode.h"\ + "..\perl.h"\ + "..\perlio.h"\ + "..\perlsdio.h"\ + "..\perlsfio.h"\ + "..\perly.h"\ + "..\plan9\plan9ish.h"\ + "..\pp.h"\ + "..\proto.h"\ + "..\regexp.h"\ + "..\scope.h"\ + "..\sv.h"\ + "..\unixish.h"\ + "..\util.h"\ + "..\XSUB.h"\ + ".\..\ext\DynaLoader\dlutils.c"\ + ".\config.h"\ + ".\EXTERN.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + "$(INCLUDE)\sys\Stat.h"\ + "$(INCLUDE)\sys\Types.h"\ + +NODEP_CPP_DYNAL=\ + "..\os2ish.h"\ + "..\vmsish.h"\ + + +"$(INTDIR)\Dynaloader.obj" : $(SOURCE) $(DEP_CPP_DYNAL) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "modules - Win32 Debug" + +DEP_CPP_DYNAL=\ + "..\av.h"\ + "..\cop.h"\ + "..\cv.h"\ + "..\dosish.h"\ + "..\embed.h"\ + "..\form.h"\ + "..\gv.h"\ + "..\handy.h"\ + "..\hv.h"\ + "..\mg.h"\ + "..\nostdio.h"\ + "..\op.h"\ + "..\opcode.h"\ + "..\perl.h"\ + "..\perlio.h"\ + "..\perlsdio.h"\ + "..\perlsfio.h"\ + "..\perly.h"\ + "..\plan9\plan9ish.h"\ + "..\pp.h"\ + "..\proto.h"\ + "..\regexp.h"\ + "..\scope.h"\ + "..\sv.h"\ + "..\unixish.h"\ + "..\util.h"\ + "..\XSUB.h"\ + ".\..\ext\DynaLoader\dlutils.c"\ + ".\config.h"\ + ".\EXTERN.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\sys\Stat.h"\ + "$(INCLUDE)\sys\Types.h"\ + +NODEP_CPP_DYNAL=\ + "..\os2ish.h"\ + "..\vmsish.h"\ + + +"$(INTDIR)\Dynaloader.obj" : $(SOURCE) $(DEP_CPP_DYNAL) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\ext\Fcntl\Fcntl.c + +!IF "$(CFG)" == "modules - Win32 Release" + +DEP_CPP_FCNTL=\ + "..\av.h"\ + "..\cop.h"\ + "..\cv.h"\ + "..\dosish.h"\ + "..\embed.h"\ + "..\form.h"\ + "..\gv.h"\ + "..\handy.h"\ + "..\hv.h"\ + "..\mg.h"\ + "..\nostdio.h"\ + "..\op.h"\ + "..\opcode.h"\ + "..\perl.h"\ + "..\perlio.h"\ + "..\perlsdio.h"\ + "..\perlsfio.h"\ + "..\perly.h"\ + "..\plan9\plan9ish.h"\ + "..\pp.h"\ + "..\proto.h"\ + "..\regexp.h"\ + "..\scope.h"\ + "..\sv.h"\ + "..\unixish.h"\ + "..\util.h"\ + "..\XSUB.h"\ + ".\config.h"\ + ".\EXTERN.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + "$(INCLUDE)\sys\Stat.h"\ + "$(INCLUDE)\sys\Types.h"\ + +NODEP_CPP_FCNTL=\ + "..\os2ish.h"\ + "..\vmsish.h"\ + + +"$(INTDIR)\Fcntl.obj" : $(SOURCE) $(DEP_CPP_FCNTL) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "modules - Win32 Debug" + +DEP_CPP_FCNTL=\ + "..\av.h"\ + "..\cop.h"\ + "..\cv.h"\ + "..\dosish.h"\ + "..\embed.h"\ + "..\form.h"\ + "..\gv.h"\ + "..\handy.h"\ + "..\hv.h"\ + "..\mg.h"\ + "..\nostdio.h"\ + "..\op.h"\ + "..\opcode.h"\ + "..\perl.h"\ + "..\perlio.h"\ + "..\perlsdio.h"\ + "..\perlsfio.h"\ + "..\perly.h"\ + "..\plan9\plan9ish.h"\ + "..\pp.h"\ + "..\proto.h"\ + "..\regexp.h"\ + "..\scope.h"\ + "..\sv.h"\ + "..\unixish.h"\ + "..\util.h"\ + "..\XSUB.h"\ + ".\config.h"\ + ".\EXTERN.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\sys\Stat.h"\ + "$(INCLUDE)\sys\Types.h"\ + +NODEP_CPP_FCNTL=\ + "..\os2ish.h"\ + "..\vmsish.h"\ + + +"$(INTDIR)\Fcntl.obj" : $(SOURCE) $(DEP_CPP_FCNTL) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\ext\Io\IO.c + +!IF "$(CFG)" == "modules - Win32 Release" + +DEP_CPP_IO_C4=\ + "..\av.h"\ + "..\cop.h"\ + "..\cv.h"\ + "..\dosish.h"\ + "..\embed.h"\ + "..\form.h"\ + "..\gv.h"\ + "..\handy.h"\ + "..\hv.h"\ + "..\mg.h"\ + "..\nostdio.h"\ + "..\op.h"\ + "..\opcode.h"\ + "..\perl.h"\ + "..\perlio.h"\ + "..\perlsdio.h"\ + "..\perlsfio.h"\ + "..\perly.h"\ + "..\plan9\plan9ish.h"\ + "..\pp.h"\ + "..\proto.h"\ + "..\regexp.h"\ + "..\scope.h"\ + "..\sv.h"\ + "..\unixish.h"\ + "..\util.h"\ + "..\XSUB.h"\ + ".\config.h"\ + ".\EXTERN.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + "$(INCLUDE)\sys\Stat.h"\ + "$(INCLUDE)\sys\Types.h"\ + +NODEP_CPP_IO_C4=\ + "..\os2ish.h"\ + "..\vmsish.h"\ + + +"$(INTDIR)\IO.obj" : $(SOURCE) $(DEP_CPP_IO_C4) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "modules - Win32 Debug" + +DEP_CPP_IO_C4=\ + "..\av.h"\ + "..\cop.h"\ + "..\cv.h"\ + "..\dosish.h"\ + "..\embed.h"\ + "..\form.h"\ + "..\gv.h"\ + "..\handy.h"\ + "..\hv.h"\ + "..\mg.h"\ + "..\nostdio.h"\ + "..\op.h"\ + "..\opcode.h"\ + "..\perl.h"\ + "..\perlio.h"\ + "..\perlsdio.h"\ + "..\perlsfio.h"\ + "..\perly.h"\ + "..\plan9\plan9ish.h"\ + "..\pp.h"\ + "..\proto.h"\ + "..\regexp.h"\ + "..\scope.h"\ + "..\sv.h"\ + "..\unixish.h"\ + "..\util.h"\ + "..\XSUB.h"\ + ".\config.h"\ + ".\EXTERN.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\sys\Stat.h"\ + "$(INCLUDE)\sys\Types.h"\ + +NODEP_CPP_IO_C4=\ + "..\os2ish.h"\ + "..\vmsish.h"\ + + +"$(INTDIR)\IO.obj" : $(SOURCE) $(DEP_CPP_IO_C4) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\ext\Opcode\Opcode.c + +!IF "$(CFG)" == "modules - Win32 Release" + +DEP_CPP_OPCOD=\ + "..\av.h"\ + "..\cop.h"\ + "..\cv.h"\ + "..\dosish.h"\ + "..\embed.h"\ + "..\form.h"\ + "..\gv.h"\ + "..\handy.h"\ + "..\hv.h"\ + "..\mg.h"\ + "..\nostdio.h"\ + "..\op.h"\ + "..\opcode.h"\ + "..\perl.h"\ + "..\perlio.h"\ + "..\perlsdio.h"\ + "..\perlsfio.h"\ + "..\perly.h"\ + "..\plan9\plan9ish.h"\ + "..\pp.h"\ + "..\proto.h"\ + "..\regexp.h"\ + "..\scope.h"\ + "..\sv.h"\ + "..\unixish.h"\ + "..\util.h"\ + "..\XSUB.h"\ + ".\config.h"\ + ".\EXTERN.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + "$(INCLUDE)\sys\Stat.h"\ + "$(INCLUDE)\sys\Types.h"\ + +NODEP_CPP_OPCOD=\ + "..\os2ish.h"\ + "..\vmsish.h"\ + + +"$(INTDIR)\Opcode.obj" : $(SOURCE) $(DEP_CPP_OPCOD) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "modules - Win32 Debug" + +DEP_CPP_OPCOD=\ + "..\av.h"\ + "..\cop.h"\ + "..\cv.h"\ + "..\dosish.h"\ + "..\embed.h"\ + "..\form.h"\ + "..\gv.h"\ + "..\handy.h"\ + "..\hv.h"\ + "..\mg.h"\ + "..\nostdio.h"\ + "..\op.h"\ + "..\opcode.h"\ + "..\perl.h"\ + "..\perlio.h"\ + "..\perlsdio.h"\ + "..\perlsfio.h"\ + "..\perly.h"\ + "..\plan9\plan9ish.h"\ + "..\pp.h"\ + "..\proto.h"\ + "..\regexp.h"\ + "..\scope.h"\ + "..\sv.h"\ + "..\unixish.h"\ + "..\util.h"\ + "..\XSUB.h"\ + ".\config.h"\ + ".\EXTERN.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\sys\Stat.h"\ + "$(INCLUDE)\sys\Types.h"\ + +NODEP_CPP_OPCOD=\ + "..\os2ish.h"\ + "..\vmsish.h"\ + + +"$(INTDIR)\Opcode.obj" : $(SOURCE) $(DEP_CPP_OPCOD) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\ext\SDBM_File\SDBM_File.c +DEP_CPP_SDBM_=\ + "..\av.h"\ + "..\cop.h"\ + "..\cv.h"\ + "..\dosish.h"\ + "..\embed.h"\ + "..\form.h"\ + "..\gv.h"\ + "..\handy.h"\ + "..\hv.h"\ + "..\mg.h"\ + "..\nostdio.h"\ + "..\op.h"\ + "..\opcode.h"\ + "..\perl.h"\ + "..\perlio.h"\ + "..\perlsdio.h"\ + "..\perlsfio.h"\ + "..\perly.h"\ + "..\plan9\plan9ish.h"\ + "..\pp.h"\ + "..\proto.h"\ + "..\regexp.h"\ + "..\scope.h"\ + "..\sv.h"\ + "..\unixish.h"\ + "..\util.h"\ + "..\XSUB.h"\ + ".\..\ext\SDBM_File\sdbm\sdbm.h"\ + ".\config.h"\ + ".\EXTERN.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + "$(INCLUDE)\sys\Stat.h"\ + "$(INCLUDE)\sys\Types.h"\ + +NODEP_CPP_SDBM_=\ + "..\os2ish.h"\ + "..\vmsish.h"\ + + +"$(INTDIR)\SDBM_File.obj" : $(SOURCE) $(DEP_CPP_SDBM_) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\ext\Socket\Socket.c +DEP_CPP_SOCKE=\ + "..\av.h"\ + "..\cop.h"\ + "..\cv.h"\ + "..\dosish.h"\ + "..\embed.h"\ + "..\form.h"\ + "..\gv.h"\ + "..\handy.h"\ + "..\hv.h"\ + "..\mg.h"\ + "..\nostdio.h"\ + "..\op.h"\ + "..\opcode.h"\ + "..\perl.h"\ + "..\perlio.h"\ + "..\perlsdio.h"\ + "..\perlsfio.h"\ + "..\perly.h"\ + "..\plan9\plan9ish.h"\ + "..\pp.h"\ + "..\proto.h"\ + "..\regexp.h"\ + "..\scope.h"\ + "..\sv.h"\ + "..\unixish.h"\ + "..\util.h"\ + "..\XSUB.h"\ + ".\config.h"\ + ".\EXTERN.h"\ + ".\include\arpa/inet.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + "$(INCLUDE)\sys\Stat.h"\ + "$(INCLUDE)\sys\Types.h"\ + +NODEP_CPP_SOCKE=\ + "..\os2ish.h"\ + "..\vmsish.h"\ + ".\..\ext\Socket\sockadapt.h"\ + + +"$(INTDIR)\Socket.obj" : $(SOURCE) $(DEP_CPP_SOCKE) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\ext\SDBM_File\sdbm\sdbm.c + +!IF "$(CFG)" == "modules - Win32 Release" + +DEP_CPP_SDBM_C=\ + "..\ext\SDBM_File\sdbm\pair.h"\ + ".\..\ext\SDBM_File\sdbm\sdbm.h"\ + ".\..\ext\SDBM_File\sdbm\tune.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + "$(INCLUDE)\sys\Stat.h"\ + "$(INCLUDE)\sys\Types.h"\ + + +"$(INTDIR)\sdbm.obj" : $(SOURCE) $(DEP_CPP_SDBM_C) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "modules - Win32 Debug" + +DEP_CPP_SDBM_C=\ + "..\ext\SDBM_File\sdbm\pair.h"\ + ".\..\ext\SDBM_File\sdbm\sdbm.h"\ + ".\..\ext\SDBM_File\sdbm\tune.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\sdbm.obj" : $(SOURCE) $(DEP_CPP_SDBM_C) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\ext\SDBM_File\sdbm\pair.c + +!IF "$(CFG)" == "modules - Win32 Release" + +DEP_CPP_PAIR_=\ + "..\ext\SDBM_File\sdbm\pair.h"\ + ".\..\ext\SDBM_File\sdbm\sdbm.h"\ + ".\..\ext\SDBM_File\sdbm\tune.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + "$(INCLUDE)\sys\Stat.h"\ + "$(INCLUDE)\sys\Types.h"\ + + +"$(INTDIR)\pair.obj" : $(SOURCE) $(DEP_CPP_PAIR_) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "modules - Win32 Debug" + +DEP_CPP_PAIR_=\ + "..\ext\SDBM_File\sdbm\pair.h"\ + ".\..\ext\SDBM_File\sdbm\sdbm.h"\ + ".\..\ext\SDBM_File\sdbm\tune.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\pair.obj" : $(SOURCE) $(DEP_CPP_PAIR_) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\ext\SDBM_File\sdbm\hash.c + +!IF "$(CFG)" == "modules - Win32 Release" + +DEP_CPP_HASH_=\ + ".\..\ext\SDBM_File\sdbm\sdbm.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + "$(INCLUDE)\sys\Stat.h"\ + "$(INCLUDE)\sys\Types.h"\ + + +"$(INTDIR)\hash.obj" : $(SOURCE) $(DEP_CPP_HASH_) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ELSEIF "$(CFG)" == "modules - Win32 Debug" + +DEP_CPP_HASH_=\ + ".\..\ext\SDBM_File\sdbm\sdbm.h"\ + ".\config.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + + +"$(INTDIR)\hash.obj" : $(SOURCE) $(DEP_CPP_HASH_) "$(INTDIR)" + $(CPP) $(CPP_PROJ) $(SOURCE) + + +!ENDIF + +# End Source File +# End Target +# End Project +################################################################################ diff --git a/win32/VC-2.0/perl.mak b/win32/VC-2.0/perl.mak new file mode 100644 index 0000000000..bee99fda0e --- /dev/null +++ b/win32/VC-2.0/perl.mak @@ -0,0 +1,228 @@ +# Microsoft Developer Studio Generated NMAKE File, Format Version 4.20 +# ** DO NOT EDIT ** + +# TARGTYPE "Win32 (x86) Console Application" 0x0103 + +!IF "$(CFG)" == "" +CFG=perl - Win32 Debug +!MESSAGE No configuration specified. Defaulting to perl - Win32 Debug. +!ENDIF + +!IF "$(CFG)" != "perl - Win32 Release" && "$(CFG)" != "perl - Win32 Debug" +!MESSAGE Invalid configuration "$(CFG)" specified. +!MESSAGE You can specify a configuration when running NMAKE on this makefile +!MESSAGE by defining the macro CFG on the command line. For example: +!MESSAGE +!MESSAGE NMAKE /f "perl.mak" CFG="perl - Win32 Debug" +!MESSAGE +!MESSAGE Possible choices for configuration are: +!MESSAGE +!MESSAGE "perl - Win32 Release" (based on "Win32 (x86) Console Application") +!MESSAGE "perl - Win32 Debug" (based on "Win32 (x86) Console Application") +!MESSAGE +!ERROR An invalid configuration is specified. +!ENDIF + +!IF "$(OS)" == "Windows_NT" +NULL= +!ELSE +NULL=nul +!ENDIF +################################################################################ +# Begin Project +# PROP Target_Last_Scanned "perl - Win32 Debug" +CPP=cl.exe +RSC=rc.exe + +!IF "$(CFG)" == "perl - Win32 Release" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 0 +# PROP BASE Output_Dir "perl" +# PROP BASE Intermediate_Dir "perl" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 0 +# PROP Output_Dir "Release" +# PROP Intermediate_Dir "Release" +# PROP Target_Dir "" +OUTDIR=.\Release +INTDIR=.\Release + +ALL : "..\_perl.exe" + +CLEAN : + -@erase "$(INTDIR)\perlmain.obj" + -@erase "$(INTDIR)\win32io.obj" + -@erase "..\_perl.exe" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +# ADD BASE CPP /nologo /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /YX /c +# ADD CPP /nologo /MT /W3 /O2 /I "." /I ".\include" /I ".." /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /YX /c +CPP_PROJ=/nologo /MT /W3 /O2 /I "." /I ".\include" /I ".." /D "WIN32" /D\ + "NDEBUG" /D "_CONSOLE" /Fp"$(INTDIR)/perl.pch" /YX /Fo"$(INTDIR)/" /c +CPP_OBJS=.\Release/ +CPP_SBRS=.\. +# ADD BASE RSC /l 0x409 /d "NDEBUG" +# ADD RSC /l 0x409 /d "NDEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +BSC32_FLAGS=/nologo /o"$(OUTDIR)/perl.bsc" +BSC32_SBRS= \ + +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:console /machine:I386 +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib setargv.obj /nologo /subsystem:console /machine:I386 /out:"../_perl.exe" +LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ + advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib setargv.obj /nologo\ + /subsystem:console /incremental:no /pdb:"$(OUTDIR)/_perl.pdb" /machine:I386\ + /out:"../_perl.exe" +LINK32_OBJS= \ + "$(INTDIR)\perlmain.obj" \ + "$(INTDIR)\win32io.obj" \ + "..\perl.lib" + +"..\_perl.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) + $(LINK32) @<< + $(LINK32_FLAGS) $(LINK32_OBJS) +<< + +!ELSEIF "$(CFG)" == "perl - Win32 Debug" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 1 +# PROP BASE Output_Dir "dynaper0" +# PROP BASE Intermediate_Dir "dynaper0" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 1 +# PROP Output_Dir "Debug" +# PROP Intermediate_Dir "Debug" +# PROP Target_Dir "" +OUTDIR=.\Debug +INTDIR=.\Debug + +ALL : "..\_perl.exe" + +CLEAN : + -@erase "$(INTDIR)\perlmain.obj" + -@erase "$(INTDIR)\vc40.idb" + -@erase "$(INTDIR)\vc40.pdb" + -@erase "$(INTDIR)\win32io.obj" + -@erase "$(OUTDIR)\_perl.pdb" + -@erase "..\_perl.exe" + -@erase "..\_perl.ilk" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +# ADD BASE CPP /nologo /W3 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c +# ADD CPP /nologo /MTd /W3 /Gm /Zi /Od /I "." /I ".\include" /I ".." /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c +CPP_PROJ=/nologo /MTd /W3 /Gm /Zi /Od /I "." /I ".\include" /I ".." /D\ + "WIN32" /D "_DEBUG" /D "_CONSOLE" /Fp"$(INTDIR)/perl.pch" /YX /Fo"$(INTDIR)/"\ + /Fd"$(INTDIR)/" /c +CPP_OBJS=.\Debug/ +CPP_SBRS=.\. +# ADD BASE RSC /l 0x409 /d "_DEBUG" +# ADD RSC /l 0x409 /d "_DEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +BSC32_FLAGS=/nologo /o"$(OUTDIR)/perl.bsc" +BSC32_SBRS= \ + +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:console /debug /machine:I386 +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib setargv.obj /nologo /subsystem:console /debug /machine:I386 /out:"../_perl.exe" +LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ + advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib setargv.obj /nologo\ + /subsystem:console /incremental:yes /pdb:"$(OUTDIR)/_perl.pdb" /debug\ + /machine:I386 /out:"../_perl.exe" +LINK32_OBJS= \ + "$(INTDIR)\perlmain.obj" \ + "$(INTDIR)\win32io.obj" \ + "..\perl.lib" + +"..\_perl.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) + $(LINK32) @<< + $(LINK32_FLAGS) $(LINK32_OBJS) +<< + +!ENDIF + +.c{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.cpp{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.cxx{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.c{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +.cpp{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +.cxx{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +################################################################################ +# Begin Target + +# Name "perl - Win32 Release" +# Name "perl - Win32 Debug" + +!IF "$(CFG)" == "perl - Win32 Release" + +!ELSEIF "$(CFG)" == "perl - Win32 Debug" + +!ENDIF + +################################################################################ +# Begin Source File + +SOURCE=.\perlmain.c +DEP_CPP_PERLM=\ + ".\win32io.h"\ + + +"$(INTDIR)\perlmain.obj" : $(SOURCE) $(DEP_CPP_PERLM) "$(INTDIR)" + + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\perl.lib + +!IF "$(CFG)" == "perl - Win32 Release" + +!ELSEIF "$(CFG)" == "perl - Win32 Debug" + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=.\win32io.c +DEP_CPP_WIN32=\ + ".\include\sys/socket.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\Sys\Stat.h"\ + "$(INCLUDE)\Sys\Types.h"\ + + +"$(INTDIR)\win32io.obj" : $(SOURCE) $(DEP_CPP_WIN32) "$(INTDIR)" + + +# End Source File +# End Target +# End Project +################################################################################ diff --git a/win32/VC-2.0/perldll.mak b/win32/VC-2.0/perldll.mak new file mode 100644 index 0000000000..ab9460e2c8 --- /dev/null +++ b/win32/VC-2.0/perldll.mak @@ -0,0 +1,436 @@ +# Microsoft Developer Studio Generated NMAKE File, Format Version 4.20 +# ** DO NOT EDIT ** + +# TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102 + +!IF "$(CFG)" == "" +CFG=perldll - Win32 Debug +!MESSAGE No configuration specified. Defaulting to perldll - Win32 Debug. +!ENDIF + +!IF "$(CFG)" != "perldll - Win32 Release" && "$(CFG)" !=\ + "perldll - Win32 Debug" +!MESSAGE Invalid configuration "$(CFG)" specified. +!MESSAGE You can specify a configuration when running NMAKE on this makefile +!MESSAGE by defining the macro CFG on the command line. For example: +!MESSAGE +!MESSAGE NMAKE /f "perldll.mak" CFG="perldll - Win32 Debug" +!MESSAGE +!MESSAGE Possible choices for configuration are: +!MESSAGE +!MESSAGE "perldll - Win32 Release" (based on\ + "Win32 (x86) Dynamic-Link Library") +!MESSAGE "perldll - Win32 Debug" (based on "Win32 (x86) Dynamic-Link Library") +!MESSAGE +!ERROR An invalid configuration is specified. +!ENDIF + +!IF "$(OS)" == "Windows_NT" +NULL= +!ELSE +NULL=nul +!ENDIF +################################################################################ +# Begin Project +# PROP Target_Last_Scanned "perldll - Win32 Debug" +CPP=cl.exe +RSC=rc.exe +MTL=mktyplib.exe + +!IF "$(CFG)" == "perldll - Win32 Release" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 0 +# PROP BASE Output_Dir "perldll_" +# PROP BASE Intermediate_Dir "perldll_" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 0 +# PROP Output_Dir "../" +# PROP Intermediate_Dir "release" +# PROP Target_Dir "" +OUTDIR=.\.. +INTDIR=.\release + +ALL : "$(OUTDIR)\perl.dll" + +CLEAN : + -@erase "$(INTDIR)\perllib.obj" + -@erase "$(INTDIR)\win32.obj" + -@erase "$(INTDIR)\win32aux.obj" + -@erase "$(INTDIR)\win32io.obj" + -@erase "$(INTDIR)\win32sck.obj" + -@erase "$(OUTDIR)\perl.dll" + -@erase "$(OUTDIR)\perl.exp" + -@erase "$(OUTDIR)\perl.lib" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +"$(INTDIR)" : + if not exist "$(INTDIR)/$(NULL)" mkdir "$(INTDIR)" + +# ADD BASE CPP /nologo /MT /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MT /W3 /O2 /I "." /I ".\include" /I ".." /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "PERLDLL" /YX /c +CPP_PROJ=/nologo /MT /W3 /O2 /I "." /I ".\include" /I ".." /D "NDEBUG" /D\ + "WIN32" /D "_WINDOWS" /D "PERLDLL" /Fp"$(INTDIR)/perldll.pch" /YX\ + /Fo"$(INTDIR)/" /c +CPP_OBJS=.\release/ +CPP_SBRS=.\. +# ADD BASE MTL /nologo /D "NDEBUG" /win32 +# ADD MTL /nologo /D "NDEBUG" /win32 +MTL_PROJ=/nologo /D "NDEBUG" /win32 +# ADD BASE RSC /l 0x409 /d "NDEBUG" +# ADD RSC /l 0x409 /d "NDEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +BSC32_FLAGS=/nologo /o"$(OUTDIR)/perldll.bsc" +BSC32_SBRS= \ + +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:windows /dll /machine:I386 +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:windows /dll /pdb:none /machine:I386 /out:"../perl.dll" +LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ + advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo\ + /subsystem:windows /dll /pdb:none /machine:I386 /def:".\perldll.def"\ + /out:"$(OUTDIR)/perl.dll" /implib:"$(OUTDIR)/perl.lib" +DEF_FILE= \ + ".\perldll.def" +LINK32_OBJS= \ + "$(INTDIR)\perllib.obj" \ + "$(INTDIR)\win32.obj" \ + "$(INTDIR)\win32aux.obj" \ + "$(INTDIR)\win32io.obj" \ + "$(INTDIR)\win32sck.obj" \ + "..\libperl.lib" \ + ".\modules.lib" + +"$(OUTDIR)\perl.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) + $(LINK32) @<< + $(LINK32_FLAGS) $(LINK32_OBJS) +<< + +!ELSEIF "$(CFG)" == "perldll - Win32 Debug" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 1 +# PROP BASE Output_Dir "perldll0" +# PROP BASE Intermediate_Dir "perldll0" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 1 +# PROP Output_Dir "debug" +# PROP Intermediate_Dir "debug" +# PROP Target_Dir "" +OUTDIR=.\debug +INTDIR=.\debug + +ALL : "..\perl.dll" + +CLEAN : + -@erase "$(INTDIR)\perllib.obj" + -@erase "$(INTDIR)\vc40.idb" + -@erase "$(INTDIR)\vc40.pdb" + -@erase "$(INTDIR)\win32.obj" + -@erase "$(INTDIR)\win32aux.obj" + -@erase "$(INTDIR)\win32io.obj" + -@erase "$(INTDIR)\win32sck.obj" + -@erase "$(OUTDIR)\perl.exp" + -@erase "$(OUTDIR)\perl.lib" + -@erase "$(OUTDIR)\perl.pdb" + -@erase "..\perl.dll" + -@erase "..\perl.ilk" + +"$(OUTDIR)" : + if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" + +# ADD BASE CPP /nologo /MTd /W3 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MTd /W3 /Gm /Zi /Od /I "." /I ".\include" /I ".." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "PERLDLL" /YX /c +CPP_PROJ=/nologo /MTd /W3 /Gm /Zi /Od /I "." /I ".\include" /I ".." /D\ + "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "PERLDLL" /Fp"$(INTDIR)/perldll.pch" /YX\ + /Fo"$(INTDIR)/" /Fd"$(INTDIR)/" /c +CPP_OBJS=.\debug/ +CPP_SBRS=.\. +# ADD BASE MTL /nologo /D "_DEBUG" /win32 +# ADD MTL /nologo /D "_DEBUG" /win32 +MTL_PROJ=/nologo /D "_DEBUG" /win32 +# ADD BASE RSC /l 0x409 /d "_DEBUG" +# ADD RSC /l 0x409 /d "_DEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +BSC32_FLAGS=/nologo /o"$(OUTDIR)/perldll.bsc" +BSC32_SBRS= \ + +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:windows /dll /debug /machine:I386 +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:windows /dll /debug /machine:I386 /out:"../perl.dll" +LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ + advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo\ + /subsystem:windows /dll /incremental:yes /pdb:"$(OUTDIR)/perl.pdb" /debug\ + /machine:I386 /def:".\perldll.def" /out:"../perl.dll"\ + /implib:"$(OUTDIR)/perl.lib" +DEF_FILE= \ + ".\perldll.def" +LINK32_OBJS= \ + "$(INTDIR)\perllib.obj" \ + "$(INTDIR)\win32.obj" \ + "$(INTDIR)\win32aux.obj" \ + "$(INTDIR)\win32io.obj" \ + "$(INTDIR)\win32sck.obj" \ + "..\libperl.lib" \ + ".\modules.lib" + +"..\perl.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) + $(LINK32) @<< + $(LINK32_FLAGS) $(LINK32_OBJS) +<< + +!ENDIF + +.c{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.cpp{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.cxx{$(CPP_OBJS)}.obj: + $(CPP) $(CPP_PROJ) $< + +.c{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +.cpp{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +.cxx{$(CPP_SBRS)}.sbr: + $(CPP) $(CPP_PROJ) $< + +################################################################################ +# Begin Target + +# Name "perldll - Win32 Release" +# Name "perldll - Win32 Debug" + +!IF "$(CFG)" == "perldll - Win32 Release" + +!ELSEIF "$(CFG)" == "perldll - Win32 Debug" + +!ENDIF + +################################################################################ +# Begin Source File + +SOURCE=.\perllib.c +DEP_CPP_PERLL=\ + "..\av.h"\ + "..\cop.h"\ + "..\cv.h"\ + "..\dosish.h"\ + "..\embed.h"\ + "..\form.h"\ + "..\gv.h"\ + "..\handy.h"\ + "..\hv.h"\ + "..\mg.h"\ + "..\nostdio.h"\ + "..\op.h"\ + "..\opcode.h"\ + "..\perl.h"\ + "..\perlio.h"\ + "..\perlsdio.h"\ + "..\perlsfio.h"\ + "..\perly.h"\ + "..\plan9\plan9ish.h"\ + "..\pp.h"\ + "..\proto.h"\ + "..\regexp.h"\ + "..\scope.h"\ + "..\sv.h"\ + "..\unixish.h"\ + "..\util.h"\ + ".\config.h"\ + ".\EXTERN.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\sys\stat.h"\ + "$(INCLUDE)\sys\types.h"\ + +NODEP_CPP_PERLL=\ + "..\os2ish.h"\ + "..\vmsish.h"\ + + +"$(INTDIR)\perllib.obj" : $(SOURCE) $(DEP_CPP_PERLL) "$(INTDIR)" + + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=.\perldll.def + +!IF "$(CFG)" == "perldll - Win32 Release" + +!ELSEIF "$(CFG)" == "perldll - Win32 Debug" + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=..\libperl.lib + +!IF "$(CFG)" == "perldll - Win32 Release" + +!ELSEIF "$(CFG)" == "perldll - Win32 Debug" + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=.\win32sck.c +DEP_CPP_WIN32=\ + "..\av.h"\ + "..\cop.h"\ + "..\cv.h"\ + "..\dosish.h"\ + "..\embed.h"\ + "..\form.h"\ + "..\gv.h"\ + "..\handy.h"\ + "..\hv.h"\ + "..\mg.h"\ + "..\nostdio.h"\ + "..\op.h"\ + "..\opcode.h"\ + "..\perl.h"\ + "..\perlio.h"\ + "..\perlsdio.h"\ + "..\perlsfio.h"\ + "..\perly.h"\ + "..\plan9\plan9ish.h"\ + "..\pp.h"\ + "..\proto.h"\ + "..\regexp.h"\ + "..\scope.h"\ + "..\sv.h"\ + "..\unixish.h"\ + "..\util.h"\ + ".\config.h"\ + ".\EXTERN.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\sys\stat.h"\ + "$(INCLUDE)\sys\types.h"\ + +NODEP_CPP_WIN32=\ + "..\os2ish.h"\ + "..\vmsish.h"\ + + +"$(INTDIR)\win32sck.obj" : $(SOURCE) $(DEP_CPP_WIN32) "$(INTDIR)" + + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=.\win32.c + +!IF "$(CFG)" == "perldll - Win32 Release" + +DEP_CPP_WIN32_=\ + "..\embed.h"\ + "..\nostdio.h"\ + "..\perl.h"\ + "..\perlio.h"\ + "..\perlsdio.h"\ + "..\perlsfio.h"\ + ".\config.h"\ + ".\EXTERN.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys/socket.h"\ + ".\win32.h"\ + "$(INCLUDE)\sys\stat.h"\ + "$(INCLUDE)\sys\types.h"\ + + +"$(INTDIR)\win32.obj" : $(SOURCE) $(DEP_CPP_WIN32_) "$(INTDIR)" + + +!ELSEIF "$(CFG)" == "perldll - Win32 Debug" + +DEP_CPP_WIN32_=\ + "..\perl.h"\ + ".\EXTERN.h"\ + "$(INCLUDE)\sys\stat.h"\ + "$(INCLUDE)\sys\types.h"\ + + +"$(INTDIR)\win32.obj" : $(SOURCE) $(DEP_CPP_WIN32_) "$(INTDIR)" + + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=.\win32aux.c +DEP_CPP_WIN32A=\ + ".\include\sys/socket.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\sys\stat.h"\ + "$(INCLUDE)\sys\types.h"\ + + +"$(INTDIR)\win32aux.obj" : $(SOURCE) $(DEP_CPP_WIN32A) "$(INTDIR)" + + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=.\modules.lib + +!IF "$(CFG)" == "perldll - Win32 Release" + +!ELSEIF "$(CFG)" == "perldll - Win32 Debug" + +!ENDIF + +# End Source File +################################################################################ +# Begin Source File + +SOURCE=.\win32io.c +DEP_CPP_WIN32I=\ + ".\include\sys/socket.h"\ + ".\win32io.h"\ + ".\win32iop.h"\ + "$(INCLUDE)\sys\stat.h"\ + "$(INCLUDE)\sys\types.h"\ + + +"$(INTDIR)\win32io.obj" : $(SOURCE) $(DEP_CPP_WIN32I) "$(INTDIR)" + + +# End Source File +# End Target +# End Project +################################################################################ diff --git a/win32/VC-2.0/vc2.patch b/win32/VC-2.0/vc2.patch new file mode 100644 index 0000000000..ea7031b3c8 --- /dev/null +++ b/win32/VC-2.0/vc2.patch @@ -0,0 +1,16 @@ +You will need this patch to win32.c when compiling with VC++ ver. 2.0. + + +diff -ur /y/src/perl5.003_93/win32/win32.c perl5.003_93-w32/win32/win32.c +--- /y/src/perl5.003_93/win32/win32.c Fri Jan 31 21:38:10 1997 ++++ perl5.003_93-w32/win32/win32.c Tue Mar 11 01:51:08 1997 +@@ -41,7 +41,8 @@ + char szPerlLibRoot[MAX_PATH+1]; + HANDLE PerlDllHandle = INVALID_HANDLE_VALUE; + +-#define IsWin95() (Win32System == VER_PLATFORM_WIN32_WINDOWS) ++/* #define IsWin95() (Win32System == VER_PLATFORM_WIN32_WINDOWS) */ ++#define IsWin95() (0) + #define IsWinNT() (Win32System == VER_PLATFORM_WIN32_NT) + + void * diff --git a/win32/config.H b/win32/config.H index 62fa2f18db..f71ddc8151 100644 --- a/win32/config.H +++ b/win32/config.H @@ -1,11 +1,6 @@ -/* This file (config_H) is a sample config.h file. If you are unable - to successfully run Configure, copy this file to config.h and - edit it to suit your system. -*/ /* - * This file was produced by running the config_h.SH script, which - * gets its values from config.sh, which is generally produced by - * running Configure. + * This file was produced by running the config_h.SH script, on a UNIX machine + * with config.sh set to conif.w32 from this directory * * Feel free to modify any of this as the need arises. Note, however, * that running config_h.SH again will wipe out any changes you've made. @@ -14,9 +9,9 @@ * $Id: Config_h.U,v 3.0.1.4 1995/09/25 09:10:49 ram Exp $ */ -/* Configuration time: Thu Feb 8 17:15:11 EST 1996 - * Configured by: doughera - * Target system: sunos fractal 5.4 generic_101946-29 i86pc i386 +/* Configuration time: Thu Apr 11 06:20:49 PDT 1996 + * Configured by: garyng + * Target system: */ #ifndef _config_h_ @@ -29,9 +24,12 @@ #define MEM_ALIGNBYTES 8 /**/ /* ARCHNAME: - * This symbol archtechure name, not used in win32 + * This symbol holds a string representing the architecture name. + * It may be used to construct an architecture-dependant pathname + * where library files may be held under a private library, for + * instance. */ -#define ARCHNAME "win32" +#define ARCHNAME "MSWin32" /**/ /* BIN: * This symbol holds the path of the bin directory where the package will @@ -41,12 +39,15 @@ * This symbol is the filename expanded version of the BIN symbol, for * programs that do not want to deal with that at run-time. */ -#define BIN "/usr/local/bin" /**/ -#define BIN_EXP "/usr/local/bin" /**/ +#define BIN "C:\\perl\\bin" /**/ +#define BIN_EXP "C:\\perl\\bin" /**/ /* CAT2: * This macro catenates 2 tokens together. */ +/* STRINGIFY: + * This macro surrounds its token with double quotes. + */ #if 42 == 1 #define CAT2(a,b)a/**/b #define CAT3(a,b,c)a/**/b/**/c @@ -144,13 +145,13 @@ * This symbol, if defined, indicates that the chown routine is * available. */ -/* #define HAS_CHOWN /**/ +/*#define HAS_CHOWN /**/ /* HAS_CHROOT: * This symbol, if defined, indicates that the chroot routine is * available. */ -/* #define HAS_CHROOT /**/ +/*#define HAS_CHROOT /**/ /* HAS_CHSIZE: * This symbol, if defined, indicates that the chsize routine is available @@ -179,13 +180,13 @@ * This symbol, if defined, indicates that the crypt routine is available * to encrypt passwords and the like. */ -/* #define HAS_CRYPT /**/ +/*#define HAS_CRYPT /**/ /* HAS_CUSERID: * This symbol, if defined, indicates that the cuserid routine is * available to get character login names. */ -/* #define HAS_CUSERID /**/ +/*#define HAS_CUSERID /**/ /* HAS_DBL_DIG: * This symbol, if defined, indicates that this system's <float.h> @@ -193,7 +194,7 @@ * of significant digits in a double precision number. If this * symbol is not defined, a guess of 15 is usually pretty good. */ -#define HAS_DBL_DIG /* */ +#define HAS_DBL_DIG /**/ /* HAS_DIFFTIME: * This symbol, if defined, indicates that the difftime routine is @@ -262,6 +263,17 @@ */ #define HAS_FSETPOS /**/ +/* HAS_GETTIMEOFDAY: + * This symbol, if defined, indicates that the gettimeofday() system + * call is available for a sub-second accuracy clock. Usually, the file + * <sys/resource.h> needs to be included (see I_SYS_RESOURCE). + * The type "Timeval" should be used to refer to "struct timeval". + */ +/*#define HAS_GETTIMEOFDAY /**/ +#ifdef HAS_GETTIMEOFDAY +#define Timeval struct timeval /* Structure used by gettimeofday() */ +#endif + /* HAS_GETGROUPS: * This symbol, if defined, indicates that the getgroups() routine is * available to get the list of process groups. If unavailable, multiple @@ -288,12 +300,6 @@ */ /*#define HAS_GETLOGIN /**/ -/* HAS_GETPGRP: - * This symbol, if defined, indicates that the getpgrp routine is - * available to get the current process group. - */ -/*#define HAS_GETPGRP /**/ - /* HAS_GETPGRP2: * This symbol, if defined, indicates that the getpgrp2() (as in DG/UX) * routine is available to get the current process group. @@ -467,8 +473,8 @@ * to determine file-system related limits and options associated * with a given open file descriptor. */ -/* #define HAS_PATHCONF /**/ -/* #define HAS_FPATHCONF /**/ +/*#define HAS_PATHCONF /**/ +/*#define HAS_FPATHCONF /**/ /* HAS_PAUSE: * This symbol, if defined, indicates that the pause routine is @@ -486,7 +492,7 @@ * This symbol, if defined, indicates that the poll routine is * available to poll active file descriptors. */ -/* #define HAS_POLL /**/ +/*#define HAS_POLL /**/ /* HAS_READDIR: * This symbol, if defined, indicates that the readdir routine is @@ -517,7 +523,7 @@ * This symbol, if defined, indicates that the readlink routine is * available to read the value of a symbolic link. */ -/* #define HAS_READLINK /**/ +/*#define HAS_READLINK /**/ /* HAS_RENAME: * This symbol, if defined, indicates that the rename routine is available @@ -549,6 +555,13 @@ */ /*#define HAS_SAFE_MEMCPY /**/ +/* HAS_SANE_MEMCMP: + * This symbol, if defined, indicates that the memcmp routine is available + * and can be used to compare relative magnitudes of chars with their high + * bits set. If it is not defined, roll your own version. + */ +#define HAS_SANE_MEMCMP /**/ + /* HAS_SELECT: * This symbol, if defined, indicates that the select routine is * available to select active file descriptors. If the timeout field @@ -560,19 +573,19 @@ * This symbol, if defined, indicates that the entire sem*(2) library is * supported. */ -/* #define HAS_SEM /**/ +/*#define HAS_SEM /**/ /* HAS_SETEGID: * This symbol, if defined, indicates that the setegid routine is available * to change the effective gid of the current program. */ -/* #define HAS_SETEGID /**/ +/*#define HAS_SETEGID /**/ /* HAS_SETEUID: * This symbol, if defined, indicates that the seteuid routine is available * to change the effective uid of the current program. */ -/* #define HAS_SETEUID /**/ +/*#define HAS_SETEUID /**/ /* HAS_SETLINEBUF: * This symbol, if defined, indicates that the setlinebuf routine is @@ -587,24 +600,6 @@ */ #define HAS_SETLOCALE /**/ -/* HAS_SETPGID: - * This symbol, if defined, indicates that the setpgid routine is - * available to set process group ID. - */ -/* #define HAS_SETPGID /**/ - -/* HAS_SETPGRP: - * This symbol, if defined, indicates that the setpgrp routine is - * available to set the current process group. - */ -/* USE_BSDPGRP: - * This symbol, if defined, indicates that the BSD notion of process - * group is to be used. For instance, you have to say setpgrp(pid, pgrp) - * instead of the USG setpgrp(). - */ -/* #define HAS_SETPGRP /**/ -/*#define USE_BSDPGRP /**/ - /* HAS_SETPGRP2: * This symbol, if defined, indicates that the setpgrp2() (as in DG/UX) * routine is available to set the current process group. @@ -659,13 +654,13 @@ * This symbol, if defined, indicates that the setsid routine is * available to set the process group ID. */ -/* #define HAS_SETSID /**/ +/*#define HAS_SETSID /**/ /* HAS_SHM: * This symbol, if defined, indicates that the entire shm*(2) library is * supported. */ -/* #define HAS_SHM /**/ +/*#define HAS_SHM /**/ /* Shmat_t: * This symbol holds the return type of the shmat() system call. @@ -678,14 +673,14 @@ * but not always right so it should be emitted by the program only * when HAS_SHMAT_PROTOTYPE is not defined to avoid conflicting defs. */ -/* #define Shmat_t void * /**/ -/* #define HAS_SHMAT_PROTOTYPE /**/ +#define Shmat_t void * /**/ +/*#define HAS_SHMAT_PROTOTYPE /**/ /* HAS_SIGACTION: * This symbol, if defined, indicates that Vr4's sigaction() routine * is available. */ -/* #define HAS_SIGACTION /**/ +/*#define HAS_SIGACTION /**/ /* HAS_SOCKET: * This symbol, if defined, indicates that the BSD socket interface is @@ -696,13 +691,13 @@ * supported. */ #define HAS_SOCKET /**/ -/* #define HAS_SOCKETPAIR /**/ +/*#define HAS_SOCKETPAIR /**/ /* USE_STAT_BLOCKS: * This symbol is defined if this system has a stat structure declaring * st_blksize and st_blocks. */ -/* #define USE_STAT_BLOCKS /**/ +/*#define USE_STAT_BLOCKS /**/ /* USE_STDIO_PTR: * This symbol is defined if the _ptr and _cnt fields (or similar) @@ -711,18 +706,6 @@ * and FILE_cnt(fp) macros will also be defined and should be used * to access these fields. */ -/* USE_STDIO_BASE: - * This symbol is defined if the _base field (or similar) of the - * stdio FILE structure can be used to access the stdio buffer for - * a file handle. If this is defined, then the FILE_base(fp) macro - * will also be defined and should be used to access this field. - * Also, the FILE_bufsiz(fp) macro will be defined and should be used - * to determine the number of bytes in the buffer. USE_STDIO_BASE - * will never be defined unless USE_STDIO_PTR is. - */ -#define USE_STDIO_PTR /**/ -#define USE_STDIO_BASE /**/ - /* FILE_ptr: * This macro is used to access the _ptr field (or equivalent) of the * FILE structure pointed to by its argument. This macro will always be @@ -741,6 +724,7 @@ * This symbol is defined if the FILE_cnt macro can be used as an * lvalue. */ +#define USE_STDIO_PTR /**/ #ifdef USE_STDIO_PTR #define FILE_ptr(fp) ((fp)->_ptr) #define STDIO_PTR_LVALUE /**/ @@ -748,6 +732,15 @@ #define STDIO_CNT_LVALUE /**/ #endif +/* USE_STDIO_BASE: + * This symbol is defined if the _base field (or similar) of the + * stdio FILE structure can be used to access the stdio buffer for + * a file handle. If this is defined, then the FILE_base(fp) macro + * will also be defined and should be used to access this field. + * Also, the FILE_bufsiz(fp) macro will be defined and should be used + * to determine the number of bytes in the buffer. USE_STDIO_BASE + * will never be defined unless USE_STDIO_PTR is. + */ /* FILE_base: * This macro is used to access the _base field (or equivalent) of the * FILE structure pointed to by its argument. This macro will always be @@ -759,6 +752,7 @@ * structure pointed to its argument. This macro will always be defined * if USE_STDIO_BASE is defined. */ +#define USE_STDIO_BASE /**/ #ifdef USE_STDIO_BASE #define FILE_base(fp) ((fp)->_base) #define FILE_bufsiz(fp) ((fp)->_cnt + (fp)->_ptr - (fp)->_base) @@ -808,6 +802,24 @@ #define HAS_SYS_ERRLIST /**/ #define Strerror(e) strerror(e) +/* HAS_STRTOD: + * This symbol, if defined, indicates that the strtod routine is + * available to provide better numeric string conversion than atof(). + */ +#define HAS_STRTOD /**/ + +/* HAS_STRTOL: + * This symbol, if defined, indicates that the strtol routine is available + * to provide better numeric string conversion than atoi() and friends. + */ +#define HAS_STRTOL /**/ + +/* HAS_STRTOUL: + * This symbol, if defined, indicates that the strtoul routine is + * available to provide conversion of strings to unsigned long. + */ +#define HAS_STRTOUL /**/ + /* HAS_STRXFRM: * This symbol, if defined, indicates that the strxfrm() routine is * available to transform strings. @@ -818,19 +830,19 @@ * This symbol, if defined, indicates that the symlink routine is available * to create symbolic links. */ -/* #define HAS_SYMLINK /**/ +/*#define HAS_SYMLINK /**/ /* HAS_SYSCALL: * This symbol, if defined, indicates that the syscall routine is * available to call arbitrary system calls. If undefined, that's tough. */ -/* #define HAS_SYSCALL /**/ +/*#define HAS_SYSCALL /**/ /* HAS_SYSCONF: * This symbol, if defined, indicates that sysconf() is available * to determine system related limits and options. */ -/* #define HAS_SYSCONF /**/ +/*#define HAS_SYSCONF /**/ /* HAS_SYSTEM: * This symbol, if defined, indicates that the system routine is @@ -842,13 +854,13 @@ * This symbol, if defined, indicates that the tcgetpgrp routine is * available to get foreground process group ID. */ -/* #define HAS_TCGETPGRP /**/ +/*#define HAS_TCGETPGRP /**/ /* HAS_TCSETPGRP: * This symbol, if defined, indicates that the tcsetpgrp routine is * available to set foreground process group ID. */ -/* #define HAS_TCSETPGRP /**/ +/*#define HAS_TCSETPGRP /**/ /* Time_t: * This symbol holds the type returned by time(). It can be long, @@ -868,7 +880,7 @@ * This symbol, if defined, indicates that the truncate routine is * available to truncate files. */ -/* #define HAS_TRUNCATE /**/ +/*#define HAS_TRUNCATE /**/ /* HAS_TZNAME: * This symbol, if defined, indicates that the tzname[] array is @@ -927,7 +939,7 @@ * This symbol, if defined, indicates that the waitpid routine is * available to wait for child process. */ -/* #define HAS_WAITPID /**/ +/*#define HAS_WAITPID /**/ /* HAS_WCSTOMBS: * This symbol, if defined, indicates that the wcstombs routine is @@ -1147,11 +1159,17 @@ */ /*#define I_SYS_PARAM /**/ +/* I_SYS_RESOURCE: + * This symbol, if defined, indicates to the C program that it should + * include <sys/resource.h>. + */ +/*#define I_SYS_RESOURCE /**/ + /* I_SYS_SELECT: * This symbol, if defined, indicates to the C program that it should * include <sys/select.h> in order to get definition of struct timeval. */ -/* #define I_SYS_SELECT /**/ +/*#define I_SYS_SELECT /**/ /* I_SYS_TIMES: * This symbol, if defined, indicates to the C program that it should @@ -1171,6 +1189,12 @@ */ /*#define I_SYS_UN /**/ +/* I_SYS_WAIT: + * This symbol, if defined, indicates to the C program that it should + * include <sys/wait.h>. + */ +/*#define I_SYS_WAIT /**/ + /* I_TERMIO: * This symbol, if defined, indicates that the program should include * <termio.h> rather than <sgtty.h>. There are also differences in @@ -1219,12 +1243,39 @@ */ /*#define I_UTIME /**/ +/* I_STDARG: + * This symbol, if defined, indicates that <stdarg.h> exists and should + * be included. + */ +/* I_VARARGS: + * This symbol, if defined, indicates to the C program that it should + * include <varargs.h>. + */ +#define I_STDARG /**/ +/*#define I_VARARGS /**/ + /* I_VFORK: * This symbol, if defined, indicates to the C program that it should * include vfork.h. */ /*#define I_VFORK /**/ +/* INTSIZE: + * This symbol contains the value of sizeof(int) so that the C + * preprocessor can make decisions based on it. + */ +/* LONGSIZE: + * This symbol contains the value of sizeof(long) so that the C + * preprocessor can make decisions based on it. + */ +/* SHORTSIZE: + * This symbol contains the value of sizeof(short) so that the C + * preprocessor can make decisions based on it. + */ +#define INTSIZE 4 /**/ +#define LONGSIZE 4 /**/ +#define SHORTSIZE 2 /**/ + /* Off_t: * This symbol holds the type used to declare offsets in the kernel. * It can be int, long, off_t, etc... It may be necessary to include @@ -1240,6 +1291,33 @@ */ #define Mode_t mode_t /* file mode parameter for system calls */ +/* VAL_O_NONBLOCK: + * This symbol is to be used during open() or fcntl(F_SETFL) to turn on + * non-blocking I/O for the file descriptor. Note that there is no way + * back, i.e. you cannot turn it blocking again this way. If you wish to + * alternatively switch between blocking and non-blocking, use the + * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. + */ +/* VAL_EAGAIN: + * This symbol holds the errno error code set by read() when no data was + * present on the non-blocking file descriptor. + */ +/* RD_NODATA: + * This symbol holds the return code from read() when no data is present + * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is + * not defined, then you can't distinguish between no data and EOF by + * issuing a read(). You'll have to find another way to tell for sure! + */ +/* EOF_NONBLOCK: + * This symbol, if defined, indicates to the C program that a read() on + * a non-blocking file descriptor will return 0 on EOF, and not the value + * held in RD_NODATA (-1 usually, in that case!). + */ +#define VAL_O_NONBLOCK O_NONBLOCK +#define VAL_EAGAIN EAGAIN +#define RD_NODATA -1 +#define EOF_NONBLOCK + /* CAN_PROTOTYPE: * If defined, this macro indicates that the C compiler can handle * function prototypes. @@ -1270,7 +1348,6 @@ * is defined, and 'int *' otherwise. This is only useful if you * have select(), of course. */ -//#define Select_fd_set_t fd_set * /**/ #define Select_fd_set_t int * /**/ /* Size_t: @@ -1304,40 +1381,71 @@ */ #define Uid_t uid_t /* UID type */ -/* VMS: - * This symbol, if defined, indicates that the program is running under - * VMS. It is currently only set in conjunction with the EUNICE symbol. - */ -/*#define VMS /**/ - /* LOC_SED: * This symbol holds the complete pathname to the sed program. */ -#define LOC_SED "/bin/sed" /**/ +#define LOC_SED "" /**/ + +/* OSNAME: + * This symbol contains the name of the operating system, as determined + * by Configure. You shouldn't rely on it too much; the specific + * feature tests from Configure are generally more reliable. + */ +#define OSNAME "MSWin32" /**/ +/* ARCHLIB: + * This variable, if defined, holds the name of the directory in + * which the user wants to put architecture-dependent public + * library files for perl5. It is most often a local directory + * such as /usr/local/lib. Programs using this variable must be + * prepared to deal with filename expansion. If ARCHLIB is the + * same as PRIVLIB, it is not defined, since presumably the + * program already searches PRIVLIB. + */ /* ARCHLIB_EXP: * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB_EXP "/usr/local/lib/perl5/i86pc-solaris/5.002" /**/ +/* This added by hand */ +#define APPLLIB_EXP (win32PerlLibPath()) + +#define ARCHLIB "C:\\perl\\lib" /**/ +/* #define ARCHLIB_EXP "C:\\perl\\lib" /**/ -/* OSNAME - * This symbol defined the name of the OS. in our case WIN32 - * (we don't distinguish between NT or 95) +/* BINCOMPAT3: + * This symbol, if defined, indicates that Perl 5.004 should be + * binary-compatible with Perl 5.003. */ -#define OSNAME "MSWin32" +/*#define BINCOMPAT3 /**/ /* BYTEORDER: - * This symbol hold the hexadecimal constant defined in byteorder, + * This symbol holds the hexadecimal constant defined in byteorder, * i.e. 0x1234 or 0x4321, etc... - */ + * On NeXT 4 (and greater), you can build "Fat" Multiple Architecture + * Binaries (MAB) on either big endian or little endian machines. + * The endian-ness is available at compile-time. This only matters + * for perl, where the config.h can be generated and installed on + * one system, and used by a different architecture to build an + * extension. Older versions of NeXT that might not have + * defined either *_ENDIAN__ were all on Motorola 680x0 series, + * so the default case (for NeXT) is big endian to catch them. + * This might matter for NeXT 3.0. + */ +#ifndef NeXT #define BYTEORDER 0x1234 /* large digits for MSB */ +#else /* NeXT */ +#ifdef __LITTLE_ENDIAN__ +#define BYTEORDER 0x1234 +#else /* __BIG_ENDIAN__ */ +#define BYTEORDER 0x4321 +#endif /* ENDIAN CHECK */ +#endif /* NeXT */ /* CSH: * This symbol, if defined, indicates that the C-shell exists. * If defined, contains the full pathname of csh. */ -#define CSH "/bin/csh" /**/ +/*#define CSH "" /**/ /* DLSYM_NEEDS_UNDERSCORE: * This symbol, if defined, indicates that we need to prepend an @@ -1345,7 +1453,7 @@ * makes sense if you *have* dlsym, which we will presume is the * case if you're using dl_dlopen.xs. */ -/*#define DLSYM_NEEDS_UNDERSCORE /* */ +/*#define DLSYM_NEEDS_UNDERSCORE /**/ /* SETUID_SCRIPTS_ARE_SECURE_NOW: * This symbol, if defined, indicates that the bug that prevents @@ -1364,7 +1472,7 @@ * subprocesses to which it must pass the filename rather than the * file descriptor of the script to be executed. */ -#define SETUID_SCRIPTS_ARE_SECURE_NOW /**/ +/*#define SETUID_SCRIPTS_ARE_SECURE_NOW /**/ /*#define DOSUID /**/ /* Gconvert: @@ -1382,30 +1490,87 @@ * d_Gconvert='sprintf((b),"%.*g",(n),(x))' * The last two assume trailing zeros should not be kept. */ -/* WIN32 ?? */ #define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x)) +/* HAS_GETPGID: + * This symbol, if defined, indicates to the C program that + * the getpgid(pid) function is available to get the + * process group id. + */ +/*#define HAS_GETPGID /**/ + +/* HAS_GETPGRP: + * This symbol, if defined, indicates that the getpgrp routine is + * available to get the current process group. + */ +/* USE_BSD_GETPGRP: + * This symbol, if defined, indicates that getpgrp needs one + * arguments whereas USG one needs none. + */ +/*#define HAS_GETPGRP /**/ +/*#define USE_BSD_GETPGRP /**/ + +/* HAS_INET_ATON: + * This symbol, if defined, indicates to the C program that the + * inet_aton() function is available to parse IP address "dotted-quad" + * strings. + */ +/*#define HAS_INET_ATON /**/ + +/* HAS_SETPGID: + * This symbol, if defined, indicates to the C program that + * the setpgid(pid, gpid) function is available to set the + * process group id. + */ +/*#define HAS_SETPGID /**/ + +/* HAS_SETPGRP: + * This symbol, if defined, indicates that the setpgrp routine is + * available to set the current process group. + */ +/* USE_BSD_SETPGRP: + * This symbol, if defined, indicates that setpgrp needs two + * arguments whereas USG one needs none. See also HAS_SETPGID + * for a POSIX interface. + */ +/* USE_BSDPGRP: + * This symbol, if defined, indicates that the BSD notion of process + * group is to be used. For instance, you have to say setpgrp(pid, pgrp) + * instead of the USG setpgrp(). This should be obsolete since + * there are systems which have BSD-ish setpgrp but USG-ish getpgrp. + */ +/*#define HAS_SETPGRP /**/ +/*#define USE_BSD_SETPGRP /**/ +/*#define USE_BSDPGRP /**/ + +/* USE_SFIO: + * This symbol, if defined, indicates that sfio should + * be used. + */ +/*#define USE_SFIO /**/ + /* Sigjmp_buf: - * This is the buffer type to be used with Sigsetjmp and Siglongjmp. + * This is the buffer type to be used with Sigsetjmp and Siglongjmp. */ /* Sigsetjmp: - * This macro is used in the same way as sigsetjmp(), but will invoke - * traditional setjmp() if sigsetjmp isn't available. + * This macro is used in the same way as sigsetjmp(), but will invoke + * traditional setjmp() if sigsetjmp isn't available. + * See HAS_SIGSETJMP. */ /* Siglongjmp: - * This macro is used in the same way as siglongjmp(), but will invoke - * traditional longjmp() if siglongjmp isn't available. + * This macro is used in the same way as siglongjmp(), but will invoke + * traditional longjmp() if siglongjmp isn't available. + * See HAS_SIGSETJMP. */ -/* #define HAS_SIGSETJMP /**/ - +/*#define HAS_SIGSETJMP /**/ #ifdef HAS_SIGSETJMP #define Sigjmp_buf sigjmp_buf -#define Sigsetjmp(buf,save_mask) sigsetjmp(buf,save_mask) -#define Siglongjmp(buf,retval) siglongjmp(buf,retval) +#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask)) +#define Siglongjmp(buf,retval) siglongjmp((buf),(retval)) #else #define Sigjmp_buf jmp_buf -#define Sigsetjmp(buf,save_mask) setjmp(buf) -#define Siglongjmp(buf,retval) longjmp(buf,retval) +#define Sigsetjmp(buf,save_mask) setjmp((buf)) +#define Siglongjmp(buf,retval) longjmp((buf),(retval)) #endif /* USE_DYNAMIC_LOADING: @@ -1431,28 +1596,25 @@ */ #define I_LOCALE /**/ +/* I_SFIO: + * This symbol, if defined, indicates to the C program that it should + * include <sfio.h>. + */ +/*#define I_SFIO /**/ + /* I_SYS_STAT: * This symbol, if defined, indicates to the C program that it should * include <sys/stat.h>. */ #define I_SYS_STAT /**/ -/* I_STDARG: - * This symbol, if defined, indicates that <stdarg.h> exists and should - * be included. - */ -/* I_VARARGS: +/* I_VALUES: * This symbol, if defined, indicates to the C program that it should - * include <varargs.h>. + * include <values.h> to get definition of symbols like MINFLOAT or + * MAXLONG, i.e. machine dependant limitations. Probably, you + * should use <limits.h> instead, if it is available. */ -#define I_STDARG /**/ -/*#define I_VARARGS /**/ - -/* INTSIZE: - * This symbol contains the size of an int, so that the C preprocessor - * can make decisions based on it. - */ -#define INTSIZE 4 /**/ +/*#define I_VALUES /**/ /* Free_t: * This variable contains the return type of free(). It is usually @@ -1469,51 +1631,40 @@ */ /*#define MYMALLOC /**/ -/* VAL_O_NONBLOCK: - * This symbol is to be used during open() or fcntl(F_SETFL) to turn on - * non-blocking I/O for the file descriptor. Note that there is no way - * back, i.e. you cannot turn it blocking again this way. If you wish to - * alternatively switch between blocking and non-blocking, use the - * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. - */ -/* VAL_EAGAIN: - * This symbol holds the errno error code set by read() when no data was - * present on the non-blocking file descriptor. - */ -/* RD_NODATA: - * This symbol holds the return code from read() when no data is present - * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is - * not defined, then you can't distinguish between no data and EOF by - * issuing a read(). You'll have to find another way to tell for sure! +/* OLDARCHLIB: + * This variable, if defined, holds the name of the directory in + * which the user has perl5.000 or perl5.001 architecture-dependent + * public library files for perl5. For the most part, these + * files will work with 5.002 (and later), but that is not + * guaranteed. */ -/* EOF_NONBLOCK: - * This symbol, if defined, indicates to the C program that a read() on - * a non-blocking file descriptor will return 0 on EOF, and not the value - * held in RD_NODATA (-1 usually, in that case!). - */ -#define VAL_O_NONBLOCK O_NONBLOCK -#define VAL_EAGAIN EAGAIN -#define RD_NODATA -1 -#define EOF_NONBLOCK - /* OLDARCHLIB_EXP: * This symbol contains the ~name expanded version of OLDARCHLIB, to be * used in programs that are not prepared to deal with ~ expansion at * run-time. */ +/*#define OLDARCHLIB "" /**/ /*#define OLDARCHLIB_EXP "" /**/ +/* PRIVLIB: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + */ /* PRIVLIB_EXP: * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB_EXP (win32PerlLibPath()) /**/ +#define PRIVLIB "C:\\perl\\lib" /**/ +#define PRIVLIB_EXP "C:\\perl\\lib" /**/ /* SH_PATH: * This symbol contains the full pathname to the shell used on this * on this system to execute Bourne shell scripts. Usually, this will be * /bin/sh, though it's possible that some systems will have /bin/ksh, - * /bin/pdksh, /bin/ash, /bin/bash, or even something such as D:/bin/sh. + * /bin/pdksh, /bin/ash, /bin/bash, or even something such as + * D:/bin/sh.exe. */ #define SH_PATH "/bin/sh" /**/ @@ -1548,24 +1699,51 @@ #define SIG_NAME "ZERO","HUP","INT","QUIT","ILL","TRAP","ABRT","EMT","FPE","KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM","USR1","USR2","CHLD","PWR","WINCH","URG","IO","STOP","TSTP","CONT","TTIN","TTOU","VTALRM","PROF","XCPU","XFSZ","WAITING","LWP","FREEZE","THAW","RTMIN","NUM37","NUM38","NUM39","NUM40","NUM41","NUM42","RTMAX","IOT","CLD","POLL",0 /**/ #define SIG_NUM 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,6,18,22,0 /**/ +/* SITEARCH: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + * The standard distribution will put nothing in this directory. + * Individual sites may place their own extensions and modules in + * this directory. + */ /* SITEARCH_EXP: * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH_EXP "/usr/local/lib/perl5/site_perl/i86pc-solaris" /**/ +#define SITEARCH "C:\\perl\\lib\\site" /**/ +/* #define SITEARCH_EXP "C:\\perl\\lib\\site" /**/ +/* SITELIB: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + * The standard distribution will put nothing in this directory. + * Individual sites may place their own extensions and modules in + * this directory. + */ /* SITELIB_EXP: * This symbol contains the ~name expanded version of SITELIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITELIB_EXP "/usr/local/lib/perl5/site_perl" /**/ +#define SITELIB "C:\\perl\\lib\\site" /**/ +#define SITELIB_EXP "C:\\perl\\lib\\site" /**/ /* STARTPERL: * This variable contains the string to put in front of a perl * script to make sure (one hopes) that it runs with perl and not * some shell. */ -#define STARTPERL "#!/usr/local/bin/perl" /**/ +#define STARTPERL "#perl" /**/ + +/* USE_PERLIO: + * This symbol, if defined, indicates that the PerlIO abstraction should + * be used throughout. If not defined, stdio should be + * used in a fully backward compatible manner. + */ +/*#define USE_PERLIO /**/ /* VOIDFLAGS: * This symbol indicates how much support of the void type is given by this diff --git a/win32/config.w32 b/win32/config.w32 index 7525eeb252..116762202e 100644 --- a/win32/config.w32 +++ b/win32/config.w32 @@ -5,25 +5,25 @@ ## Target system: WIN32 # -archlibexp='d:/temp/b/perl5.002/lib' +archlibexp='C:\perl\lib' archname='MSWin32' cc='cl' -ccflags='-Id:/msdev/include -Id:/temp' -cppflags='-I/usr/local/include' +ccflags='' +cppflags='' dlsrc='dl_win32.xs' dynamic_ext='Fcntl IO Opcode SDBM_File Socket' extensions='Fcntl IO Opcode SDBM_File Socket' -installarchlib='/u1/garyng/tmp/lib/5.002' -installprivlib='/u1/garyng/tmp/lib/perl5' -libpth='/usr/local/lib /lib /usr/lib /usr/ucblib' -libs='-lgdbm -ldbm -ldl -lm -lc -lposix' +installarchlib='C:\perl\lib' +installprivlib='C:\perl\lib' +libpth='' +libs='' osname='MSWin32' osvers='4.0' -prefix='~garyng/tmp' -privlibexp='/u1/garyng/tmp/lib/perl5' +prefix='C:' +privlibexp='C:\perl\lib' sharpbang='#!' shsharp='true' -sig_name='ZERO HUP INT QUIT ILL TRAP ABRT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM URG STOP TSTP CONT CHLD TTIN TTOU IO XCPU XFSZ VTALRM PROF WINCH LOST USR1 USR2 IOT CLD POLL ' +sig_name='ZERO HUP INT QUIT ILL TRAP ABRT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM USR1 USR2 CHLD PWR WINCH URG IO STOP TSTP CONT TTIN TTOU VTALRM PROF XCPU XFSZ WAITING LWP FREEZE THAW RTMIN NUM37 NUM38 NUM39 NUM40 NUM41 NUM42 RTMAX IOT CLD POLL' so='dll' startsh='#!/bin/sh' static_ext=' ' @@ -35,7 +35,7 @@ Id='$Id' Locker='' Log='$Log' Mcc='Mcc' -PATCHLEVEL='2' +PATCHLEVEL='3' POSIX_cflags='ccflags="$ccflags -DSTRUCT_TM_HASZONE"' RCSfile='$RCSfile' Revision='$Revision' @@ -46,20 +46,20 @@ afs='false' alignbytes='8' aphostname='' ar='ar' -archlib='~garyng/tmp/lib/perl5/sun4-sunos/5.002' +archlib='C:\perl\lib' archobjs='' awk='awk' baserev='5.0' bash='' -bin='~garyng/tmp/bin' -binexp='/u1/garyng/tmp/bin' +bin='C:\perl\bin' +binexp='C:\perl\bin' bison='' byacc='byacc' byteorder='1234' c='' castflags='0' cat='cat' -cccdlflags='-pic' +cccdlflags='' ccdlflags=' ' cf_by='garyng' cf_email='71564.1743@compuserve.com' @@ -74,36 +74,39 @@ contains='grep' cp='cp' cpio='' cpp='cpp' -cpp_stuff='1' +cpp_stuff='42' cpplast='' cppminus='' -cpprun='/usr/lib/cpp' -cppstdin='cppstdin' +cpprun='cl -E' +cppstdin='cl -E' cryptlib='' -csh='csh' -d_Gconvert='gconvert((x),(n),(t),(b))' +csh='undef' +d_Gconvert='sprintf((b),"%.*g",(n),(x))' d_access='define' d_alarm='define' d_archlib='define' d_attribut='undef' -d_bcmp='define' -d_bcopy='define' +d_bcmp='undef' +d_bcopy='undef' +d_bincompat3='undef' d_bsd='define' -d_bsdpgrp='define' -d_bzero='define' +d_bsdgetpgrp='undef' +d_bsdpgrp='undef' +d_bsdsetpgrp='undef' +d_bzero='undef' d_casti32='define' d_castneg='define' -d_charvspr='define' -d_chown='define' -d_chroot='define' -d_chsize='undef' +d_charvspr='undef' +d_chown='undef' +d_chroot='undef' +d_chsize='define' d_closedir='define' -d_const='undef' -d_crypt='define' -d_csh='define' -d_cuserid='define' -d_dbl_dig='undef' -d_difftime='undef' +d_const='define' +d_crypt='undef' +d_csh='undef' +d_cuserid='undef' +d_dbl_dig='define' +d_difftime='define' d_dirnamlen='define' d_dlerror='define' d_dlopen='define' @@ -112,109 +115,114 @@ d_dosuid='undef' d_dup2='define' d_eofnblk='define' d_eunice='undef' -d_fchmod='define' -d_fchown='define' -d_fcntl='define' +d_fchmod='undef' +d_fchown='undef' +d_fcntl='undef' d_fd_macros='define' d_fd_set='define' d_fds_bits='define' -d_fgetpos='undef' +d_fgetpos='define' d_flexfnam='define' -d_flock='define' -d_fork='define' -d_fpathconf='define' -d_fsetpos='undef' -d_getgrps='define' +d_flock='undef' +d_fork='undef' +d_fpathconf='undef' +d_fsetpos='define' +d_getgrps='undef' d_gethent='undef' d_gethname='undef' -d_getlogin='define' +d_getlogin='undef' d_getpgrp2='undef' -d_getpgrp='define' -d_getppid='define' -d_getprior='define' +d_getpgrp='undef' +d_getpgid='undef' +d_getppid='undef' +d_getprior='undef' +d_gettimeod='undef' d_htonl='define' d_index='undef' +d_inetaton='undef' d_isascii='define' -d_killpg='define' -d_link='define' +d_killpg='undef' +d_link='undef' d_locconv='define' -d_lockf='define' -d_lstat='define' +d_lockf='undef' +d_lstat='undef' d_mblen='define' d_mbstowcs='define' d_mbtowc='define' d_memcmp='define' d_memcpy='define' -d_memmove='undef' +d_memmove='define' d_memset='define' d_mkdir='define' -d_mkfifo='define' +d_mkfifo='undef' d_mktime='define' -d_msg='define' +d_msg='undef' d_msgctl='define' d_msgget='define' d_msgrcv='define' d_msgsnd='define' -d_mymalloc='define' -d_nice='define' +d_mymalloc='undef' +d_nice='undef' d_oldarchlib='undef' d_oldsock='undef' -d_open3='define' -d_pathconf='define' +d_open3='undef' +d_pathconf='undef' d_pause='define' d_phostname='undef' d_pipe='define' -d_poll='define' +d_poll='undef' d_portable='define' -d_pwage='define' +d_pwage='undef' d_pwchange='undef' d_pwclass='undef' -d_pwcomment='define' +d_pwcomment='undef' d_pwexpire='undef' d_pwquota='undef' d_readdir='define' -d_readlink='define' +d_readlink='undef' d_rename='define' d_rewinddir='define' d_rmdir='define' -d_safebcpy='define' +d_safebcpy='undef' d_safemcpy='undef' +d_sanemcmp='define' d_seekdir='define' d_select='define' -d_sem='define' +d_sem='undef' d_semctl='define' d_semget='define' d_semop='define' -d_setegid='define' -d_seteuid='define' -d_setlinebuf='define' +d_setegid='undef' +d_seteuid='undef' +d_setlinebuf='undef' d_setlocale='define' -d_setpgid='define' +d_setpgid='undef' d_setpgrp2='undef' -d_setpgrp='define' -d_setprior='define' -d_setregid='define' +d_setpgrp='undef' +d_setprior='undef' +d_setregid='undef' d_setresgid='undef' d_setresuid='undef' -d_setreuid='define' -d_setrgid='define' -d_setruid='define' -d_setsid='define' -d_shm='define' -d_shmat='define' +d_setreuid='undef' +d_setrgid='undef' +d_setruid='undef' +d_setsid='undef' +d_sfio='undef'; +d_shm='undef' +d_shmat='undef' d_shmatprototype='undef' d_shmctl='define' d_shmdt='define' d_shmget='define' d_shrplib='undef' -d_sigaction='define' +d_sigaction='undef' d_sigintrp='' -d_sigsetjmp='define' +d_sigsetjmp='undef' d_sigvec='define' d_sigvectr='undef' d_socket='define' -d_sockpair='define' -d_statblks='define' +d_sockpair='undef' +d_statblks='undef' d_stdio_cnt_lval='define' d_stdio_ptr_lval='define' d_stdiobase='define' @@ -222,33 +230,36 @@ d_stdstdio='define' d_strchr='define' d_strcoll='define' d_strctcpy='define' -d_strerrm='((e)<0||(e)>=sys_nerr?"unknown":sys_errlist[e])' -d_strerror='undef' +d_strerrm='strerror(e)' +d_strerror='define' +d_strtod='define' +d_strtol='define' +d_strtoul='define' d_strxfrm='define' d_suidsafe='undef' -d_symlink='define' -d_syscall='define' -d_sysconf='define' +d_symlink='undef' +d_syscall='undef' +d_sysconf='undef' d_sysernlst='' d_syserrlst='define' d_system='define' -d_tcgetpgrp='define' -d_tcsetpgrp='define' +d_tcgetpgrp='undef' +d_tcsetpgrp='undef' d_telldir='define' d_time='define' d_times='define' -d_truncate='define' -d_tzname='undef' +d_truncate='undef' +d_tzname='define' d_umask='define' -d_uname='define' -d_vfork='define' +d_uname='undef' +d_vfork='undef' d_void_closedir='undef' d_voidsig='define' d_voidtty='' -d_volatile='undef' +d_volatile='define' d_vprintf='define' -d_wait4='define' -d_waitpid='define' +d_wait4='undef' +d_waitpid='undef' d_wcstombs='define' d_wctomb='define' d_xenix='undef' @@ -256,29 +267,29 @@ date='date' db_hashtype='int' db_prefixtype='int' defvoidused='15' -direntrytype='struct dirent' -dlext='so' +direntrytype='struct direct' +dlext='dll' eagain='EAGAIN' echo='echo' egrep='egrep' emacs='' eunicefix=':' -exe_ext='' +exe_ext='.exe' expr='expr' find='find' firstmakefile='makefile' flex='' -fpostype='long' -freetype='int' -full_csh='/usr/bin/csh' -full_sed='/usr/bin/sed' +fpostype='fpos_t' +freetype='void' +full_csh='' +full_sed='' gcc='' gccversion='' gidtype='gid_t' glibpth='/usr/shlib /lib/pa1.1 /usr/lib/large /lib /usr/lib /usr/lib/386 /lib/386 /lib/large /usr/lib/small /lib/small /usr/ccs/lib /usr/ucblib /usr/shlib ' grep='grep' groupcat='' -groupstype='int' +groupstype='gid_t' h_fcntl='false' h_sysfile='true' hint='recommended' @@ -286,76 +297,80 @@ hostcat='ypcat hosts' huge='' i_bsdioctl='' i_db='undef' -i_dbm='define' +i_dbm='undef' i_dirent='define' i_dld='undef' i_dlfcn='define' -i_fcntl='undef' -i_float='undef' +i_fcntl='define' +i_float='define' i_gdbm='define' i_grp='define' i_limits='define' i_locale='define' i_malloc='define' i_math='define' -i_memory='define' +i_memory='undef' i_ndbm='define' i_neterrno='undef' -i_niin='define' -i_pwd='define' -i_rpcsvcdbm='undef' +i_niin='undef' +i_pwd='undef' +i_rpcsvcdbm='define' +i_sfio='undef' i_sgtty='undef' -i_stdarg='undef' +i_stdarg='define' i_stddef='define' i_stdlib='define' i_string='define' -i_sysdir='define' -i_sysfile='define' +i_sysdir='undef' +i_sysfile='undef' i_sysfilio='define' i_sysin='undef' -i_sysioctl='define' +i_sysioctl='undef' i_sysndir='undef' -i_sysparam='define' +i_sysparam='undef' +i_sysresrc='undef' i_sysselct='undef' i_syssockio='' i_sysstat='define' -i_systime='define' +i_systime='undef' i_systimek='undef' -i_systimes='define' +i_systimes='undef' i_systypes='define' -i_sysun='define' +i_sysun='undef' +i_syswait='undef' i_termio='undef' -i_termios='define' -i_time='undef' -i_unistd='define' -i_utime='define' -i_varargs='define' +i_termios='undef' +i_time='define' +i_unistd='undef' +i_utime='undef' +i_values='undef' +i_varargs='undef' i_varhdr='varargs.h' -i_vfork='define' +i_vfork='undef' incpath='' inews='' -installbin='/u1/garyng/tmp/bin' -installman1dir='/u1/garyng/tmp/man/man1' -installman3dir='/u1/garyng/tmp/lib/perl5/man/man3' -installscript='/u1/garyng/tmp/bin' -installsitearch='/u1/garyng/tmp/lib/perl5/site_perl/sun4-sunos' -installsitelib='/u1/garyng/tmp/lib/perl5/site_perl' +installbin='C:\perl\bin' +installman1dir='C:\perl\man\man1' +installman3dir='C:\perl\lib\perl5\man\man3' +installscript='C:\perl\bin' +installsitearch='C:\perl\lib\site' +installsitelib='C:\perl\lib\site' intsize='4' known_extensions='DB_File Fcntl GDBM_File NDBM_File ODBM_File Opcode POSIX SDBM_File Socket' ksh='' large='' -ld='ld' -lddlflags='-assert nodefinitions -L/usr/local/lib' -ldflags=' -L/usr/local/lib' +ld='link' +lddlflags='-dll' +ldflags='-nologo -subsystem:windows' less='less' -lib_ext='.a' +lib_ext='.lib' libc='/lib/libc.so.1.9.2' libswanted='net socket inet nsl nm ndbm gdbm dbm db malloc dl dld ld sun m c cposix posix ndir dir crypt ucb bsd BSD PW x' line='line' lint='' lkflags='' -ln='ln' -lns='/usr/bin/ln -s' +ln='' +lns='' locincpth='/usr/local/include /opt/local/include /usr/gnu/include /opt/gnu/include /usr/GNU/include /opt/GNU/include' loclibpth='/usr/local/lib /opt/local/lib /usr/gnu/lib /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib' longsize='4' @@ -365,15 +380,15 @@ ls='ls' lseektype='off_t' mail='' mailx='' -make='' +make='nmake' mallocobj='malloc.o' mallocsrc='malloc.c' -malloctype='char *' -man1dir='~garyng/tmp/man/man1' -man1direxp='/u1/garyng/tmp/man/man1' +malloctype='void *' +man1dir='C:\perl\man\man1' +man1direxp='C:\perl\man\man1' man1ext='1' -man3dir='~garyng/tmp/lib/perl5/man/man3' -man3direxp='/u1/garyng/tmp/lib/perl5/man/man3' +man3dir='C:\perl\lib\perl5\man\man3' +man3direxp='C:\perl\lib\perl5\man\man3' man3ext='3' medium='' mips='' @@ -383,7 +398,7 @@ models='none' modetype='mode_t' more='more' mv='' -myarchname='sun4-sunos' +myarchname='MSWin32' mydomain='' myhostname='' myuname='' @@ -398,43 +413,43 @@ oldarchlibexp='' optimize='-O' orderlib='false' package='perl5' -pager='/usr/local/bin/less' +pager='cmd /c more' passcat='' patchlevel='2' -path_sep=':' +path_sep=';' perl='perl' perladmin='' -perlpath='/u1/garyng/tmp/bin/perl' +perlpath='C:\perl\bin\perl.exe' pg='pg' phostname='hostname' plibpth='' pmake='' pr='' -prefixexp='/u1/garyng/tmp' -privlib='~garyng/tmp/lib/perl5' -prototype='undef' -randbits='31' -ranlib='/usr/bin/ranlib' +prefixexp='C:' +privlib='C:\perl\lib' +prototype='define' +randbits='15' +ranlib='' rd_nodata='-1' rm='rm' rmail='' runnm='true' -scriptdir='~garyng/tmp/bin' -scriptdirexp='/u1/garyng/tmp/bin' +scriptdir='C:\perl\bin' +scriptdirexp='C:\perl\bin' sed='sed' -selecttype='fd_set *' +selecttype='int *' sendmail='blat' -sh='' +sh='cmd /c' shar='' -shmattype='char *' +shmattype='void *' shortsize='2' shrpdir='none' -sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 6 20 23 ' +sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 6 18 22' signal_t='void' -sitearch='~garyng/tmp/lib/perl5/site_perl/sun4-sunos' -sitearchexp='/u1/garyng/tmp/lib/perl5/site_perl/sun4-sunos' -sitelib='~garyng/tmp/lib/perl5/site_perl' -sitelibexp='/u1/garyng/tmp/lib/perl5/site_perl' +sitearch='C:\perl\lib\site' +sitearchexp='C:\perl\lib\site' +sitelib='C:\perl\lib\site' +sitelibexp='C:\perl\lib\site' sizetype='size_t' sleep='' smail='' @@ -446,7 +461,7 @@ spackage='Perl5' spitshell='cat' split='' ssizetype='int' -startperl='#!/u1/garyng/tmp/bin/perl' +startperl='#perl' stdchar='unsigned char' stdio_base='((fp)->_base)' stdio_bufsiz='((fp)->_cnt + (fp)->_ptr - (fp)->_base)' @@ -470,6 +485,7 @@ uniq='uniq' usedl='define' usemymalloc='y' usenm='true' +useperlio='undef' useposix='true' usesafe='true' usevfork='true' diff --git a/win32/dl_win32.xs b/win32/dl_win32.xs index 47d06c080e..7b227e299c 100644 --- a/win32/dl_win32.xs +++ b/win32/dl_win32.xs @@ -36,11 +36,11 @@ dl_private_init() static int dl_static_linked(char *filename) { - char **p; + char **p; for (p = staticlinkmodules; *p;p++) { - if (strstr(filename, *p)) return 1; - }; - return 0; + if (strstr(filename, *p)) return 1; + }; + return 0; } MODULE = DynaLoader PACKAGE = DynaLoader @@ -55,10 +55,10 @@ dl_load_file(filename,flags=0) PREINIT: CODE: DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename)); - if (dl_static_linked(filename) == 0) - RETVAL = (void*) LoadLibraryEx(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ; - else - RETVAL = (void*) GetModuleHandle(NULL); + if (dl_static_linked(filename) == 0) + RETVAL = (void*) LoadLibraryEx(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ; + else + RETVAL = (void*) GetModuleHandle(NULL); DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) @@ -73,7 +73,7 @@ dl_find_symbol(libhandle, symbolname) char * symbolname CODE: DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n", - libhandle, symbolname)); + libhandle, symbolname)); RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname); DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL)); ST(0) = sv_newmortal() ; @@ -98,8 +98,8 @@ dl_install_xsub(perl_name, symref, filename="$Package") char * filename CODE: DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", - perl_name, symref)); - ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); + perl_name, symref)); + ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(CV*))symref, filename))); char * diff --git a/win32/dosish.h b/win32/dosish.h index cca452b9f2..8e423fa8fa 100644 --- a/win32/dosish.h +++ b/win32/dosish.h @@ -80,10 +80,10 @@ void Perl_DJGPP_init(); #define Fflush(fp) fflush(fp) #define my_getenv(var) getenv(var) -// -// the following are standard library calls (stdio in particular) -// that is being redirected to the perl DLL. This is needed for -// Dynaloading any modules that called stdio functions -// +/* + * the following are standard library calls (stdio in particular) + * that is being redirected to the perl DLL. This is needed for + * Dynaloading any modules that called stdio functions + */ #include <win32iop.h> diff --git a/win32/libperl.mak b/win32/libperl.mak index 2298c1129e..3fe30ffa8d 100644 --- a/win32/libperl.mak +++ b/win32/libperl.mak @@ -86,9 +86,9 @@ CLEAN : "$(INTDIR)" : if not exist "$(INTDIR)/$(NULL)" mkdir "$(INTDIR)" -# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MT /W3 /GX /Od /I ".\include" /I ".." /I "." /D "WIN32" /D "NDEBUG" /D "PERLDLL" /D "_WINDOWS" /YX /c -CPP_PROJ=/nologo /MT /W3 /GX /Od /I ".\include" /I ".." /I "." /D "WIN32" /D\ +# ADD BASE CPP /nologo /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MT /W3 /Od /I ".\include" /I ".." /I "." /D "WIN32" /D "NDEBUG" /D "PERLDLL" /D "_WINDOWS" /YX /c +CPP_PROJ=/nologo /MT /W3 /Od /I ".\include" /I ".." /I "." /D "WIN32" /D\ "NDEBUG" /D "PERLDLL" /D "_WINDOWS" /Fp"$(INTDIR)/libperl.pch" /YX\ /Fo"$(INTDIR)/" /c CPP_OBJS=.\Release/ @@ -188,9 +188,9 @@ CLEAN : "$(INTDIR)" : if not exist "$(INTDIR)/$(NULL)" mkdir "$(INTDIR)" -# ADD BASE CPP /nologo /W3 /GX /Z7 /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MTd /W3 /GX /Z7 /Od /I ".\include" /I ".." /I "." /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c -CPP_PROJ=/nologo /MTd /W3 /GX /Z7 /Od /I ".\include" /I ".." /I "." /D "WIN32"\ +# ADD BASE CPP /nologo /W3 /Z7 /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MTd /W3 /Z7 /Od /I ".\include" /I ".." /I "." /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +CPP_PROJ=/nologo /MTd /W3 /Z7 /Od /I ".\include" /I ".." /I "." /D "WIN32"\ /D "_DEBUG" /D "_WINDOWS" /Fp"$(INTDIR)/libperl.pch" /YX /Fo"$(INTDIR)/" /c CPP_OBJS=.\Debug/ CPP_SBRS=.\. diff --git a/win32/makedef.pl b/win32/makedef.pl index f118aaf215..dfd507a865 100644 --- a/win32/makedef.pl +++ b/win32/makedef.pl @@ -102,6 +102,7 @@ Perl_scan_str Perl_scan_subst Perl_scan_trans Perl_scan_word +Perl_setenv_getix Perl_skipspace Perl_sublex_done Perl_sublex_start @@ -134,6 +135,9 @@ Perl_safexcalloc Perl_safexmalloc Perl_safexfree Perl_safexrealloc +Perl_my_memcmp +Perl_cshlen +Perl_cshname !END!OF!SKIP! # All symbols have a Perl_ prefix because that's what embed.h @@ -210,3 +214,47 @@ win32_inet_ntoa win32_htons win32_ntohs win32_htonl +win32_stat +win32_errno +win32_stderr +win32_stdin +win32_stdout +win32_ferror +win32_feof +win32_strerror +win32_fprintf +win32_printf +win32_vfprintf +win32_fread +win32_fwrite +win32_fopen +win32_fdopen +win32_freopen +win32_fclose +win32_fputs +win32_fputc +win32_ungetc +win32_getc +win32_fileno +win32_clearerr +win32_fflush +win32_ftell +win32_fseek +win32_fgetpos +win32_fsetpos +win32_rewind +win32_tmpfile +win32_abort +win32_fstat +win32_pipe +win32_popen +win32_pclose +win32_setmode +win32_open +win32_close +win32_dup +win32_dup2 +win32_read +win32_write +win32_spawnvpe +win32_spawnle diff --git a/win32/miniperl.mak b/win32/miniperl.mak index da3daf986f..9e6e2a4a15 100644 --- a/win32/miniperl.mak +++ b/win32/miniperl.mak @@ -64,9 +64,9 @@ CLEAN : "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /YX /c -# ADD CPP /nologo /MT /W3 /GX /Od /I "." /I ".\include" /I ".." /D "NDEBUG" /D "WIN32" /D "_CONSOLE" /D "PERLDLL" /YX /c -CPP_PROJ=/nologo /MT /W3 /GX /Od /I "." /I ".\include" /I ".." /D "NDEBUG" /D\ +# ADD BASE CPP /nologo /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /YX /c +# ADD CPP /nologo /MT /W3 /Od /I "." /I ".\include" /I ".." /D "NDEBUG" /D "WIN32" /D "_CONSOLE" /D "PERLDLL" /YX /c +CPP_PROJ=/nologo /MT /W3 /Od /I "." /I ".\include" /I ".." /D "NDEBUG" /D\ "WIN32" /D "_CONSOLE" /D "PERLDLL" /Fp"$(INTDIR)/miniperl.pch" /YX\ /Fo"$(INTDIR)/" /c CPP_OBJS=.\Release/ @@ -131,9 +131,9 @@ CLEAN : "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c -# ADD CPP /nologo /MTd /W3 /Gm /GX /Zi /Od /I "." /I ".\include" /I ".." /D "_DEBUG" /D "WIN32" /D "_CONSOLE" /D "PERLDLL" /YX /c -CPP_PROJ=/nologo /MTd /W3 /Gm /GX /Zi /Od /I "." /I ".\include" /I ".." /D\ +# ADD BASE CPP /nologo /W3 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c +# ADD CPP /nologo /MTd /W3 /Gm /Zi /Od /I "." /I ".\include" /I ".." /D "_DEBUG" /D "WIN32" /D "_CONSOLE" /D "PERLDLL" /YX /c +CPP_PROJ=/nologo /MTd /W3 /Gm /Zi /Od /I "." /I ".\include" /I ".." /D\ "_DEBUG" /D "WIN32" /D "_CONSOLE" /D "PERLDLL" /Fp"$(INTDIR)/miniperl.pch" /YX\ /Fo"$(INTDIR)/" /Fd"$(INTDIR)/" /c CPP_OBJS=.\Debug/ @@ -364,7 +364,7 @@ NODEP_CPP_WIN32S=\ ################################################################################ # Begin Source File -SOURCE=.\win32aux.cpp +SOURCE=.\win32aux.c DEP_CPP_WIN32A=\ ".\include\sys/socket.h"\ @@ -376,7 +376,7 @@ DEP_CPP_WIN32A=\ ################################################################################ # Begin Source File -SOURCE=.\win32io.cpp +SOURCE=.\win32io.c DEP_CPP_WIN32I=\ ".\include\sys/socket.h"\ ".\win32io.h"\ diff --git a/win32/modules.mak b/win32/modules.mak index 2a6505e959..8c0a546ec2 100644 --- a/win32/modules.mak +++ b/win32/modules.mak @@ -53,22 +53,14 @@ ALL : ".\modules.lib" CLEAN : -@erase "$(INTDIR)\Dynaloader.obj" - -@erase "$(INTDIR)\Fcntl.obj" - -@erase "$(INTDIR)\hash.obj" - -@erase "$(INTDIR)\IO.obj" - -@erase "$(INTDIR)\Opcode.obj" - -@erase "$(INTDIR)\pair.obj" - -@erase "$(INTDIR)\sdbm.obj" - -@erase "$(INTDIR)\SDBM_File.obj" - -@erase "$(INTDIR)\Socket.obj" -@erase ".\modules.lib" "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MT /W3 /GX /O2 /I ".\include" /I "." /I ".." /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" /YX /c -CPP_PROJ=/nologo /MT /W3 /GX /O2 /I ".\include" /I "." /I ".." /D "NDEBUG" /D\ +# ADD BASE CPP /nologo /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" /YX /c +CPP_PROJ=/nologo /MT /W3 /O2 /I ".\include" /I "." /I ".." /D "NDEBUG" /D\ "WIN32" /D "_WINDOWS" /D "MSDOS" /Fp"$(INTDIR)/modules.pch" /YX /Fo"$(INTDIR)/"\ /c CPP_OBJS=.\Release/ @@ -84,15 +76,7 @@ LIB32=link.exe -lib # ADD LIB32 /nologo /out:"modules.lib" LIB32_FLAGS=/nologo /out:"modules.lib" LIB32_OBJS= \ - "$(INTDIR)\Dynaloader.obj" \ - "$(INTDIR)\Fcntl.obj" \ - "$(INTDIR)\hash.obj" \ - "$(INTDIR)\IO.obj" \ - "$(INTDIR)\Opcode.obj" \ - "$(INTDIR)\pair.obj" \ - "$(INTDIR)\sdbm.obj" \ - "$(INTDIR)\SDBM_File.obj" \ - "$(INTDIR)\Socket.obj" + "$(INTDIR)\Dynaloader.obj" ".\modules.lib" : "$(OUTDIR)" $(DEF_FILE) $(LIB32_OBJS) $(LIB32) @<< @@ -118,22 +102,14 @@ ALL : ".\modules.lib" CLEAN : -@erase "$(INTDIR)\Dynaloader.obj" - -@erase "$(INTDIR)\Fcntl.obj" - -@erase "$(INTDIR)\hash.obj" - -@erase "$(INTDIR)\IO.obj" - -@erase "$(INTDIR)\Opcode.obj" - -@erase "$(INTDIR)\pair.obj" - -@erase "$(INTDIR)\sdbm.obj" - -@erase "$(INTDIR)\SDBM_File.obj" - -@erase "$(INTDIR)\Socket.obj" -@erase ".\modules.lib" "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /W3 /GX /Z7 /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MTd /W3 /GX /Z7 /Od /I ".\include" /I "." /I ".." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" /YX /c -CPP_PROJ=/nologo /MTd /W3 /GX /Z7 /Od /I ".\include" /I "." /I ".." /D "_DEBUG"\ +# ADD BASE CPP /nologo /W3 /Z7 /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MTd /W3 /Z7 /Od /I ".\include" /I "." /I ".." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "MSDOS" /YX /c +CPP_PROJ=/nologo /MTd /W3 /Z7 /Od /I ".\include" /I "." /I ".." /D "_DEBUG"\ /D "WIN32" /D "_WINDOWS" /D "MSDOS" /Fp"$(INTDIR)/modules.pch" /YX\ /Fo"$(INTDIR)/" /c CPP_OBJS=.\Debug/ @@ -149,15 +125,7 @@ LIB32=link.exe -lib # ADD LIB32 /nologo /out:"modules.lib" LIB32_FLAGS=/nologo /out:"modules.lib" LIB32_OBJS= \ - "$(INTDIR)\Dynaloader.obj" \ - "$(INTDIR)\Fcntl.obj" \ - "$(INTDIR)\hash.obj" \ - "$(INTDIR)\IO.obj" \ - "$(INTDIR)\Opcode.obj" \ - "$(INTDIR)\pair.obj" \ - "$(INTDIR)\sdbm.obj" \ - "$(INTDIR)\SDBM_File.obj" \ - "$(INTDIR)\Socket.obj" + "$(INTDIR)\Dynaloader.obj" ".\modules.lib" : "$(OUTDIR)" $(DEF_FILE) $(LIB32_OBJS) $(LIB32) @<< diff --git a/win32/perl.mak b/win32/perl.mak index 13a1e18866..558717c97d 100644 --- a/win32/perl.mak +++ b/win32/perl.mak @@ -59,9 +59,9 @@ CLEAN : "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /YX /c -# ADD CPP /nologo /MT /W3 /GX /O2 /I "." /I ".\include" /I ".." /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /YX /c -CPP_PROJ=/nologo /MT /W3 /GX /O2 /I "." /I ".\include" /I ".." /D "WIN32" /D\ +# ADD BASE CPP /nologo /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /YX /c +# ADD CPP /nologo /MT /W3 /O2 /I "." /I ".\include" /I ".." /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /YX /c +CPP_PROJ=/nologo /MT /W3 /O2 /I "." /I ".\include" /I ".." /D "WIN32" /D\ "NDEBUG" /D "_CONSOLE" /Fp"$(INTDIR)/perl.pch" /YX /Fo"$(INTDIR)/" /c CPP_OBJS=.\Release/ CPP_SBRS=.\. @@ -119,9 +119,9 @@ CLEAN : "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c -# ADD CPP /nologo /MTd /W3 /Gm /GX /Zi /Od /I "." /I ".\include" /I ".." /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c -CPP_PROJ=/nologo /MTd /W3 /Gm /GX /Zi /Od /I "." /I ".\include" /I ".." /D\ +# ADD BASE CPP /nologo /W3 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c +# ADD CPP /nologo /MTd /W3 /Gm /Zi /Od /I "." /I ".\include" /I ".." /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c +CPP_PROJ=/nologo /MTd /W3 /Gm /Zi /Od /I "." /I ".\include" /I ".." /D\ "WIN32" /D "_DEBUG" /D "_CONSOLE" /Fp"$(INTDIR)/perl.pch" /YX /Fo"$(INTDIR)/"\ /Fd"$(INTDIR)/" /c CPP_OBJS=.\Debug/ @@ -210,7 +210,7 @@ SOURCE=..\perl.lib ################################################################################ # Begin Source File -SOURCE=.\win32io.cpp +SOURCE=.\win32io.c DEP_CPP_WIN32=\ ".\include\sys/socket.h"\ ".\win32io.h"\ diff --git a/win32/perldll.mak b/win32/perldll.mak index 01aea72150..eb308771a3 100644 --- a/win32/perldll.mak +++ b/win32/perldll.mak @@ -70,9 +70,9 @@ CLEAN : "$(INTDIR)" : if not exist "$(INTDIR)/$(NULL)" mkdir "$(INTDIR)" -# ADD BASE CPP /nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MT /W3 /GX /O2 /I "." /I ".\include" /I ".." /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "PERLDLL" /YX /c -CPP_PROJ=/nologo /MT /W3 /GX /O2 /I "." /I ".\include" /I ".." /D "NDEBUG" /D\ +# ADD BASE CPP /nologo /MT /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MT /W3 /O2 /I "." /I ".\include" /I ".." /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "PERLDLL" /YX /c +CPP_PROJ=/nologo /MT /W3 /O2 /I "." /I ".\include" /I ".." /D "NDEBUG" /D\ "WIN32" /D "_WINDOWS" /D "PERLDLL" /Fp"$(INTDIR)/perldll.pch" /YX\ /Fo"$(INTDIR)/" /c CPP_OBJS=.\release/ @@ -145,9 +145,9 @@ CLEAN : "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /MTd /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c -# ADD CPP /nologo /MTd /W3 /Gm /GX /Zi /Od /I "." /I ".\include" /I ".." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "PERLDLL" /YX /c -CPP_PROJ=/nologo /MTd /W3 /Gm /GX /Zi /Od /I "." /I ".\include" /I ".." /D\ +# ADD BASE CPP /nologo /MTd /W3 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c +# ADD CPP /nologo /MTd /W3 /Gm /Zi /Od /I "." /I ".\include" /I ".." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "PERLDLL" /YX /c +CPP_PROJ=/nologo /MTd /W3 /Gm /Zi /Od /I "." /I ".\include" /I ".." /D\ "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "PERLDLL" /Fp"$(INTDIR)/perldll.pch" /YX\ /Fo"$(INTDIR)/" /Fd"$(INTDIR)/" /c CPP_OBJS=.\debug/ @@ -390,7 +390,7 @@ DEP_CPP_WIN32_=\ ################################################################################ # Begin Source File -SOURCE=.\win32aux.cpp +SOURCE=.\win32aux.c DEP_CPP_WIN32A=\ ".\include\sys/socket.h"\ ".\win32io.h"\ @@ -418,7 +418,7 @@ SOURCE=.\modules.lib ################################################################################ # Begin Source File -SOURCE=.\win32io.cpp +SOURCE=.\win32io.c DEP_CPP_WIN32I=\ ".\include\sys/socket.h"\ ".\win32io.h"\ diff --git a/win32/perlglob.c b/win32/perlglob.c index 6413b37ddd..87e8e90cd4 100644 --- a/win32/perlglob.c +++ b/win32/perlglob.c @@ -31,7 +31,7 @@ main(int argc, char *argv[]) } } - _setmode(_fileno(stdout), _O_BINARY); + _setmode(_fileno(stdout), _O_BINARY); for (i = 1; i < argc; i++) { len = strlen(argv[i]); if (downcase) diff --git a/win32/perlglob.mak b/win32/perlglob.mak index 0a4c0bffcf..6a1dabf3c4 100644 --- a/win32/perlglob.mak +++ b/win32/perlglob.mak @@ -60,9 +60,9 @@ CLEAN : "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /YX /c -# ADD CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /YX /c -CPP_PROJ=/nologo /ML /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE"\ +# ADD BASE CPP /nologo /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /YX /c +# ADD CPP /nologo /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /YX /c +CPP_PROJ=/nologo /ML /W3 /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE"\ /Fp"$(INTDIR)/perlglob.pch" /YX /Fo"$(INTDIR)/" /c CPP_OBJS=.\release/ CPP_SBRS= @@ -116,9 +116,9 @@ CLEAN : "$(OUTDIR)" : if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" -# ADD BASE CPP /nologo /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c -# ADD CPP /nologo /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c -CPP_PROJ=/nologo /MLd /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE"\ +# ADD BASE CPP /nologo /W3 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c +# ADD CPP /nologo /W3 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /YX /c +CPP_PROJ=/nologo /MLd /W3 /Gm /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE"\ /Fp"$(INTDIR)/perlglob.pch" /YX /Fo"$(INTDIR)/" /Fd"$(INTDIR)/" /c CPP_OBJS=.\debug/ CPP_SBRS= diff --git a/win32/perllib.c b/win32/perllib.c index f35d41c8bf..13d4b8b000 100644 --- a/win32/perllib.c +++ b/win32/perllib.c @@ -1,12 +1,3 @@ -#ifdef ABC -#define WIN32_LEAN_AND_MEAN -#include <windows.h> -#include <stdio.h> -#include <stdlib.h> -#include <fcntl.h> -#include <io.h> -#endif - /* * "The Road goes ever on and on, down from the door where it began." */ @@ -27,94 +18,94 @@ extern "C" { static void xs_init _((void)); -__declspec(dllexport) int RunPerl(int argc, char **argv, char **env, void *iosubsystem) +__declspec(dllexport) int +RunPerl(int argc, char **argv, char **env, void *iosubsystem) { - int exitstatus; - PerlInterpreter *my_perl; - void *pOldIOSubsystem; + int exitstatus; + PerlInterpreter *my_perl; + void *pOldIOSubsystem; - pOldIOSubsystem = SetIOSubSystem(iosubsystem); + pOldIOSubsystem = SetIOSubSystem(iosubsystem); PERL_SYS_INIT(&argc,&argv); perl_init_i18nl10n(1); - if (!(my_perl = perl_alloc())) return (1); - perl_construct( my_perl ); - perl_destruct_level = 0; - + if (!(my_perl = perl_alloc())) + return (1); + perl_construct( my_perl ); + perl_destruct_level = 0; exitstatus = perl_parse( my_perl, xs_init, argc, argv, env); if (!exitstatus) { exitstatus = perl_run( my_perl ); } - perl_destruct( my_perl ); perl_free( my_perl ); PERL_SYS_TERM(); - SetIOSubSystem(pOldIOSubsystem); + SetIOSubSystem(pOldIOSubsystem); - return (exitstatus); + return (exitstatus); } /* Register any extra external extensions */ -char *staticlinkmodules[]={ - "DynaLoader", - NULL, - }; +char *staticlinkmodules[] = { + "DynaLoader", + NULL, +}; EXTERN_C void boot_DynaLoader _((CV* cv)); static void xs_init() { - dXSUB_SYS; - char *file = __FILE__; - newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); + dXSUB_SYS; + char *file = __FILE__; + newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); } extern HANDLE PerlDllHandle; -BOOL APIENTRY DllMain(HANDLE hModule, // DLL module handle - DWORD fdwReason, // reason called - LPVOID lpvReserved) // reserved +BOOL APIENTRY +DllMain(HANDLE hModule, /* DLL module handle */ + DWORD fdwReason, /* reason called */ + LPVOID lpvReserved) /* reserved */ { - switch (fdwReason) - { - // The DLL is attaching to a process due to process - // initialization or a call to LoadLibrary. - case DLL_PROCESS_ATTACH: -//#define DEFAULT_BINMODE + switch (fdwReason) { + /* The DLL is attaching to a process due to process + * initialization or a call to LoadLibrary. + */ + case DLL_PROCESS_ATTACH: +/* #define DEFAULT_BINMODE */ #ifdef DEFAULT_BINMODE - _setmode( _fileno( stdin ), _O_BINARY ); - _setmode( _fileno( stdout ), _O_BINARY ); - _setmode( _fileno( stderr ), _O_BINARY ); - _fmode = _O_BINARY; + _setmode( _fileno( stdin ), _O_BINARY ); + _setmode( _fileno( stdout ), _O_BINARY ); + _setmode( _fileno( stderr ), _O_BINARY ); + _fmode = _O_BINARY; #endif + PerlDllHandle = hModule; + break; - PerlDllHandle = hModule; - break; + /* The DLL is detaching from a process due to + * process termination or call to FreeLibrary. + */ + case DLL_PROCESS_DETACH: + break; - // The DLL is detaching from a process due to - // process termination or call to FreeLibrary. - case DLL_PROCESS_DETACH: - break; + /* The attached process creates a new thread. */ + case DLL_THREAD_ATTACH: + break; - // The attached process creates a new thread. - case DLL_THREAD_ATTACH: - break; + /* The thread of the attached process terminates. */ + case DLL_THREAD_DETACH: + break; - // The thread of the attached process terminates. - case DLL_THREAD_DETACH: - break; - - default: - break; - } - return TRUE; + default: + break; + } + return TRUE; } - diff --git a/win32/splittree.pl b/win32/splittree.pl index 9f7f929477..3c76daadb1 100644 --- a/win32/splittree.pl +++ b/win32/splittree.pl @@ -8,7 +8,7 @@ if (defined $d) { while (defined($_ = $d->read)) { next if $_ eq "."; next if $_ eq ".."; - my $entry = "$base/$_"; + my $entry = "$base\\$_"; my $entrywithouttop = $entry; $entrywithouttop =~ s/^$top//; if (-d $entry) {splitthis ($top,$entry,$dest);} diff --git a/win32/win32.c b/win32/win32.c index e9e5af2a5f..2e025ce152 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -1,18 +1,19 @@ -// WIN32.C - -// (c) 1995 Microsoft Corporation. All rights reserved. -// Developed by hip communications inc., http://info.hip.com/info/ -// Portions (c) 1993 Intergraph Corporation. All rights reserved. - -// You may distribute under the terms of either the GNU General Public -// License or the Artistic License, as specified in the README file. +/* WIN32.C + * + * (c) 1995 Microsoft Corporation. All rights reserved. + * Developed by hip communications inc., http://info.hip.com/info/ + * Portions (c) 1993 Intergraph Corporation. All rights reserved. + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + */ #define WIN32_LEAN_AND_MEAN #define WIN32IO_IS_STDIO #include <tchar.h> #include <windows.h> -//#include "config.h" +/* #include "config.h" */ #define PERLIO_NOT_STDIO 0 #if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO) @@ -32,7 +33,7 @@ extern WIN32_IOSUBSYSTEM win32stdio; __declspec(thread) PWIN32_IOSUBSYSTEM pIOSubSystem = &win32stdio; -//__declspec(thread) PWIN32_IOSUBSYSTEM pIOSubSystem = NULL; +/*__declspec(thread) PWIN32_IOSUBSYSTEM pIOSubSystem = NULL;*/ BOOL ProbeEnv = FALSE; DWORD Win32System; @@ -43,103 +44,109 @@ HANDLE PerlDllHandle = INVALID_HANDLE_VALUE; #define IsWin95() (Win32System == VER_PLATFORM_WIN32_WINDOWS) #define IsWinNT() (Win32System == VER_PLATFORM_WIN32_NT) -void *SetIOSubSystem(void *p) +void * +SetIOSubSystem(void *p) { - if (p) { - PWIN32_IOSUBSYSTEM pio = (PWIN32_IOSUBSYSTEM)p; + if (p) { + PWIN32_IOSUBSYSTEM pio = (PWIN32_IOSUBSYSTEM)p; - if (pio->signature_begin == 12345678L && pio->signature_end == 87654321L) { - PWIN32_IOSUBSYSTEM pold = pIOSubSystem; - pIOSubSystem = pio; - return pold; - } - } - else { - // re-assign our stuff -// pIOSubSystem = &win32stdio; - pIOSubSystem = NULL; - } + if (pio->signature_begin == 12345678L + && pio->signature_end == 87654321L) { + PWIN32_IOSUBSYSTEM pold = pIOSubSystem; + pIOSubSystem = pio; + return pold; + } + } + else { + /* re-assign our stuff */ +/* pIOSubSystem = &win32stdio; */ + pIOSubSystem = NULL; + } + return pIOSubSystem; +} + +char * +win32PerlLibPath(void) +{ + char *end; + GetModuleFileName((PerlDllHandle == INVALID_HANDLE_VALUE) + ? GetModuleHandle(NULL) + : PerlDllHandle, + szPerlLibRoot, + sizeof(szPerlLibRoot)); + + *(end = strrchr(szPerlLibRoot, '\\')) = '\0'; + if (stricmp(end-4,"\\bin") == 0) + end -= 4; + strcpy(end,"\\lib"); + return (szPerlLibRoot); +} - return pIOSubSystem; -} - -char *win32PerlLibPath(void) -{ - - GetModuleFileName((PerlDllHandle == INVALID_HANDLE_VALUE) - ? GetModuleHandle(NULL) : PerlDllHandle, - szPerlLibRoot, - sizeof(szPerlLibRoot)); - - *(strrchr(szPerlLibRoot, '\\')) = '\0'; - strcat(szPerlLibRoot,"\\LIB"); - return (szPerlLibRoot); -} - -BOOL HasRedirection(char *ptr) -{ - int inquote = 0; - char quote = '\0'; - - // - // Scan string looking for redirection (< or >) or pipe - // characters (|) that are not in a quoted string - // - while(*ptr) - { - switch(*ptr) - { - case '\'': - case '\"': - if(inquote) - { - if(quote == *ptr) - { - inquote = 0; - quote = '\0'; - } - } - else - { - quote = *ptr; - inquote++; - } - break; - - case '>': - case '<': - case '|': - if(!inquote) - return TRUE; - - default: - break; +BOOL +HasRedirection(char *ptr) +{ + int inquote = 0; + char quote = '\0'; + + /* + * Scan string looking for redirection (< or >) or pipe + * characters (|) that are not in a quoted string + */ + while(*ptr) { + switch(*ptr) { + case '\'': + case '\"': + if(inquote) { + if(quote == *ptr) { + inquote = 0; + quote = '\0'; } - ++ptr; + } + else { + quote = *ptr; + inquote++; + } + break; + case '>': + case '<': + case '|': + if(!inquote) + return TRUE; + default: + break; } - return FALSE; + ++ptr; + } + return FALSE; } -// since the current process environment is being updated in util.c -// the library functions will get the correct environment -PerlIO *my_popen(char *cmd, char *mode) +/* since the current process environment is being updated in util.c + * the library functions will get the correct environment + */ +PerlIO * +my_popen(char *cmd, char *mode) { #ifdef FIXCMD -#define fixcmd(x) {\ - char *pspace = strchr((x),' ');\ - if (pspace) {\ - char *p = (x);\ - while (p < pspace) {\ - if (*p == '/') *p = '\\';\ - p++;\ - }\ - }\ - } +#define fixcmd(x) { \ + char *pspace = strchr((x),' '); \ + if (pspace) { \ + char *p = (x); \ + while (p < pspace) { \ + if (*p == '/') \ + *p = '\\'; \ + p++; \ + } \ + } \ + } #else #define fixcmd(x) #endif -#ifndef PERLDLL - fixcmd(cmd); + +#if 1 +/* was #ifndef PERLDLL, but the #else stuff doesn't work on NT + * GSAR 97/03/13 + */ + fixcmd(cmd); return win32_popen(cmd, mode); #else /* @@ -154,357 +161,355 @@ PerlIO *my_popen(char *cmd, char *mode) #define EXT_C_FUNC extern # endif -EXT_C_FUNC int __cdecl _set_osfhnd(int fh, long value); -EXT_C_FUNC void __cdecl _lock_fhandle(int); -EXT_C_FUNC void __cdecl _unlock_fhandle(int); - - BOOL fSuccess; - PerlIO *pf; // to store the _popen return value - int tm = 0; /* flag indicating tDllExport or binary mode */ - int fhNeeded, fhInherited, fhDup; - int ineeded, iinherited; - DWORD dwDup; - int phdls[2]; /* I/O handles for pipe */ - HANDLE hPIn, - hPOut, - hPErr, - hSaveStdin, - hSaveStdout, - hSaveStderr, - hPNeeded, hPInherited, hPDuped; + EXT_C_FUNC int __cdecl _set_osfhnd(int fh, long value); + EXT_C_FUNC void __cdecl _lock_fhandle(int); + EXT_C_FUNC void __cdecl _unlock_fhandle(int); + + BOOL fSuccess; + PerlIO *pf; /* to store the _popen return value */ + int tm = 0; /* flag indicating tDllExport or binary mode */ + int fhNeeded, fhInherited, fhDup; + int ineeded, iinherited; + DWORD dwDup; + int phdls[2]; /* I/O handles for pipe */ + HANDLE hPIn, hPOut, hPErr, + hSaveStdin, hSaveStdout, hSaveStderr, + hPNeeded, hPInherited, hPDuped; - /* first check for errors in the arguments - */ - - if ( (cmd == NULL) || (mode == NULL) || ((*mode != 'w') && - (*mode != _T('r'))) ) - goto error1; + /* first check for errors in the arguments */ + if ( (cmd == NULL) || (mode == NULL) + || ((*mode != 'w') && (*mode != _T('r'))) ) + goto error1; if ( *(mode + 1) == _T('t') ) - tm = _O_TEXT; + tm = _O_TEXT; else if ( *(mode + 1) == _T('b') ) - tm = _O_BINARY; - else tm = (*mode == 'w' ? _O_BINARY : _O_TEXT); + tm = _O_BINARY; + else + tm = (*mode == 'w' ? _O_BINARY : _O_TEXT); - fixcmd(cmd); - if (&win32stdio != pIOSubSystem) return win32_popen(cmd, mode); + fixcmd(cmd); + if (&win32stdio != pIOSubSystem) + return win32_popen(cmd, mode); #ifdef EFG if ( _pipe( phdls, 1024, tm ) == -1 ) #else if ( win32_pipe( phdls, 1024, tm ) == -1 ) #endif - goto error1; - - - /* save the current situation */ - - hSaveStdin = GetStdHandle(STD_INPUT_HANDLE); - hSaveStdout = GetStdHandle(STD_OUTPUT_HANDLE); - hSaveStderr = GetStdHandle(STD_ERROR_HANDLE); - - if (*mode == _T('w')) { - ineeded = 1; - dwDup = STD_INPUT_HANDLE; - iinherited = 0; - } - else { - ineeded = 0; - dwDup = STD_OUTPUT_HANDLE; - iinherited = 1; - } - - - fhNeeded = phdls[ineeded]; - fhInherited = phdls[iinherited]; - - fSuccess = DuplicateHandle(GetCurrentProcess(), - (HANDLE) stolen_get_osfhandle(fhNeeded), - GetCurrentProcess(), - &hPNeeded, - 0, - FALSE, /* not inherited */ - DUPLICATE_SAME_ACCESS); - - if (!fSuccess) goto error2; - - fhDup = stolen_open_osfhandle((long) hPNeeded, tm); - win32_dup2(fhDup, fhNeeded); - win32_close(fhDup); + goto error1; + + /* save the current situation */ + hSaveStdin = GetStdHandle(STD_INPUT_HANDLE); + hSaveStdout = GetStdHandle(STD_OUTPUT_HANDLE); + hSaveStderr = GetStdHandle(STD_ERROR_HANDLE); + + if (*mode == _T('w')) { + ineeded = 1; + dwDup = STD_INPUT_HANDLE; + iinherited = 0; + } + else { + ineeded = 0; + dwDup = STD_OUTPUT_HANDLE; + iinherited = 1; + } + + fhNeeded = phdls[ineeded]; + fhInherited = phdls[iinherited]; + + fSuccess = DuplicateHandle(GetCurrentProcess(), + (HANDLE) stolen_get_osfhandle(fhNeeded), + GetCurrentProcess(), + &hPNeeded, + 0, + FALSE, /* not inherited */ + DUPLICATE_SAME_ACCESS); + + if (!fSuccess) + goto error2; + + fhDup = stolen_open_osfhandle((long) hPNeeded, tm); + win32_dup2(fhDup, fhNeeded); + win32_close(fhDup); #ifdef AAA - /* Close the Out pipe, child won't need it */ - hPDuped = (HANDLE) stolen_get_osfhandle(fhNeeded); + /* Close the Out pipe, child won't need it */ + hPDuped = (HANDLE) stolen_get_osfhandle(fhNeeded); - _lock_fhandle(fhNeeded); - _set_osfhnd(fhNeeded, (long) hPNeeded); // put in ours duplicated one - _unlock_fhandle(fhNeeded); + _lock_fhandle(fhNeeded); + _set_osfhnd(fhNeeded, (long)hPNeeded); /* put in ours duplicated one */ + _unlock_fhandle(fhNeeded); - CloseHandle(hPDuped); // close the handle first + CloseHandle(hPDuped); /* close the handle first */ #endif - if (!SetStdHandle(dwDup, (HANDLE) stolen_get_osfhandle(fhInherited))) goto error2; + if (!SetStdHandle(dwDup, (HANDLE) stolen_get_osfhandle(fhInherited))) + goto error2; - // - // make sure the child see the same stderr as the calling program - // - // - if (!SetStdHandle(STD_ERROR_HANDLE, (HANDLE) stolen_get_osfhandle(win32_fileno(win32_stderr())))) goto error2; + /* + * make sure the child see the same stderr as the calling program + */ + if (!SetStdHandle(STD_ERROR_HANDLE, + (HANDLE)stolen_get_osfhandle(win32_fileno(win32_stderr())))) + goto error2; - pf = win32_popen(cmd, mode); // ask _popen to do the job + pf = win32_popen(cmd, mode); /* ask _popen to do the job */ - /* restore to where we were */ + /* restore to where we were */ SetStdHandle(STD_INPUT_HANDLE, hSaveStdin); SetStdHandle(STD_OUTPUT_HANDLE, hSaveStdout); SetStdHandle(STD_ERROR_HANDLE, hSaveStderr); - /* we don't need it any more, that's for the child */ - win32_close(fhInherited); - - if (NULL == pf) { - // something wrong - win32_close(fhNeeded); - goto error1; - } - else { - - /* - * here we steal the file handle in pf and stuff ours in - * - */ - win32_dup2(fhNeeded, win32_fileno(pf)); - win32_close(fhNeeded); - } + /* we don't need it any more, that's for the child */ + win32_close(fhInherited); - return (pf); + if (NULL == pf) { + /* something wrong */ + win32_close(fhNeeded); + goto error1; + } + else { + /* + * here we steal the file handle in pf and stuff ours in + */ + win32_dup2(fhNeeded, win32_fileno(pf)); + win32_close(fhNeeded); + } + return (pf); error2: - win32_close(fhNeeded); - win32_close(fhInherited); + win32_close(fhNeeded); + win32_close(fhInherited); error1: - return (NULL); + return (NULL); #endif } -long my_pclose(PerlIO *fp) +long +my_pclose(PerlIO *fp) { return win32_pclose(fp); } -static void IdOS(void) +static void +IdOS(void) { - OSVERSIONINFO osver; + OSVERSIONINFO osver; - memset(&osver, 0, sizeof(OSVERSIONINFO)); - osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); - GetVersionEx(&osver); - Win32System = osver.dwPlatformId; - return; + memset(&osver, 0, sizeof(OSVERSIONINFO)); + osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); + GetVersionEx(&osver); + Win32System = osver.dwPlatformId; + return; } -static char *GetShell(void) +static char * +GetShell(void) { - static char* szWin95ShellEntry = "Win95Shell"; - static char* szWin95DefaultShell = "Cmd32.exe"; - static char* szWinNTDefaultShell = "cmd.exe"; - - if (!ProbeEnv) { - IdOS(), ProbeEnv = TRUE; - if (IsWin95()) { - strcpy(szShellPath, szWin95DefaultShell); - } - else { - strcpy(szShellPath, szWinNTDefaultShell); - } - } - - return szShellPath; + static char* szWin95ShellEntry = "Win95Shell"; + static char* szWin95DefaultShell = "Cmd32.exe"; + static char* szWinNTDefaultShell = "cmd.exe"; + + if (!ProbeEnv) { + IdOS(), ProbeEnv = TRUE; + if (IsWin95()) { + strcpy(szShellPath, szWin95DefaultShell); + } + else { + strcpy(szShellPath, szWinNTDefaultShell); + } + } + return szShellPath; } -int do_aspawn(void* really, void** mark, void** arglast) +int +do_aspawn(void* really, void** mark, void** arglast) { - char **argv; - char *strPtr; - char *cmd; - int status; - unsigned int length; - int index = 0; + char **argv; + char *strPtr; + char *cmd; + int status; + unsigned int length; + int index = 0; SV *sv = (SV*)really; - SV** pSv = (SV**)mark; - - New(1110, argv, (arglast - mark) + 3, char*); - - if(sv != Nullsv) - { - cmd = SvPV(sv, length); + SV** pSv = (SV**)mark; + + New(1110, argv, (arglast - mark) + 3, char*); + + if(sv != Nullsv) { + cmd = SvPV(sv, length); + } + else { + cmd = GetShell(); + argv[index++] = "/c"; + } + + while(pSv <= (SV**)arglast) { + sv = *pSv++; + strPtr = SvPV(sv, length); + if(strPtr != NULL && *strPtr != '\0') + argv[index++] = strPtr; + } + argv[index++] = 0; + + status = win32_spawnvpe(P_WAIT, cmd, (const char* const*)argv, + (const char* const*)environ); + + Safefree(argv); + + /* set statusvalue the perl variable $? */ + return (statusvalue = status*256); +} + +int +do_spawn(char *cmd) +{ + char **a; + char *s; + char **argv; + int status = -1; + BOOL needToTry = TRUE; + char *shell, *cmd2; + + /* save an extra exec if possible */ + shell = GetShell(); + + /* see if there are shell metacharacters in it */ + if(!HasRedirection(cmd)) { + New(1102,argv, strlen(cmd) / 2 + 2, char*); + New(1103,cmd2, strlen(cmd) + 1, char); + strcpy(cmd2, cmd); + a = argv; + for (s = cmd2; *s;) { + while (*s && isspace(*s)) + s++; + if (*s) + *(a++) = s; + while(*s && !isspace(*s)) + s++; + if(*s) + *s++ = '\0'; } - else - { - cmd = GetShell(); - argv[index++] = "/c"; + *a = Nullch; + if(argv[0]) { + status = win32_spawnvpe(P_WAIT, + argv[0], + (const char* const*)argv, + (const char* const*)environ); + if(status != -1 || errno == 0) + needToTry = FALSE; } - - while(pSv <= (SV**)arglast) - { - sv = *pSv++; - strPtr = SvPV(sv, length); - if(strPtr != NULL && *strPtr != '\0') - argv[index++] = strPtr; - } - argv[index++] = 0; - - status = win32_spawnvpe(P_WAIT, cmd, (const char* const*)argv, (const char* const*)environ); - Safefree(argv); + Safefree(cmd2); + } + if(needToTry) { + status = win32_spawnle(P_WAIT, + shell, + shell, + "/c", cmd, (char*)0, environ); + } - // set statusvalue the perl variable $? - return (statusvalue = status*256); -} - -int do_spawn(char *cmd) -{ - char **a; - char *s; - char **argv; - int status = -1; - BOOL needToTry = TRUE; - char *shell, *cmd2; - - /* save an extra exec if possible */ - shell = GetShell(); - - /* see if there are shell metacharacters in it */ - if(!HasRedirection(cmd)) - { - New(1102,argv, strlen(cmd) / 2 + 2, char*); - - New(1103,cmd2, strlen(cmd) + 1, char); - strcpy(cmd2, cmd); - a = argv; - for(s = cmd2; *s;) - { - while(*s && isspace(*s)) s++; - if(*s) - *(a++) = s; - while(*s && !isspace(*s)) s++; - if(*s) - *s++ = '\0'; - } - *a = Nullch; - if(argv[0]) - { - status = win32_spawnvpe(P_WAIT, argv[0], (const char* const*)argv, (const char* const*)environ); - if(status != -1 || errno == 0) - needToTry = FALSE; - } - Safefree(argv); - Safefree(cmd2); - } - if(needToTry) - { - status = win32_spawnle(P_WAIT, shell, shell, "/c", cmd, (char*)0, environ); - } - - // set statusvalue the perl variable $? - return (statusvalue = status*256); + /* set statusvalue the perl variable $? */ + return (statusvalue = status*256); } #define PATHLEN 1024 -// The idea here is to read all the directory names into a string table -// (separated by nulls) and when one of the other dir functions is called -// return the pointer to the current file name. -DIR *opendir(char *filename) +/* The idea here is to read all the directory names into a string table + * (separated by nulls) and when one of the other dir functions is called + * return the pointer to the current file name. + */ +DIR * +opendir(char *filename) { DIR *p; - long len; - long idx; - char scannamespc[PATHLEN]; - char *scanname = scannamespc; - struct stat sbuf; - WIN32_FIND_DATA FindData; - HANDLE fh; -// char root[_MAX_PATH]; -// char volname[_MAX_PATH]; -// DWORD serial, maxname, flags; -// BOOL downcase; -// char *dummy; - - // check to see if filename is a directory - if(stat(filename, &sbuf) < 0 || sbuf.st_mode & _S_IFDIR == 0) - { - return NULL; - } - - // get the file system characteristics -// if(GetFullPathName(filename, MAX_PATH, root, &dummy)) -// { -// if(dummy = strchr(root, '\\')) -// *++dummy = '\0'; -// if(GetVolumeInformation(root, volname, MAX_PATH, &serial, &maxname, &flags, 0, 0)) -// { -// downcase = !(flags & FS_CASE_IS_PRESERVED); -// } -// } -// else -// { -// downcase = TRUE; -// } - - // Get us a DIR structure - Newz(1501, p, 1, DIR); - if(p == NULL) - return NULL; - - // Create the search pattern - strcpy(scanname, filename); - - if(index("/\\", *(scanname + strlen(scanname) - 1)) == NULL) - strcat(scanname, "/*"); - else - strcat(scanname, "*"); - - // do the FindFirstFile call - fh = FindFirstFile(scanname, &FindData); - if(fh == INVALID_HANDLE_VALUE) - { - return NULL; - } - - // now allocate the first part of the string table for the filenames that we find. - idx = strlen(FindData.cFileName)+1; - New(1502, p->start, idx, char); - if(p->start == NULL) - { - CROAK("opendir: malloc failed!\n"); + long len; + long idx; + char scannamespc[PATHLEN]; + char *scanname = scannamespc; + struct stat sbuf; + WIN32_FIND_DATA FindData; + HANDLE fh; +/* char root[_MAX_PATH];*/ +/* char volname[_MAX_PATH];*/ +/* DWORD serial, maxname, flags;*/ +/* BOOL downcase;*/ +/* char *dummy;*/ + + /* check to see if filename is a directory */ + if(stat(filename, &sbuf) < 0 || sbuf.st_mode & _S_IFDIR == 0) { + return NULL; + } + + /* get the file system characteristics */ +/* if(GetFullPathName(filename, MAX_PATH, root, &dummy)) { + * if(dummy = strchr(root, '\\')) + * *++dummy = '\0'; + * if(GetVolumeInformation(root, volname, MAX_PATH, &serial, + * &maxname, &flags, 0, 0)) { + * downcase = !(flags & FS_CASE_IS_PRESERVED); + * } + * } + * else { + * downcase = TRUE; + * } + */ + /* Get us a DIR structure */ + Newz(1501, p, 1, DIR); + if(p == NULL) + return NULL; + + /* Create the search pattern */ + strcpy(scanname, filename); + + if(index("/\\", *(scanname + strlen(scanname) - 1)) == NULL) + strcat(scanname, "/*"); + else + strcat(scanname, "*"); + + /* do the FindFirstFile call */ + fh = FindFirstFile(scanname, &FindData); + if(fh == INVALID_HANDLE_VALUE) { + return NULL; + } + + /* now allocate the first part of the string table for + * the filenames that we find. + */ + idx = strlen(FindData.cFileName)+1; + New(1502, p->start, idx, char); + if(p->start == NULL) { + CROAK("opendir: malloc failed!\n"); + } + strcpy(p->start, FindData.cFileName); +/* if(downcase) + * strlwr(p->start); + */ + p->nfiles++; + + /* loop finding all the files that match the wildcard + * (which should be all of them in this directory!). + * the variable idx should point one past the null terminator + * of the previous string found. + */ + while (FindNextFile(fh, &FindData)) { + len = strlen(FindData.cFileName); + /* bump the string table size by enough for the + * new name and it's null terminator + */ + Renew(p->start, idx+len+1, char); + if(p->start == NULL) { + CROAK("opendir: malloc failed!\n"); } - strcpy(p->start, FindData.cFileName); -// if(downcase) -// strlwr(p->start); - p->nfiles++; - - // loop finding all the files that match the wildcard - // (which should be all of them in this directory!). - // the variable idx should point one past the null terminator - // of the previous string found. - // - while(FindNextFile(fh, &FindData)) - { - len = strlen(FindData.cFileName); - // bump the string table size by enough for the - // new name and it's null terminator - Renew(p->start, idx+len+1, char); - if(p->start == NULL) - { - CROAK("opendir: malloc failed!\n"); - } - strcpy(&p->start[idx], FindData.cFileName); -// if(downcase) -// strlwr(&p->start[idx]); + strcpy(&p->start[idx], FindData.cFileName); +/* if (downcase) + * strlwr(&p->start[idx]); + */ p->nfiles++; idx += len+1; } @@ -515,470 +520,537 @@ DIR *opendir(char *filename) } -// Readdir just returns the current string pointer and bumps the -// string pointer to the nDllExport entry. -struct direct *readdir(DIR *dirp) +/* Readdir just returns the current string pointer and bumps the + * string pointer to the nDllExport entry. + */ +struct direct * +readdir(DIR *dirp) { - int len; - static int dummy = 0; + int len; + static int dummy = 0; - if(dirp->curr) - { // first set up the structure to return - len = strlen(dirp->curr); - strcpy(dirp->dirstr.d_name, dirp->curr); - dirp->dirstr.d_namlen = len; + if (dirp->curr) { + /* first set up the structure to return */ + len = strlen(dirp->curr); + strcpy(dirp->dirstr.d_name, dirp->curr); + dirp->dirstr.d_namlen = len; - // Fake an inode - dirp->dirstr.d_ino = dummy++; + /* Fake an inode */ + dirp->dirstr.d_ino = dummy++; - // Now set up for the nDllExport call to readdir - dirp->curr += len + 1; - if(dirp->curr >= (dirp->start + dirp->size)) - { - dirp->curr = NULL; - } + /* Now set up for the nDllExport call to readdir */ + dirp->curr += len + 1; + if (dirp->curr >= (dirp->start + dirp->size)) { + dirp->curr = NULL; + } - return &(dirp->dirstr); - } - else - return NULL; + return &(dirp->dirstr); + } + else + return NULL; } -// Telldir returns the current string pointer position -long telldir(DIR *dirp) +/* Telldir returns the current string pointer position */ +long +telldir(DIR *dirp) { return (long) dirp->curr; } -// Seekdir moves the string pointer to a previously saved position (Saved by telldir). -void seekdir(DIR *dirp, long loc) +/* Seekdir moves the string pointer to a previously saved position + *(Saved by telldir). + */ +void +seekdir(DIR *dirp, long loc) { dirp->curr = (char *)loc; } -// Rewinddir resets the string pointer to the start -void rewinddir(DIR *dirp) +/* Rewinddir resets the string pointer to the start */ +void +rewinddir(DIR *dirp) { dirp->curr = dirp->start; } -// free the memory allocated by opendir -int closedir(DIR *dirp) +/* free the memory allocated by opendir */ +int +closedir(DIR *dirp) { Safefree(dirp->start); Safefree(dirp); - return 1; + return 1; } -// -// various stubs -// +/* + * various stubs + */ -// Ownership -// -// Just pretend that everyone is a superuser. NT will let us know if -// we don\'t really have permission to do something. -// +/* Ownership + * + * Just pretend that everyone is a superuser. NT will let us know if + * we don\'t really have permission to do something. + */ #define ROOT_UID ((uid_t)0) #define ROOT_GID ((gid_t)0) -uid_t getuid(void) +uid_t +getuid(void) { - return ROOT_UID; + return ROOT_UID; } -uid_t geteuid(void) +uid_t +geteuid(void) { - return ROOT_UID; + return ROOT_UID; } -gid_t getgid(void) +gid_t +getgid(void) { - return ROOT_GID; + return ROOT_GID; } -gid_t getegid(void) +gid_t +getegid(void) { - return ROOT_GID; + return ROOT_GID; } -int setuid(uid_t uid) +int +setuid(uid_t uid) { - return (uid == ROOT_UID ? 0 : -1); + return (uid == ROOT_UID ? 0 : -1); } -int setgid(gid_t gid) +int +setgid(gid_t gid) { - return (gid == ROOT_GID ? 0 : -1); + return (gid == ROOT_GID ? 0 : -1); } -// -// pretended kill -// -int kill(int pid, int sig) +/* + * pretended kill + */ +int +kill(int pid, int sig) { - HANDLE hProcess= OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid); + HANDLE hProcess= OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid); if (hProcess == NULL) { - CROAK("kill process failed!\n"); - } - else { - if (!TerminateProcess(hProcess, sig)) CROAK("kill process failed!\n"); - CloseHandle(hProcess); - } - return 0; + CROAK("kill process failed!\n"); + } + else { + if (!TerminateProcess(hProcess, sig)) + CROAK("kill process failed!\n"); + CloseHandle(hProcess); + } + return 0; } -// -// File system stuff -// +/* + * File system stuff + */ -int ioctl(int i, unsigned int u, char *data) +int +ioctl(int i, unsigned int u, char *data) { - CROAK("ioctl not implemented!\n"); - return -1; + CROAK("ioctl not implemented!\n"); + return -1; } -unsigned int sleep(unsigned int t) +unsigned int +sleep(unsigned int t) { - Sleep(t*1000); - return 0; + Sleep(t*1000); + return 0; } #undef rename -int myrename(char *OldFileName, char *newname) +int +myrename(char *OldFileName, char *newname) { - if(_access(newname, 0) != -1) - { // file exists - _unlink(newname); - } - return rename(OldFileName, newname); + if(_access(newname, 0) != -1) { /* file exists */ + _unlink(newname); + } + return rename(OldFileName, newname); } -int win32_stat(const char *path, struct stat *buffer) +DllExport int +win32_stat(const char *path, struct stat *buffer) { - char t[MAX_PATH]; - const char *p = path; - int l = strlen(path); + char t[MAX_PATH]; + const char *p = path; + int l = strlen(path); - if (l > 1) { - switch(path[l - 1]) { - case '\\': - case '/': - if (path[l - 2] != ':') { - strncpy(t, path, l - 1); - t[l - 1] = 0; - p = t; - }; - } - } - - return stat(p, buffer); + if (l > 1) { + switch(path[l - 1]) { + case '\\': + case '/': + if (path[l - 2] != ':') { + strncpy(t, path, l - 1); + t[l - 1] = 0; + p = t; + }; + } + } + return stat(p, buffer); } #undef times -int mytimes(struct tms *timebuf) +int +mytimes(struct tms *timebuf) { - clock_t t = clock(); - timebuf->tms_utime = t; - timebuf->tms_stime = 0; - timebuf->tms_cutime = 0; - timebuf->tms_cstime = 0; + clock_t t = clock(); + timebuf->tms_utime = t; + timebuf->tms_stime = 0; + timebuf->tms_cutime = 0; + timebuf->tms_cstime = 0; - return 0; + return 0; } #undef alarm -unsigned int myalarm(unsigned int sec) +unsigned int +myalarm(unsigned int sec) { - // we warn the usuage of alarm function - if (sec != 0) - WARN("dummy function alarm called, program might not function as expected\n"); - return 0; + /* we warn the usuage of alarm function */ + if (sec != 0) + WARN("dummy function alarm called, program might not function as expected\n"); + return 0; } -// -// redirected io subsystem for all XS modules -// -// +/* + * redirected io subsystem for all XS modules + * + */ -DllExport int * win32_errno(void) +DllExport int * +win32_errno(void) { - return (pIOSubSystem->pfnerrno()); + return (pIOSubSystem->pfnerrno()); } -// the rest are the remapped stdio routines -DllExport FILE *win32_stderr(void) +/* the rest are the remapped stdio routines */ +DllExport FILE * +win32_stderr(void) { - return (pIOSubSystem->pfnstderr()); + return (pIOSubSystem->pfnstderr()); } -DllExport FILE *win32_stdin(void) +DllExport FILE * +win32_stdin(void) { - return (pIOSubSystem->pfnstdin()); + return (pIOSubSystem->pfnstdin()); } -DllExport FILE *win32_stdout() +DllExport FILE * +win32_stdout() { - return (pIOSubSystem->pfnstdout()); + return (pIOSubSystem->pfnstdout()); } -DllExport int win32_ferror(FILE *fp) +DllExport int +win32_ferror(FILE *fp) { - return (pIOSubSystem->pfnferror(fp)); + return (pIOSubSystem->pfnferror(fp)); } -DllExport int win32_feof(FILE *fp) +DllExport int +win32_feof(FILE *fp) { - return (pIOSubSystem->pfnfeof(fp)); + return (pIOSubSystem->pfnfeof(fp)); } -// -// Since the errors returned by the socket error function -// WSAGetLastError() are not known by the library routine strerror -// we have to roll our own. -// +/* + * Since the errors returned by the socket error function + * WSAGetLastError() are not known by the library routine strerror + * we have to roll our own. + */ __declspec(thread) char strerror_buffer[512]; -DllExport char *win32_strerror(int e) +DllExport char * +win32_strerror(int e) { - extern int sys_nerr; - DWORD source = 0; + extern int sys_nerr; + DWORD source = 0; - if(e < 0 || e > sys_nerr) - { - if(e < 0) - e = GetLastError(); + if(e < 0 || e > sys_nerr) { + if(e < 0) + e = GetLastError(); - if(FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, &source, e, 0, strerror_buffer, sizeof(strerror_buffer), NULL) == 0) - strcpy(strerror_buffer, "Unknown Error"); - - return strerror_buffer; - } + if(FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, &source, e, 0, + strerror_buffer, sizeof(strerror_buffer), NULL) == 0) + strcpy(strerror_buffer, "Unknown Error"); - return pIOSubSystem->pfnstrerror(e); + return strerror_buffer; + } + return pIOSubSystem->pfnstrerror(e); } -DllExport int win32_fprintf(FILE *fp, const char *format, ...) +DllExport int +win32_fprintf(FILE *fp, const char *format, ...) { - va_list marker; - va_start(marker, format); /* Initialize variable arguments. */ + va_list marker; + va_start(marker, format); /* Initialize variable arguments. */ - return (pIOSubSystem->pfnvfprintf(fp, format, marker)); + return (pIOSubSystem->pfnvfprintf(fp, format, marker)); } -DllExport int win32_printf(const char *format, ...) +DllExport int +win32_printf(const char *format, ...) { - va_list marker; - va_start(marker, format); /* Initialize variable arguments. */ + va_list marker; + va_start(marker, format); /* Initialize variable arguments. */ - return (pIOSubSystem->pfnvprintf(format, marker)); + return (pIOSubSystem->pfnvprintf(format, marker)); } -DllExport int win32_vfprintf(FILE *fp, const char *format, va_list args) +DllExport int +win32_vfprintf(FILE *fp, const char *format, va_list args) { - return (pIOSubSystem->pfnvfprintf(fp, format, args)); + return (pIOSubSystem->pfnvfprintf(fp, format, args)); } -DllExport size_t win32_fread(void *buf, size_t size, size_t count, FILE *fp) +DllExport size_t +win32_fread(void *buf, size_t size, size_t count, FILE *fp) { - return pIOSubSystem->pfnfread(buf, size, count, fp); + return pIOSubSystem->pfnfread(buf, size, count, fp); } -DllExport size_t win32_fwrite(const void *buf, size_t size, size_t count, FILE *fp) +DllExport size_t +win32_fwrite(const void *buf, size_t size, size_t count, FILE *fp) { - return pIOSubSystem->pfnfwrite(buf, size, count, fp); + return pIOSubSystem->pfnfwrite(buf, size, count, fp); } -DllExport FILE *win32_fopen(const char *filename, const char *mode) +DllExport FILE * +win32_fopen(const char *filename, const char *mode) { - if (stricmp(filename, "/dev/null")==0) return pIOSubSystem->pfnfopen("NUL", mode); - return pIOSubSystem->pfnfopen(filename, mode); + if (stricmp(filename, "/dev/null")==0) + return pIOSubSystem->pfnfopen("NUL", mode); + return pIOSubSystem->pfnfopen(filename, mode); } -DllExport FILE *win32_fdopen( int handle, const char *mode) +DllExport FILE * +win32_fdopen( int handle, const char *mode) { - return pIOSubSystem->pfnfdopen(handle, mode); + return pIOSubSystem->pfnfdopen(handle, mode); } -DllExport FILE *win32_freopen( const char *path, const char *mode, FILE *stream) +DllExport FILE * +win32_freopen( const char *path, const char *mode, FILE *stream) { - if (stricmp(path, "/dev/null")==0) return pIOSubSystem->pfnfreopen("NUL", mode, stream); - return pIOSubSystem->pfnfreopen(path, mode, stream); + if (stricmp(path, "/dev/null")==0) + return pIOSubSystem->pfnfreopen("NUL", mode, stream); + return pIOSubSystem->pfnfreopen(path, mode, stream); } -DllExport int win32_fclose(FILE *pf) +DllExport int +win32_fclose(FILE *pf) { - return pIOSubSystem->pfnfclose(pf); + return pIOSubSystem->pfnfclose(pf); } -DllExport int win32_fputs(const char *s,FILE *pf) +DllExport int +win32_fputs(const char *s,FILE *pf) { - return pIOSubSystem->pfnfputs(s, pf); + return pIOSubSystem->pfnfputs(s, pf); } -DllExport int win32_fputc(int c,FILE *pf) +DllExport int +win32_fputc(int c,FILE *pf) { - return pIOSubSystem->pfnfputc(c,pf); + return pIOSubSystem->pfnfputc(c,pf); } -DllExport int win32_ungetc(int c,FILE *pf) +DllExport int +win32_ungetc(int c,FILE *pf) { - return pIOSubSystem->pfnungetc(c,pf); + return pIOSubSystem->pfnungetc(c,pf); } -DllExport int win32_getc(FILE *pf) +DllExport int +win32_getc(FILE *pf) { - return pIOSubSystem->pfngetc(pf); + return pIOSubSystem->pfngetc(pf); } -DllExport int win32_fileno(FILE *pf) +DllExport int +win32_fileno(FILE *pf) { - return pIOSubSystem->pfnfileno(pf); + return pIOSubSystem->pfnfileno(pf); } -DllExport void win32_clearerr(FILE *pf) +DllExport void +win32_clearerr(FILE *pf) { - pIOSubSystem->pfnclearerr(pf); - return; + pIOSubSystem->pfnclearerr(pf); + return; } -DllExport int win32_fflush(FILE *pf) +DllExport int +win32_fflush(FILE *pf) { - return pIOSubSystem->pfnfflush(pf); + return pIOSubSystem->pfnfflush(pf); } -DllExport long win32_ftell(FILE *pf) +DllExport long +win32_ftell(FILE *pf) { - return pIOSubSystem->pfnftell(pf); + return pIOSubSystem->pfnftell(pf); } -DllExport int win32_fseek(FILE *pf,long offset,int origin) +DllExport int +win32_fseek(FILE *pf,long offset,int origin) { - return pIOSubSystem->pfnfseek(pf, offset, origin); + return pIOSubSystem->pfnfseek(pf, offset, origin); } -DllExport int win32_fgetpos(FILE *pf,fpos_t *p) +DllExport int +win32_fgetpos(FILE *pf,fpos_t *p) { - return pIOSubSystem->pfnfgetpos(pf, p); + return pIOSubSystem->pfnfgetpos(pf, p); } -DllExport int win32_fsetpos(FILE *pf,const fpos_t *p) +DllExport int +win32_fsetpos(FILE *pf,const fpos_t *p) { - return pIOSubSystem->pfnfsetpos(pf, p); + return pIOSubSystem->pfnfsetpos(pf, p); } -DllExport void win32_rewind(FILE *pf) +DllExport void +win32_rewind(FILE *pf) { - pIOSubSystem->pfnrewind(pf); - return; + pIOSubSystem->pfnrewind(pf); + return; } -DllExport FILE* win32_tmpfile(void) +DllExport FILE* +win32_tmpfile(void) { - return pIOSubSystem->pfntmpfile(); + return pIOSubSystem->pfntmpfile(); } -DllExport void win32_abort(void) +DllExport void +win32_abort(void) { - pIOSubSystem->pfnabort(); - return; + pIOSubSystem->pfnabort(); + return; } -DllExport int win32_fstat(int fd,struct stat *bufptr) +DllExport int +win32_fstat(int fd,struct stat *bufptr) { - return pIOSubSystem->pfnfstat(fd,bufptr); + return pIOSubSystem->pfnfstat(fd,bufptr); } -DllExport int win32_pipe(int *pfd, unsigned int size, int mode) +DllExport int +win32_pipe(int *pfd, unsigned int size, int mode) { - return pIOSubSystem->pfnpipe(pfd, size, mode); + return pIOSubSystem->pfnpipe(pfd, size, mode); } -DllExport FILE* win32_popen(const char *command, const char *mode) +DllExport FILE* +win32_popen(const char *command, const char *mode) { - return pIOSubSystem->pfnpopen(command, mode); + return pIOSubSystem->pfnpopen(command, mode); } -DllExport int win32_pclose(FILE *pf) +DllExport int +win32_pclose(FILE *pf) { - return pIOSubSystem->pfnpclose(pf); + return pIOSubSystem->pfnpclose(pf); } -DllExport int win32_setmode(int fd, int mode) +DllExport int +win32_setmode(int fd, int mode) { - return pIOSubSystem->pfnsetmode(fd, mode); + return pIOSubSystem->pfnsetmode(fd, mode); } -DllExport int win32_open(const char *path, int flag, ...) +DllExport int +win32_open(const char *path, int flag, ...) { - va_list ap; - int pmode; + va_list ap; + int pmode; va_start(ap, flag); pmode = va_arg(ap, int); va_end(ap); - if (stricmp(path, "/dev/null")==0) return pIOSubSystem->pfnopen("NUL", flag, pmode); - return pIOSubSystem->pfnopen(path,flag,pmode); + if (stricmp(path, "/dev/null")==0) + return pIOSubSystem->pfnopen("NUL", flag, pmode); + return pIOSubSystem->pfnopen(path,flag,pmode); } -DllExport int win32_close(int fd) +DllExport int +win32_close(int fd) { - return pIOSubSystem->pfnclose(fd); + return pIOSubSystem->pfnclose(fd); } -DllExport int win32_dup(int fd) +DllExport int +win32_dup(int fd) { - return pIOSubSystem->pfndup(fd); + return pIOSubSystem->pfndup(fd); } -DllExport int win32_dup2(int fd1,int fd2) +DllExport int +win32_dup2(int fd1,int fd2) { - return pIOSubSystem->pfndup2(fd1,fd2); + return pIOSubSystem->pfndup2(fd1,fd2); } -DllExport int win32_read(int fd, char *buf, unsigned int cnt) +DllExport int +win32_read(int fd, char *buf, unsigned int cnt) { - return pIOSubSystem->pfnread(fd, buf, cnt); + return pIOSubSystem->pfnread(fd, buf, cnt); } -DllExport int win32_write(int fd, const char *buf, unsigned int cnt) +DllExport int +win32_write(int fd, const char *buf, unsigned int cnt) { - return pIOSubSystem->pfnwrite(fd, buf, cnt); + return pIOSubSystem->pfnwrite(fd, buf, cnt); } -DllExport int win32_spawnvpe(int mode, const char *cmdname, const char *const *argv, const char *const *envp) +DllExport int +win32_spawnvpe(int mode, const char *cmdname, + const char *const *argv, const char *const *envp) { - return pIOSubSystem->pfnspawnvpe(mode, cmdname, argv, envp); + return pIOSubSystem->pfnspawnvpe(mode, cmdname, argv, envp); } -DllExport int win32_spawnle(int mode, const char *cmdname, const char *arglist,...) +DllExport int +win32_spawnle(int mode, const char *cmdname, const char *arglist,...) { - const char* const* envp; - const char* const* argp; + const char* const* envp; + const char* const* argp; - argp = &arglist; - while (*argp++) ; + argp = &arglist; + while (*argp++) ; - return pIOSubSystem->pfnspawnvpe(mode, cmdname, &arglist, argp); + return pIOSubSystem->pfnspawnvpe(mode, cmdname, &arglist, argp); } -int stolen_open_osfhandle(long handle, int flags) +int +stolen_open_osfhandle(long handle, int flags) { - return pIOSubSystem->pfn_open_osfhandle(handle, flags); + return pIOSubSystem->pfn_open_osfhandle(handle, flags); } -long stolen_get_osfhandle(int fd) +long +stolen_get_osfhandle(int fd) { - return pIOSubSystem->pfn_get_osfhandle(fd); + return pIOSubSystem->pfn_get_osfhandle(fd); } diff --git a/win32/win32.h b/win32/win32.h index a051bc7261..0a18645d9c 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -1,21 +1,21 @@ -// WIN32.H - -// (c) 1995 Microsoft Corporation. All rights reserved. -// Developed by hip communications inc., http://info.hip.com/info/ - -// You may distribute under the terms of either the GNU General Public -// License or the Artistic License, as specified in the README file. - +/* WIN32.H + * + * (c) 1995 Microsoft Corporation. All rights reserved. + * Developed by hip communications inc., http://info.hip.com/info/ + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + */ #ifndef _INC_WIN32_PERL5 #define _INC_WIN32_PERL5 #define WIN32_LEAN_AND_MEAN #include <windows.h> -#ifdef WIN32_LEAN_AND_MEAN // C file is NOT a Perl5 original. -#define CONTEXT PERL_CONTEXT // Avoid conflict of CONTEXT defs. -#define index strchr // Why 'index'? -#endif //WIN32_LEAN_AND_MEAN +#ifdef WIN32_LEAN_AND_MEAN /* C file is NOT a Perl5 original. */ +#define CONTEXT PERL_CONTEXT /* Avoid conflict of CONTEXT defs. */ +#define index strchr /* Why 'index'? */ +#endif /*WIN32_LEAN_AND_MEAN */ #include <dirent.h> #include <io.h> @@ -23,7 +23,7 @@ #include <stdio.h> #include <direct.h> -// For UNIX compatibility. +/* For UNIX compatibility. */ typedef long uid_t; typedef long gid_t; @@ -45,15 +45,15 @@ extern FILE *myfdopen(int, char *); #undef fdopen #define fdopen myfdopen -#endif // USE_SOCKETS_AS_HANDLES +#endif /* USE_SOCKETS_AS_HANDLES */ -#define STANDARD_C 1 // Perl5 likes standard C. -#define DOSISH 1 // Take advantage of DOSish code in Perl5. +#define STANDARD_C 1 /* Perl5 likes standard C. */ +#define DOSISH 1 /* Take advantage of DOSish code in Perl5. */ -#define OP_BINARY _O_BINARY // Mistake in in pp_sys.c. +#define OP_BINARY _O_BINARY /* Mistake in in pp_sys.c. */ #undef mkdir -#define mkdir(nm, md) _mkdir(nm) // For UNIX compatibility. +#define mkdir(nm, md) _mkdir(nm) /* For UNIX compatibility. */ #undef chdir #define chdir(nm) _chdir(nm) @@ -62,7 +62,7 @@ extern FILE *myfdopen(int, char *); #define rmdir(nm) _rmdir(nm) #undef pipe -#define pipe(fd) win32_pipe((fd), 512, _O_BINARY) // the pipe call is a bit different +#define pipe(fd) win32_pipe((fd), 512, _O_BINARY) /* the pipe call is a bit different */ #undef pause #define pause() sleep((32767L << 16) + 32767) @@ -79,7 +79,7 @@ struct tms { long tms_stime; long tms_cutime; long tms_cstime; - }; +}; unsigned int sleep(unsigned int); char *win32PerlLibPath(); @@ -88,22 +88,21 @@ unsigned int myalarm(unsigned int sec); int do_aspawn(void* really, void** mark, void** arglast); int do_spawn(char *cmd); -typedef char * caddr_t; // In malloc.c (core address). +typedef char * caddr_t; /* In malloc.c (core address). */ -// -// Extension Library, only good for VC -// +/* + * Extension Library, only good for VC + */ #define DllExport __declspec(dllexport) - -// -// handle socket stuff, assuming socket is always available -// +/* + * handle socket stuff, assuming socket is always available + */ #include <sys/socket.h> #include <netdb.h> #pragma warning(disable: 4018 4035 4101 4102 4244 4245 4761) -#endif // _INC_NT_PERL5 +#endif /* _INC_WIN32_PERL5 */ diff --git a/win32/win32aux.c b/win32/win32aux.c new file mode 100644 index 0000000000..526b6999c9 --- /dev/null +++ b/win32/win32aux.c @@ -0,0 +1,40 @@ + +#ifdef __cplusplus +extern "C" { +#endif + +#define WIN32_LEAN_AND_MEAN +#define WIN32IO_IS_STDIO +#define EXT +#include <windows.h> +#include <stdio.h> +#include <stdlib.h> +#include <io.h> +#include <sys/stat.h> +#include <sys/socket.h> +#include <fcntl.h> +#include <assert.h> +#include <errno.h> + +#include "win32iop.h" + +struct servent* +win32_savecopyservent(struct servent*d, struct servent*s, const char *proto) +{ + d->s_name = s->s_name; + d->s_aliases = s->s_aliases; + d->s_port = s->s_port; + if (s->s_proto && strlen(s->s_proto)) + d->s_proto = s->s_proto; + else if (proto && strlen(proto)) + d->s_proto = (char *)proto; + else + d->s_proto = "tcp"; + + return d; +} + +#ifdef __cplusplus +} +#endif + diff --git a/win32/win32io.c b/win32/win32io.c new file mode 100644 index 0000000000..75832240c7 --- /dev/null +++ b/win32/win32io.c @@ -0,0 +1,238 @@ + +#ifdef __cplusplus +extern "C" { +#endif + +#define WIN32_LEAN_AND_MEAN +#define WIN32IO_IS_STDIO +#define EXT +#include <windows.h> +#include <stdio.h> +#include <stdlib.h> +#include <io.h> +#include <sys/stat.h> +#include <sys/socket.h> +#include <fcntl.h> +#include <assert.h> +#include <errno.h> +#include <process.h> + +#include "win32iop.h" + +/* + * The following is just a basic wrapping of the stdio + * + * redirected io subsystem for all XS modules + */ + +static int * +dummy_errno(void) +{ + return (&(errno)); +} + +/* the rest are the remapped stdio routines */ +static FILE * +dummy_stderr(void) +{ + return stderr; +} + +static FILE * +dummy_stdin(void) +{ + return stdin; +} + +static FILE * +dummy_stdout(void) +{ + return stdout; +} + +static int +dummy_globalmode(int mode) +{ + int o = _fmode; + _fmode = mode; + + return o; +} + + +#if defined(_WIN32) && !defined(WIN95_OSFHANDLE_FIXED) && defined(_M_IX86) + +# ifdef __cplusplus +#define EXT_C_FUNC extern "C" +# else +#define EXT_C_FUNC extern +# endif + +EXT_C_FUNC int __cdecl _alloc_osfhnd(void); +EXT_C_FUNC int __cdecl _set_osfhnd(int fh, long value); +EXT_C_FUNC void __cdecl _lock_fhandle(int); +EXT_C_FUNC void __cdecl _unlock_fhandle(int); +EXT_C_FUNC void __cdecl _unlock(int); + +#if (_MSC_VER >= 1000) +typedef struct { + long osfhnd; /* underlying OS file HANDLE */ + char osfile; /* attributes of file (e.g., open in text mode?) */ + char pipech; /* one char buffer for handles opened on pipes */ +#if defined (_MT) && !defined (DLL_FOR_WIN32S) + int lockinitflag; + CRITICAL_SECTION lock; +#endif /* defined (_MT) && !defined (DLL_FOR_WIN32S) */ +} ioinfo; + +EXT_C_FUNC ioinfo * __pioinfo[]; + +#define IOINFO_L2E 5 +#define IOINFO_ARRAY_ELTS (1 << IOINFO_L2E) +#define _pioinfo(i) (__pioinfo[i >> IOINFO_L2E] + (i & (IOINFO_ARRAY_ELTS - 1))) +#define _osfile(i) (_pioinfo(i)->osfile) + +#else /* (_MSC_VER >= 1000) */ +extern char _osfile[]; +#endif /* (_MSC_VER >= 1000) */ + +#define FOPEN 0x01 /* file handle open */ +#define FAPPEND 0x20 /* file handle opened O_APPEND */ +#define FDEV 0x40 /* file handle refers to device */ +#define FTEXT 0x80 /* file handle is in text mode */ + +#define _STREAM_LOCKS 26 /* Table of stream locks */ +#define _LAST_STREAM_LOCK (_STREAM_LOCKS+_NSTREAM_-1) /* Last stream lock */ +#define _FH_LOCKS (_LAST_STREAM_LOCK+1) /* Table of fh locks */ + +/*** +*int _patch_open_osfhandle(long osfhandle, int flags) - open C Runtime file handle +* +*Purpose: +* This function allocates a free C Runtime file handle and associates +* it with the Win32 HANDLE specified by the first parameter. This is a +* temperary fix for WIN95's brain damage GetFileType() error on socket +* we just bypass that call for socket +* +*Entry: +* long osfhandle - Win32 HANDLE to associate with C Runtime file handle. +* int flags - flags to associate with C Runtime file handle. +* +*Exit: +* returns index of entry in fh, if successful +* return -1, if no free entry is found +* +*Exceptions: +* +*******************************************************************************/ + +int +my_open_osfhandle(long osfhandle, int flags) +{ + int fh; + char fileflags; /* _osfile flags */ + + /* copy relevant flags from second parameter */ + fileflags = FDEV; + + if(flags & _O_APPEND) + fileflags |= FAPPEND; + + if(flags & _O_TEXT) + fileflags |= FTEXT; + + /* attempt to allocate a C Runtime file handle */ + if((fh = _alloc_osfhnd()) == -1) { + errno = EMFILE; /* too many open files */ + _doserrno = 0L; /* not an OS error */ + return -1; /* return error to caller */ + } + + /* the file is open. now, set the info in _osfhnd array */ + _set_osfhnd(fh, osfhandle); + + fileflags |= FOPEN; /* mark as open */ + +#if (_MSC_VER >= 1000) + _osfile(fh) = fileflags; /* set osfile entry */ + _unlock_fhandle(fh); +#else + _osfile[fh] = fileflags; /* set osfile entry */ + _unlock(fh+_FH_LOCKS); /* unlock handle */ +#endif + + return fh; /* return handle */ +} +#else + +int __cdecl +stolen_open_osfhandle(long osfhandle, int flags) +{ + return _open_osfhandle(osfhandle, flags); +} +#endif /* _M_IX86 */ + +long +my_get_osfhandle( int filehandle ) +{ + return _get_osfhandle(filehandle); +} + +WIN32_IOSUBSYSTEM win32stdio = { + 12345678L, /* begin of structure; */ + dummy_errno, /* (*pfunc_errno)(void); */ + dummy_stdin, /* (*pfunc_stdin)(void); */ + dummy_stdout, /* (*pfunc_stdout)(void); */ + dummy_stderr, /* (*pfunc_stderr)(void); */ + ferror, /* (*pfunc_ferror)(FILE *fp); */ + feof, /* (*pfunc_feof)(FILE *fp); */ + strerror, /* (*strerror)(int e); */ + vfprintf, /* (*pfunc_vfprintf)(FILE *pf, const char *format, va_list arg); */ + vprintf, /* (*pfunc_vprintf)(const char *format, va_list arg); */ + fread, /* (*pfunc_fread)(void *buf, size_t size, size_t count, FILE *pf); */ + fwrite, /* (*pfunc_fwrite)(void *buf, size_t size, size_t count, FILE *pf); */ + fopen, /* (*pfunc_fopen)(const char *path, const char *mode); */ + fdopen, /* (*pfunc_fdopen)(int fh, const char *mode); */ + freopen, /* (*pfunc_freopen)(const char *path, const char *mode, FILE *pf); */ + fclose, /* (*pfunc_fclose)(FILE *pf); */ + fputs, /* (*pfunc_fputs)(const char *s,FILE *pf); */ + fputc, /* (*pfunc_fputc)(int c,FILE *pf); */ + ungetc, /* (*pfunc_ungetc)(int c,FILE *pf); */ + getc, /* (*pfunc_getc)(FILE *pf); */ + fileno, /* (*pfunc_fileno)(FILE *pf); */ + clearerr, /* (*pfunc_clearerr)(FILE *pf); */ + fflush, /* (*pfunc_fflush)(FILE *pf); */ + ftell, /* (*pfunc_ftell)(FILE *pf); */ + fseek, /* (*pfunc_fseek)(FILE *pf,long offset,int origin); */ + fgetpos, /* (*pfunc_fgetpos)(FILE *pf,fpos_t *p); */ + fsetpos, /* (*pfunc_fsetpos)(FILE *pf,fpos_t *p); */ + rewind, /* (*pfunc_rewind)(FILE *pf); */ + tmpfile, /* (*pfunc_tmpfile)(void); */ + abort, /* (*pfunc_abort)(void); */ + fstat, /* (*pfunc_fstat)(int fd,struct stat *bufptr); */ + stat, /* (*pfunc_stat)(const char *name,struct stat *bufptr); */ + _pipe, /* (*pfunc_pipe)( int *phandles, unsigned int psize, int textmode ); */ + _popen, /* (*pfunc_popen)( const char *command, const char *mode ); */ + _pclose, /* (*pfunc_pclose)( FILE *pf); */ + setmode, /* (*pfunc_setmode)( int fd, int mode); */ + lseek, /* (*pfunc_lseek)( int fd, long offset, int origin); */ + tell, /* (*pfunc_tell)( int fd); */ + dup, /* (*pfunc_dup)( int fd); */ + dup2, /* (*pfunc_dup2)(int h1, int h2); */ + open, /* (*pfunc_open)(const char *path, int oflag,...); */ + close, /* (*pfunc_close)(int fd); */ + eof, /* (*pfunc_eof)(int fd); */ + read, /* (*pfunc_read)(int fd, void *buf, unsigned int cnt); */ + write, /* (*pfunc_write)(int fd, const void *buf, unsigned int cnt); */ + dummy_globalmode, /* (*pfunc_globalmode)(int mode) */ + my_open_osfhandle, + my_get_osfhandle, + spawnvpe, + 87654321L, /* end of structure */ +}; + + +#ifdef __cplusplus +} +#endif + diff --git a/win32/win32io.h b/win32/win32io.h index cb0c692da4..3ebc70aab5 100644 --- a/win32/win32io.h +++ b/win32/win32io.h @@ -2,58 +2,58 @@ #define WIN32IO_H typedef struct { -int signature_begin; -int * (*pfnerrno)(void); +int signature_begin; +int * (*pfnerrno)(void); FILE* (*pfnstdin)(void); FILE* (*pfnstdout)(void); FILE* (*pfnstderr)(void); -int (*pfnferror)(FILE *fp); -int (*pfnfeof)(FILE *fp); +int (*pfnferror)(FILE *fp); +int (*pfnfeof)(FILE *fp); char* (*pfnstrerror)(int e); -int (*pfnvfprintf)(FILE *pf, const char *format, va_list arg); -int (*pfnvprintf)(const char *format, va_list arg); +int (*pfnvfprintf)(FILE *pf, const char *format, va_list arg); +int (*pfnvprintf)(const char *format, va_list arg); size_t (*pfnfread)(void *buf, size_t size, size_t count, FILE *pf); size_t (*pfnfwrite)(const void *buf, size_t size, size_t count, FILE *pf); FILE* (*pfnfopen)(const char *path, const char *mode); FILE* (*pfnfdopen)(int fh, const char *mode); FILE* (*pfnfreopen)(const char *path, const char *mode, FILE *pf); -int (*pfnfclose)(FILE *pf); -int (*pfnfputs)(const char *s,FILE *pf); -int (*pfnfputc)(int c,FILE *pf); -int (*pfnungetc)(int c,FILE *pf); -int (*pfngetc)(FILE *pf); -int (*pfnfileno)(FILE *pf); +int (*pfnfclose)(FILE *pf); +int (*pfnfputs)(const char *s,FILE *pf); +int (*pfnfputc)(int c,FILE *pf); +int (*pfnungetc)(int c,FILE *pf); +int (*pfngetc)(FILE *pf); +int (*pfnfileno)(FILE *pf); void (*pfnclearerr)(FILE *pf); -int (*pfnfflush)(FILE *pf); +int (*pfnfflush)(FILE *pf); long (*pfnftell)(FILE *pf); -int (*pfnfseek)(FILE *pf,long offset,int origin); -int (*pfnfgetpos)(FILE *pf,fpos_t *p); -int (*pfnfsetpos)(FILE *pf,const fpos_t *p); +int (*pfnfseek)(FILE *pf,long offset,int origin); +int (*pfnfgetpos)(FILE *pf,fpos_t *p); +int (*pfnfsetpos)(FILE *pf,const fpos_t *p); void (*pfnrewind)(FILE *pf); FILE* (*pfntmpfile)(void); void (*pfnabort)(void); int (*pfnfstat)(int fd,struct stat *bufptr); int (*pfnstat)(const char *name,struct stat *bufptr); -int (*pfnpipe)( int *phandles, unsigned int psize, int textmode ); +int (*pfnpipe)( int *phandles, unsigned int psize, int textmode ); FILE* (*pfnpopen)( const char *command, const char *mode ); -int (*pfnpclose)( FILE *pf); -int (*pfnsetmode)( int fd, int mode); +int (*pfnpclose)( FILE *pf); +int (*pfnsetmode)( int fd, int mode); long (*pfnlseek)( int fd, long offset, int origin); long (*pfntell)( int fd); -int (*pfndup)( int fd); -int (*pfndup2)(int h1, int h2); -int (*pfnopen)(const char *path, int oflag,...); -int (*pfnclose)(int fd); -int (*pfneof)(int fd); -int (*pfnread)(int fd, void *buf, unsigned int cnt); -int (*pfnwrite)(int fd, const void *buf, unsigned int cnt); -int (*pfnopenmode)(int mode); -int (*pfn_open_osfhandle)(long handle, int flags); +int (*pfndup)( int fd); +int (*pfndup2)(int h1, int h2); +int (*pfnopen)(const char *path, int oflag,...); +int (*pfnclose)(int fd); +int (*pfneof)(int fd); +int (*pfnread)(int fd, void *buf, unsigned int cnt); +int (*pfnwrite)(int fd, const void *buf, unsigned int cnt); +int (*pfnopenmode)(int mode); +int (*pfn_open_osfhandle)(long handle, int flags); long (*pfn_get_osfhandle)(int fd); -int (*pfnspawnvpe)(int mode, const char *cmdname, const char *const *argv, const char *const *envp); +int (*pfnspawnvpe)(int mode, const char *cmdname, const char *const *argv, const char *const *envp); int signature_end; } WIN32_IOSUBSYSTEM; typedef WIN32_IOSUBSYSTEM *PWIN32_IOSUBSYSTEM; -#endif // WIN32IO_H +#endif /* WIN32IO_H */ diff --git a/win32/win32iop.h b/win32/win32iop.h index 7b7a521fe3..c0d1d57255 100644 --- a/win32/win32iop.h +++ b/win32/win32iop.h @@ -5,9 +5,10 @@ /* * Make this as close to original stdio as possible. */ -// -// function prototypes for our own win32io layer -// + +/* + * function prototypes for our own win32io layer + */ EXT int * win32_errno(); EXT FILE* win32_stdin(void); EXT FILE* win32_stdout(void); @@ -16,9 +17,9 @@ EXT int win32_ferror(FILE *fp); EXT int win32_feof(FILE *fp); EXT char* win32_strerror(int e); -EXT int win32_fprintf(FILE *pf, const char *format, ...); -EXT int win32_printf(const char *format, ...); -EXT int win32_vfprintf(FILE *pf, const char *format, va_list arg); +EXT int win32_fprintf(FILE *pf, const char *format, ...); +EXT int win32_printf(const char *format, ...); +EXT int win32_vfprintf(FILE *pf, const char *format, va_list arg); EXT size_t win32_fread(void *buf, size_t size, size_t count, FILE *pf); EXT size_t win32_fwrite(const void *buf, size_t size, size_t count, FILE *pf); EXT FILE* win32_fopen(const char *path, const char *mode); @@ -28,17 +29,17 @@ EXT int win32_fclose(FILE *pf); EXT int win32_fputs(const char *s,FILE *pf); EXT int win32_fputc(int c,FILE *pf); EXT int win32_ungetc(int c,FILE *pf); -EXT int win32_getc(FILE *pf); +EXT int win32_getc(FILE *pf); EXT int win32_fileno(FILE *pf); -EXT void win32_clearerr(FILE *pf); +EXT void win32_clearerr(FILE *pf); EXT int win32_fflush(FILE *pf); EXT long win32_ftell(FILE *pf); -EXT int win32_fseek(FILE *pf,long offset,int origin); -EXT int win32_fgetpos(FILE *pf,fpos_t *p); -EXT int win32_fsetpos(FILE *pf,const fpos_t *p); -EXT void win32_rewind(FILE *pf); -EXT FILE* win32_tmpfile(void); -EXT void win32_abort(void); +EXT int win32_fseek(FILE *pf,long offset,int origin); +EXT int win32_fgetpos(FILE *pf,fpos_t *p); +EXT int win32_fsetpos(FILE *pf,const fpos_t *p); +EXT void win32_rewind(FILE *pf); +EXT FILE* win32_tmpfile(void); +EXT void win32_abort(void); EXT int win32_fstat(int fd,struct stat *bufptr); EXT int win32_stat(const char *name,struct stat *bufptr); EXT int win32_pipe( int *phandles, unsigned int psize, int textmode ); @@ -54,22 +55,23 @@ EXT int win32_close(int fd); EXT int win32_eof(int fd); EXT int win32_read(int fd, void *buf, unsigned int cnt); EXT int win32_write(int fd, const void *buf, unsigned int cnt); -EXT int win32_spawnvpe(int mode, const char *cmdname, const char *const *argv, const char *const *envp); +EXT int win32_spawnvpe(int mode, const char *cmdname, + const char *const *argv, const char *const *envp); EXT int win32_spawnle(int mode, const char *cmdname, const char *,...); -// -// these two are win32 specific but still io related -// +/* + * these two are win32 specific but still io related + */ int stolen_open_osfhandle(long handle, int flags); -long stolen_get_osfhandle(int fd); +long stolen_get_osfhandle(int fd); -#include <win32io.h> // pull in the io sub system structure +#include <win32io.h> /* pull in the io sub system structure */ void * SetIOSubSystem(void *piosubsystem); -// -// the following six(6) is #define in stdio.h -// -// + +/* + * the following six(6) is #define in stdio.h + */ #ifndef WIN32IO_IS_STDIO #undef errno #undef stderr @@ -86,9 +88,9 @@ void * SetIOSubSystem(void *piosubsystem); #define errno (*win32_errno()) #define strerror win32_strerror -// -// redirect to our own version -// +/* + * redirect to our own version + */ #define fprintf win32_fprintf #define vfprintf win32_vfprintf #define printf win32_printf @@ -125,8 +127,8 @@ void * SetIOSubSystem(void *piosubsystem); #define write(fd,b,s) win32_write(fd,b,s) #define _open_osfhandle stolen_open_osfhandle #define _get_osfhandle stolen_get_osfhandle -#define spawnvpe win32_spawnvpe -#define spawnle win32_spawnle -#endif //WIN32IO_IS_STDIO +#define spawnvpe win32_spawnvpe +#define spawnle win32_spawnle +#endif /* WIN32IO_IS_STDIO */ -#endif // WIN32IOP_H +#endif /* WIN32IOP_H */ diff --git a/win32/win32sck.c b/win32/win32sck.c index 126ff1a246..7acb02871c 100644 --- a/win32/win32sck.c +++ b/win32/win32sck.c @@ -1,11 +1,12 @@ -// NTSock.C - -// (c) 1995 Microsoft Corporation. All rights reserved. -// Developed by hip communications inc., http://info.hip.com/info/ -// Portions (c) 1993 Intergraph Corporation. All rights reserved. - -// You may distribute under the terms of either the GNU General Public -// License or the Artistic License, as specified in the README file. +/* NTSock.C + * + * (c) 1995 Microsoft Corporation. All rights reserved. + * Developed by hip communications inc., http://info.hip.com/info/ + * Portions (c) 1993 Intergraph Corporation. All rights reserved. + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + */ #include <windows.h> #define WIN32_LEAN_AND_MEAN @@ -19,10 +20,10 @@ #define CROAK croak #ifdef USE_SOCKETS_AS_HANDLES -// thanks to Beverly Brown (beverly@datacube.com) +/* thanks to Beverly Brown (beverly@datacube.com) */ # if defined(_WIN32) && !defined(WIN95_OSFHANDLE_FIXED) && defined(_M_IX86) -//# define OPEN_SOCKET(x) _patch_open_osfhandle(x, _O_RDWR | _O_BINARY) +/*# define OPEN_SOCKET(x) _patch_open_osfhandle(x, _O_RDWR | _O_BINARY) */ # define OPEN_SOCKET(x) _open_osfhandle(x,_O_RDWR|_O_BINARY) # else # define OPEN_SOCKET(x) _open_osfhandle(x,_O_RDWR|_O_BINARY) @@ -34,17 +35,18 @@ # define OPEN_SOCKET(x) (x) # define TO_SOCKET(x) (x) -#endif // USE_SOCKETS_AS_HANDLES +#endif /* USE_SOCKETS_AS_HANDLES */ -// -// This is a clone of fdopen so that we can handle the version of sockets that NT gets to use. -// -// The problem is that sockets are not real file handles and -// cannot be fdopen'ed. This causes problems in the do_socket -// routine in doio.c, since it tries to create two file pointers -// for the socket just created. We'll fake out an fdopen and see -// if we can prevent perl from trying to do stdio on sockets. -// +/* + * This is a clone of fdopen so that we can handle the version of + * sockets that NT gets to use. + * + * The problem is that sockets are not real file handles and + * cannot be fdopen'ed. This causes problems in the do_socket + * routine in doio.c, since it tries to create two file pointers + * for the socket just created. We'll fake out an fdopen and see + * if we can prevent perl from trying to do stdio on sockets. + */ #if defined(_WIN32) && !defined(WIN95_OSFHANDLE_FIXED) && defined(_M_IX86) @@ -59,38 +61,38 @@ EXT_C_FUNC int __cdecl _set_osfhnd(int fh, long value); EXT_C_FUNC void __cdecl _lock_fhandle(int); EXT_C_FUNC void __cdecl _unlock_fhandle(int); EXT_C_FUNC void __cdecl _unlock(int); -EXT_C_FUNC struct servent* win32_savecopyservent(struct servent*d, struct servent*s, const char *proto); +EXT_C_FUNC struct servent* win32_savecopyservent(struct servent*d, + struct servent*s, const char *proto); #if (_MSC_VER >= 1000) - typedef struct - { - long osfhnd; /* underlying OS file HANDLE */ - char osfile; /* attributes of file (e.g., open in text mode?) */ - char pipech; /* one char buffer for handles opened on pipes */ +typedef struct { + long osfhnd; /* underlying OS file HANDLE */ + char osfile; /* attributes of file (e.g., open in text mode?) */ + char pipech; /* one char buffer for handles opened on pipes */ #if defined (_MT) && !defined (DLL_FOR_WIN32S) - int lockinitflag; - CRITICAL_SECTION lock; + int lockinitflag; + CRITICAL_SECTION lock; #endif /* defined (_MT) && !defined (DLL_FOR_WIN32S) */ - } ioinfo; +} ioinfo; - EXT_C_FUNC ioinfo * __pioinfo[]; +EXT_C_FUNC ioinfo * __pioinfo[]; - #define IOINFO_L2E 5 - #define IOINFO_ARRAY_ELTS (1 << IOINFO_L2E) - #define _pioinfo(i) (__pioinfo[i >> IOINFO_L2E] + (i & (IOINFO_ARRAY_ELTS - 1))) - #define _osfile(i) (_pioinfo(i)->osfile) -#else - extern "C" extern char _osfile[]; -#endif // (_MSC_VER >= 1000) +#define IOINFO_L2E 5 +#define IOINFO_ARRAY_ELTS (1 << IOINFO_L2E) +#define _pioinfo(i) (__pioinfo[i >> IOINFO_L2E] + (i & (IOINFO_ARRAY_ELTS - 1))) +#define _osfile(i) (_pioinfo(i)->osfile) +#else /* (_MSC_VER >= 1000) */ + extern char _osfile[]; +#endif /* (_MSC_VER >= 1000) */ -#define FOPEN 0x01 // file handle open -#define FAPPEND 0x20 // file handle opened O_APPEND -#define FDEV 0x40 // file handle refers to device -#define FTEXT 0x80 // file handle is in text mode +#define FOPEN 0x01 /* file handle open */ +#define FAPPEND 0x20 /* file handle opened O_APPEND */ +#define FDEV 0x40 /* file handle refers to device */ +#define FTEXT 0x80 /* file handle is in text mode */ -#define _STREAM_LOCKS 26 // Table of stream locks -#define _LAST_STREAM_LOCK (_STREAM_LOCKS+_NSTREAM_-1) // Last stream lock -#define _FH_LOCKS (_LAST_STREAM_LOCK+1) // Table of fh locks +#define _STREAM_LOCKS 26 /* Table of stream locks */ +#define _LAST_STREAM_LOCK (_STREAM_LOCKS+_NSTREAM_-1) /* Last stream lock */ +#define _FH_LOCKS (_LAST_STREAM_LOCK+1) /* Table of fh locks */ /*** *int _patch_open_osfhandle(long osfhandle, int flags) - open C Runtime file handle @@ -98,8 +100,8 @@ EXT_C_FUNC struct servent* win32_savecopyservent(struct servent*d, struct serven *Purpose: * This function allocates a free C Runtime file handle and associates * it with the Win32 HANDLE specified by the first parameter. This is a -* temperary fix for WIN95's brain damage GetFileType() error on socket -* we just bypass that call for socket +* temperary fix for WIN95's brain damage GetFileType() error on socket +* we just bypass that call for socket * *Entry: * long osfhandle - Win32 HANDLE to associate with C Runtime file handle. @@ -113,45 +115,44 @@ EXT_C_FUNC struct servent* win32_savecopyservent(struct servent*d, struct serven * *******************************************************************************/ -int __cdecl _patch_open_osfhandle(long osfhandle, int flags) +int __cdecl +_patch_open_osfhandle(long osfhandle, int flags) { - int fh; - char fileflags; // _osfile flags + int fh; + char fileflags; /* _osfile flags */ - // copy relevant flags from second parameter - fileflags = FDEV; + /* copy relevant flags from second parameter */ + fileflags = FDEV; - if(flags & _O_APPEND) - fileflags |= FAPPEND; + if(flags & _O_APPEND) + fileflags |= FAPPEND; - if(flags & _O_TEXT) - fileflags |= FTEXT; + if(flags & _O_TEXT) + fileflags |= FTEXT; - // attempt to allocate a C Runtime file handle - if((fh = _alloc_osfhnd()) == -1) - { - errno = EMFILE; // too many open files - _doserrno = 0L; // not an OS error - return -1; // return error to caller - } + /* attempt to allocate a C Runtime file handle */ + if((fh = _alloc_osfhnd()) == -1) { + errno = EMFILE; /* too many open files */ + _doserrno = 0L; /* not an OS error */ + return -1; /* return error to caller */ + } - // the file is open. now, set the info in _osfhnd array - _set_osfhnd(fh, osfhandle); + /* the file is open. now, set the info in _osfhnd array */ + _set_osfhnd(fh, osfhandle); - fileflags |= FOPEN; // mark as open + fileflags |= FOPEN; /* mark as open */ #if (_MSC_VER >= 1000) - _osfile(fh) = fileflags; // set osfile entry - _unlock_fhandle(fh); + _osfile(fh) = fileflags; /* set osfile entry */ + _unlock_fhandle(fh); #else - _osfile[fh] = fileflags; // set osfile entry - _unlock(fh+_FH_LOCKS); // unlock handle + _osfile[fh] = fileflags; /* set osfile entry */ + _unlock(fh+_FH_LOCKS); /* unlock handle */ #endif - - return fh; // return handle + return fh; /* return handle */ } -#endif // _M_IX86 +#endif /* _M_IX86 */ #define SOCKETAPI PASCAL @@ -196,7 +197,7 @@ typedef int (SOCKETAPI *LPSOCKWSAGETLASTERROR)(void); typedef int (SOCKETAPI *LPWSAFDIsSet)(SOCKET, fd_set *); static HINSTANCE hWinSockDll = 0; -// extern CRITICAL_SECTION csSock; +/* extern CRITICAL_SECTION csSock; */ static LPSOCKACCEPT paccept = 0; static LPSOCKBIND pbind = 0; @@ -236,526 +237,573 @@ static LPSOCKINETADDR pinet_addr = 0; __declspec(thread) struct servent myservent; -void *GetAddress(HINSTANCE hInstance, char *lpFunctionName) -{ - char buffer[512]; - FARPROC proc = GetProcAddress(hInstance, lpFunctionName); - if(proc == 0) - { - sprintf(buffer, "Unable to get address of %s in WSock32.dll", lpFunctionName); - CROAK(buffer); - } - return proc; -} - -void LoadWinSock(void) -{ -// EnterCriticalSection(&csSock); - if(hWinSockDll == NULL) - { - HINSTANCE hLib = LoadLibrary("WSock32.DLL"); - if(hLib == NULL) - CROAK("Could not load WSock32.dll\n"); - - paccept = (LPSOCKACCEPT)GetAddress(hLib, "accept"); - pbind = (LPSOCKBIND)GetAddress(hLib, "bind"); - pclosesocket = (LPSOCKCLOSESOCKET)GetAddress(hLib, "closesocket"); - pconnect = (LPSOCKCONNECT)GetAddress(hLib, "connect"); - pioctlsocket = (LPSOCKIOCTLSOCKET)GetAddress(hLib, "ioctlsocket"); - pgetpeername = (LPSOCKGETPEERNAME)GetAddress(hLib, "getpeername"); - pgetsockname = (LPSOCKGETSOCKNAME)GetAddress(hLib, "getsockname"); - pgetsockopt = (LPSOCKGETSOCKOPT)GetAddress(hLib, "getsockopt"); - phtonl = (LPSOCKHTONL)GetAddress(hLib, "htonl"); - phtons = (LPSOCKHTONS)GetAddress(hLib, "htons"); - plisten = (LPSOCKLISTEN)GetAddress(hLib, "listen"); - pntohl = (LPSOCKNTOHL)GetAddress(hLib, "ntohl"); - pntohs = (LPSOCKNTOHS)GetAddress(hLib, "ntohs"); - precv = (LPSOCKRECV)GetAddress(hLib, "recv"); - precvfrom = (LPSOCKRECVFROM)GetAddress(hLib, "recvfrom"); - pselect = (LPSOCKSELECT)GetAddress(hLib, "select"); - psend = (LPSOCKSEND)GetAddress(hLib, "send"); - psendto = (LPSOCKSENDTO)GetAddress(hLib, "sendto"); - psetsockopt = (LPSOCKSETSOCKOPT)GetAddress(hLib, "setsockopt"); - pshutdown = (LPSOCKSHUTDOWN)GetAddress(hLib, "shutdown"); - psocket = (LPSOCKSOCKET)GetAddress(hLib, "socket"); - pgethostbyaddr = (LPSOCKGETHOSTBYADDR)GetAddress(hLib, "gethostbyaddr"); - pgethostbyname = (LPSOCKGETHOSTBYNAME)GetAddress(hLib, "gethostbyname"); - pgethostname = (LPSOCKGETHOSTNAME)GetAddress(hLib, "gethostname"); - pgetservbyport = (LPSOCKGETSERVBYPORT)GetAddress(hLib, "getservbyport"); - pgetservbyname = (LPSOCKGETSERVBYNAME)GetAddress(hLib, "getservbyname"); - pgetprotobynumber = (LPSOCKGETPROTOBYNUMBER)GetAddress(hLib, "getprotobynumber"); - pgetprotobyname = (LPSOCKGETPROTOBYNAME)GetAddress(hLib, "getprotobyname"); - pWSAStartup = (LPSOCKWSASTARTUP)GetAddress(hLib, "WSAStartup"); - pWSACleanup = (LPSOCKWSACLEANUP)GetAddress(hLib, "WSACleanup"); - pWSAGetLastError = (LPSOCKWSAGETLASTERROR)GetAddress(hLib, "WSAGetLastError"); - pWSAFDIsSet = (LPWSAFDIsSet)GetAddress(hLib, "__WSAFDIsSet"); - pinet_addr = (LPSOCKINETADDR)GetAddress(hLib,"inet_addr"); - pinet_ntoa = (LPSOCKINETNTOA)GetAddress(hLib,"inet_ntoa"); - - hWinSockDll = hLib; - } -// LeaveCriticalSection(&csSock); -} - -void EndSockets(void) -{ - if(hWinSockDll != NULL) - { - pWSACleanup(); - FreeLibrary(hWinSockDll); - } - hWinSockDll = NULL; -} - -void StartSockets(void) -{ - unsigned short version; - WSADATA retdata; - int ret; - int iSockOpt = SO_SYNCHRONOUS_NONALERT; - - LoadWinSock(); - // - // initalize the winsock interface and insure that it is - // cleaned up at exit. - // - version = 0x101; - if(ret = pWSAStartup(version, &retdata)) - CROAK("Unable to locate winsock library!\n"); - if(retdata.wVersion != version) - CROAK("Could not find version 1.1 of winsock dll\n"); - - // atexit((void (*)(void)) EndSockets); +void * +GetAddress(HINSTANCE hInstance, char *lpFunctionName) +{ + char buffer[512]; + FARPROC proc = GetProcAddress(hInstance, lpFunctionName); + if(proc == 0) { + sprintf(buffer, "Unable to get address of %s in WSock32.dll", lpFunctionName); + CROAK(buffer); + } + return proc; +} + +void +LoadWinSock(void) +{ +/* EnterCriticalSection(&csSock); */ + if(hWinSockDll == NULL) { + HINSTANCE hLib = LoadLibrary("WSock32.DLL"); + if(hLib == NULL) + CROAK("Could not load WSock32.dll\n"); + + paccept = (LPSOCKACCEPT)GetAddress(hLib, "accept"); + pbind = (LPSOCKBIND)GetAddress(hLib, "bind"); + pclosesocket = (LPSOCKCLOSESOCKET)GetAddress(hLib, "closesocket"); + pconnect = (LPSOCKCONNECT)GetAddress(hLib, "connect"); + pioctlsocket = (LPSOCKIOCTLSOCKET)GetAddress(hLib, "ioctlsocket"); + pgetpeername = (LPSOCKGETPEERNAME)GetAddress(hLib, "getpeername"); + pgetsockname = (LPSOCKGETSOCKNAME)GetAddress(hLib, "getsockname"); + pgetsockopt = (LPSOCKGETSOCKOPT)GetAddress(hLib, "getsockopt"); + phtonl = (LPSOCKHTONL)GetAddress(hLib, "htonl"); + phtons = (LPSOCKHTONS)GetAddress(hLib, "htons"); + plisten = (LPSOCKLISTEN)GetAddress(hLib, "listen"); + pntohl = (LPSOCKNTOHL)GetAddress(hLib, "ntohl"); + pntohs = (LPSOCKNTOHS)GetAddress(hLib, "ntohs"); + precv = (LPSOCKRECV)GetAddress(hLib, "recv"); + precvfrom = (LPSOCKRECVFROM)GetAddress(hLib, "recvfrom"); + pselect = (LPSOCKSELECT)GetAddress(hLib, "select"); + psend = (LPSOCKSEND)GetAddress(hLib, "send"); + psendto = (LPSOCKSENDTO)GetAddress(hLib, "sendto"); + psetsockopt = (LPSOCKSETSOCKOPT)GetAddress(hLib, "setsockopt"); + pshutdown = (LPSOCKSHUTDOWN)GetAddress(hLib, "shutdown"); + psocket = (LPSOCKSOCKET)GetAddress(hLib, "socket"); + pgethostbyaddr = (LPSOCKGETHOSTBYADDR)GetAddress(hLib, "gethostbyaddr"); + pgethostbyname = (LPSOCKGETHOSTBYNAME)GetAddress(hLib, "gethostbyname"); + pgethostname = (LPSOCKGETHOSTNAME)GetAddress(hLib, "gethostname"); + pgetservbyport = (LPSOCKGETSERVBYPORT)GetAddress(hLib, "getservbyport"); + pgetservbyname = (LPSOCKGETSERVBYNAME)GetAddress(hLib, "getservbyname"); + pgetprotobynumber = (LPSOCKGETPROTOBYNUMBER)GetAddress(hLib, "getprotobynumber"); + pgetprotobyname = (LPSOCKGETPROTOBYNAME)GetAddress(hLib, "getprotobyname"); + pWSAStartup = (LPSOCKWSASTARTUP)GetAddress(hLib, "WSAStartup"); + pWSACleanup = (LPSOCKWSACLEANUP)GetAddress(hLib, "WSACleanup"); + pWSAGetLastError = (LPSOCKWSAGETLASTERROR)GetAddress(hLib, "WSAGetLastError"); + pWSAFDIsSet = (LPWSAFDIsSet)GetAddress(hLib, "__WSAFDIsSet"); + pinet_addr = (LPSOCKINETADDR)GetAddress(hLib,"inet_addr"); + pinet_ntoa = (LPSOCKINETNTOA)GetAddress(hLib,"inet_ntoa"); + + hWinSockDll = hLib; + } +/* LeaveCriticalSection(&csSock); */ +} + +void +EndSockets(void) +{ + if(hWinSockDll != NULL) { + pWSACleanup(); + FreeLibrary(hWinSockDll); + } + hWinSockDll = NULL; +} + +void +StartSockets(void) +{ + unsigned short version; + WSADATA retdata; + int ret; + int iSockOpt = SO_SYNCHRONOUS_NONALERT; + + LoadWinSock(); + /* + * initalize the winsock interface and insure that it is + * cleaned up at exit. + */ + version = 0x101; + if(ret = pWSAStartup(version, &retdata)) + CROAK("Unable to locate winsock library!\n"); + if(retdata.wVersion != version) + CROAK("Could not find version 1.1 of winsock dll\n"); + + /* atexit((void (*)(void)) EndSockets); */ #ifdef USE_SOCKETS_AS_HANDLES - // - // Enable the use of sockets as filehandles - // - psetsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, (char *)&iSockOpt, sizeof(iSockOpt)); -#endif // USE_SOCKETS_AS_HANDLES + /* + * Enable the use of sockets as filehandles + */ + psetsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, + (char *)&iSockOpt, sizeof(iSockOpt)); +#endif /* USE_SOCKETS_AS_HANDLES */ } #ifndef USE_SOCKETS_AS_HANDLES -FILE *myfdopen(int fd, char *mode) +FILE * +myfdopen(int fd, char *mode) { - FILE *fp; - char sockbuf[256]; - int optlen = sizeof(sockbuf); - int retval; + FILE *fp; + char sockbuf[256]; + int optlen = sizeof(sockbuf); + int retval; - - if(hWinSockDll == 0) - LoadWinSock(); - - retval = pgetsockopt((SOCKET)fd, SOL_SOCKET, SO_TYPE, sockbuf, &optlen); - if(retval == SOCKET_ERROR && pWSAGetLastError() == WSAENOTSOCK) - { - return(_fdopen(fd, mode)); - } + if (hWinSockDll == 0) + LoadWinSock(); - // - // If we get here, then fd is actually a socket. - // - Newz(1601, fp, 1, FILE); - if(fp == NULL) - { - errno = ENOMEM; - return NULL; - } + retval = pgetsockopt((SOCKET)fd, SOL_SOCKET, SO_TYPE, sockbuf, &optlen); + if(retval == SOCKET_ERROR && pWSAGetLastError() == WSAENOTSOCK) { + return(_fdopen(fd, mode)); + } - fp->_file = fd; - if(*mode == 'r') - fp->_flag = _IOREAD; - else - fp->_flag = _IOWRT; + /* + * If we get here, then fd is actually a socket. + */ + Newz(1601, fp, 1, FILE); + if(fp == NULL) { + errno = ENOMEM; + return NULL; + } - return fp; + fp->_file = fd; + if(*mode == 'r') + fp->_flag = _IOREAD; + else + fp->_flag = _IOWRT; + + return fp; } -#endif // USE_SOCKETS_AS_HANDLES +#endif /* USE_SOCKETS_AS_HANDLES */ -u_long win32_htonl(u_long hostlong) +u_long +win32_htonl(u_long hostlong) { - if(hWinSockDll == 0) - LoadWinSock(); + if(hWinSockDll == 0) + LoadWinSock(); - return phtonl(hostlong); + return phtonl(hostlong); } -u_short win32_htons(u_short hostshort) +u_short +win32_htons(u_short hostshort) { - if(hWinSockDll == 0) - LoadWinSock(); + if(hWinSockDll == 0) + LoadWinSock(); - return phtons(hostshort); + return phtons(hostshort); } -u_long win32_ntohl(u_long netlong) +u_long +win32_ntohl(u_long netlong) { - if(hWinSockDll == 0) - LoadWinSock(); + if(hWinSockDll == 0) + LoadWinSock(); - return pntohl(netlong); + return pntohl(netlong); } -u_short win32_ntohs(u_short netshort) +u_short +win32_ntohs(u_short netshort) { - if(hWinSockDll == 0) - LoadWinSock(); + if(hWinSockDll == 0) + LoadWinSock(); - return pntohs(netshort); + return pntohs(netshort); } #define SOCKET_TEST(x, y) if(hWinSockDll == 0) StartSockets();\ - if((x) == (y)) errno = pWSAGetLastError() + if((x) == (y)) errno = pWSAGetLastError() -#define SOCKET_TEST_ERROR(x) SOCKET_TEST(x, SOCKET_ERROR) +#define SOCKET_TEST_ERROR(x) SOCKET_TEST(x, SOCKET_ERROR) -SOCKET win32_accept(SOCKET s, struct sockaddr *addr, int *addrlen) +SOCKET +win32_accept(SOCKET s, struct sockaddr *addr, int *addrlen) { - SOCKET r; + SOCKET r; - SOCKET_TEST((r = paccept(TO_SOCKET(s), addr, addrlen)), INVALID_SOCKET); - return OPEN_SOCKET(r); + SOCKET_TEST((r = paccept(TO_SOCKET(s), addr, addrlen)), INVALID_SOCKET); + return OPEN_SOCKET(r); } -int win32_bind(SOCKET s, const struct sockaddr *addr, int addrlen) +int +win32_bind(SOCKET s, const struct sockaddr *addr, int addrlen) { - int r; + int r; - SOCKET_TEST_ERROR(r = pbind(TO_SOCKET(s), addr, addrlen)); - return r; + SOCKET_TEST_ERROR(r = pbind(TO_SOCKET(s), addr, addrlen)); + return r; } -int win32_connect(SOCKET s, const struct sockaddr *addr, int addrlen) +int +win32_connect(SOCKET s, const struct sockaddr *addr, int addrlen) { - int r; + int r; - SOCKET_TEST_ERROR(r = pconnect(TO_SOCKET(s), addr, addrlen)); - return r; + SOCKET_TEST_ERROR(r = pconnect(TO_SOCKET(s), addr, addrlen)); + return r; } -int win32_getpeername(SOCKET s, struct sockaddr *addr, int *addrlen) +int +win32_getpeername(SOCKET s, struct sockaddr *addr, int *addrlen) { - int r; + int r; - SOCKET_TEST_ERROR(r = pgetpeername(TO_SOCKET(s), addr, addrlen)); - return r; + SOCKET_TEST_ERROR(r = pgetpeername(TO_SOCKET(s), addr, addrlen)); + return r; } -int win32_getsockname(SOCKET s, struct sockaddr *addr, int *addrlen) +int +win32_getsockname(SOCKET s, struct sockaddr *addr, int *addrlen) { - int r; + int r; - SOCKET_TEST_ERROR(r = pgetsockname(TO_SOCKET(s), addr, addrlen)); - return r; + SOCKET_TEST_ERROR(r = pgetsockname(TO_SOCKET(s), addr, addrlen)); + return r; } -int win32_getsockopt(SOCKET s, int level, int optname, char *optval, int *optlen) +int +win32_getsockopt(SOCKET s, int level, int optname, char *optval, int *optlen) { - int r; + int r; - SOCKET_TEST_ERROR(r = pgetsockopt(TO_SOCKET(s), level, optname, optval, optlen)); - return r; + SOCKET_TEST_ERROR(r = pgetsockopt(TO_SOCKET(s), level, optname, optval, optlen)); + return r; } -int win32_ioctlsocket(SOCKET s, long cmd, u_long *argp) +int +win32_ioctlsocket(SOCKET s, long cmd, u_long *argp) { - int r; + int r; - SOCKET_TEST_ERROR(r = pioctlsocket(TO_SOCKET(s), cmd, argp)); - return r; + SOCKET_TEST_ERROR(r = pioctlsocket(TO_SOCKET(s), cmd, argp)); + return r; } -int win32_listen(SOCKET s, int backlog) +int +win32_listen(SOCKET s, int backlog) { - int r; + int r; - SOCKET_TEST_ERROR(r = plisten(TO_SOCKET(s), backlog)); - return r; + SOCKET_TEST_ERROR(r = plisten(TO_SOCKET(s), backlog)); + return r; } -int win32_recv(SOCKET s, char *buf, int len, int flags) +int +win32_recv(SOCKET s, char *buf, int len, int flags) { - int r; + int r; - SOCKET_TEST_ERROR(r = precv(TO_SOCKET(s), buf, len, flags)); - return r; + SOCKET_TEST_ERROR(r = precv(TO_SOCKET(s), buf, len, flags)); + return r; } -int win32_recvfrom(SOCKET s, char *buf, int len, int flags, struct sockaddr *from, int *fromlen) +int +win32_recvfrom(SOCKET s, char *buf, int len, int flags, struct sockaddr *from, int *fromlen) { - int r; + int r; - SOCKET_TEST_ERROR(r = precvfrom(TO_SOCKET(s), buf, len, flags, from, fromlen)); - return r; + SOCKET_TEST_ERROR(r = precvfrom(TO_SOCKET(s), buf, len, flags, from, fromlen)); + return r; } -// select contributed by Vincent R. Slyngstad (vrs@ibeam.intel.com) -int win32_select(int nfds, int* rd, int* wr, int* ex, const struct timeval* timeout) +/* select contributed by Vincent R. Slyngstad (vrs@ibeam.intel.com) */ +int +win32_select(int nfds, int* rd, int* wr, int* ex, const struct timeval* timeout) { - long r; - int dummy = 0; - int i, fd, bit, offset; - FD_SET nrd, nwr, nex,*prd,*pwr,*pex; + long r; + int dummy = 0; + int i, fd, bit, offset; + FD_SET nrd, nwr, nex,*prd,*pwr,*pex; - if (!rd) rd = &dummy, prd = NULL; - else prd = &nrd; - if (!wr) wr = &dummy, pwr = NULL; - else pwr = &nwr; - if (!ex) ex = &dummy, pex = NULL; - else pex = &nex; + if (!rd) + rd = &dummy, prd = NULL; + else + prd = &nrd; + if (!wr) + wr = &dummy, pwr = NULL; + else + pwr = &nwr; + if (!ex) + ex = &dummy, pex = NULL; + else + pex = &nex; - FD_ZERO(&nrd); - FD_ZERO(&nwr); - FD_ZERO(&nex); - for (i = 0; i < nfds; i++) - { - fd = TO_SOCKET(i); - bit = 1L<<(i % (sizeof(int)*8)); - offset = i / (sizeof(int)*8); - if (rd[offset] & bit) - FD_SET(fd, &nrd); - if (wr[offset] & bit) - FD_SET(fd, &nwr); - if (ex[offset] & bit) - FD_SET(fd, &nex); - } + FD_ZERO(&nrd); + FD_ZERO(&nwr); + FD_ZERO(&nex); + for (i = 0; i < nfds; i++) { + fd = TO_SOCKET(i); + bit = 1L<<(i % (sizeof(int)*8)); + offset = i / (sizeof(int)*8); + if (rd[offset] & bit) + FD_SET(fd, &nrd); + if (wr[offset] & bit) + FD_SET(fd, &nwr); + if (ex[offset] & bit) + FD_SET(fd, &nex); + } + + SOCKET_TEST_ERROR(r = pselect(nfds, prd, pwr, pex, timeout)); - SOCKET_TEST_ERROR(r = pselect(nfds, prd, pwr, pex, timeout)); - - for (i = 0; i < nfds; i++) - { - fd = TO_SOCKET(i); - bit = 1L<<(i % (sizeof(int)*8)); - offset = i / (sizeof(int)*8); - if (rd[offset] & bit) - { - if (!pWSAFDIsSet(fd, &nrd)) - rd[offset] &= ~bit; - } - if (wr[offset] & bit) - { - if (!pWSAFDIsSet(fd, &nwr)) - wr[offset] &= ~bit; - } - if (ex[offset] & bit) - { - if (!pWSAFDIsSet(fd, &nex)) - ex[offset] &= ~bit; - } + for (i = 0; i < nfds; i++) { + fd = TO_SOCKET(i); + bit = 1L<<(i % (sizeof(int)*8)); + offset = i / (sizeof(int)*8); + if (rd[offset] & bit) { + if (!pWSAFDIsSet(fd, &nrd)) + rd[offset] &= ~bit; + } + if (wr[offset] & bit) { + if (!pWSAFDIsSet(fd, &nwr)) + wr[offset] &= ~bit; + } + if (ex[offset] & bit) { + if (!pWSAFDIsSet(fd, &nex)) + ex[offset] &= ~bit; } - return r; + } + return r; } -int win32_send(SOCKET s, const char *buf, int len, int flags) +int +win32_send(SOCKET s, const char *buf, int len, int flags) { - int r; + int r; - SOCKET_TEST_ERROR(r = psend(TO_SOCKET(s), buf, len, flags)); - return r; + SOCKET_TEST_ERROR(r = psend(TO_SOCKET(s), buf, len, flags)); + return r; } -int win32_sendto(SOCKET s, const char *buf, int len, int flags, const struct sockaddr *to, int tolen) +int +win32_sendto(SOCKET s, const char *buf, int len, int flags, + const struct sockaddr *to, int tolen) { - int r; + int r; - SOCKET_TEST_ERROR(r = psendto(TO_SOCKET(s), buf, len, flags, to, tolen)); - return r; + SOCKET_TEST_ERROR(r = psendto(TO_SOCKET(s), buf, len, flags, to, tolen)); + return r; } -int win32_setsockopt(SOCKET s, int level, int optname, const char *optval, int optlen) +int +win32_setsockopt(SOCKET s, int level, int optname, const char *optval, int optlen) { - int r; + int r; - SOCKET_TEST_ERROR(r = psetsockopt(TO_SOCKET(s), level, optname, optval, optlen)); - return r; + SOCKET_TEST_ERROR(r = psetsockopt(TO_SOCKET(s), level, optname, optval, optlen)); + return r; } -int win32_shutdown(SOCKET s, int how) +int +win32_shutdown(SOCKET s, int how) { - int r; + int r; - SOCKET_TEST_ERROR(r = pshutdown(TO_SOCKET(s), how)); - return r; + SOCKET_TEST_ERROR(r = pshutdown(TO_SOCKET(s), how)); + return r; } -SOCKET win32_socket(int af, int type, int protocol) +SOCKET +win32_socket(int af, int type, int protocol) { - SOCKET s; + SOCKET s; #ifndef USE_SOCKETS_AS_HANDLES - SOCKET_TEST(s = psocket(af, type, protocol), INVALID_SOCKET); + SOCKET_TEST(s = psocket(af, type, protocol), INVALID_SOCKET); #else - if(hWinSockDll == 0) - StartSockets(); + if(hWinSockDll == 0) + StartSockets(); - if((s = psocket(af, type, protocol)) == INVALID_SOCKET) - errno = pWSAGetLastError(); - else - s = OPEN_SOCKET(s); -#endif // USE_SOCKETS_AS_HANDLES + if((s = psocket(af, type, protocol)) == INVALID_SOCKET) + errno = pWSAGetLastError(); + else + s = OPEN_SOCKET(s); +#endif /* USE_SOCKETS_AS_HANDLES */ - return s; + return s; } -struct hostent *win32_gethostbyaddr(const char *addr, int len, int type) +struct hostent * +win32_gethostbyaddr(const char *addr, int len, int type) { - struct hostent *r; + struct hostent *r; - SOCKET_TEST(r = pgethostbyaddr(addr, len, type), NULL); - return r; + SOCKET_TEST(r = pgethostbyaddr(addr, len, type), NULL); + return r; } -struct hostent *win32_gethostbyname(const char *name) +struct hostent * +win32_gethostbyname(const char *name) { - struct hostent *r; + struct hostent *r; - SOCKET_TEST(r = pgethostbyname(name), NULL); - return r; + SOCKET_TEST(r = pgethostbyname(name), NULL); + return r; } -int win32_gethostname(char *name, int len) +int +win32_gethostname(char *name, int len) { - int r; + int r; - SOCKET_TEST_ERROR(r = pgethostname(name, len)); - return r; + SOCKET_TEST_ERROR(r = pgethostname(name, len)); + return r; } -struct protoent *win32_getprotobyname(const char *name) +struct protoent * +win32_getprotobyname(const char *name) { - struct protoent *r; + struct protoent *r; - SOCKET_TEST(r = pgetprotobyname(name), NULL); - return r; + SOCKET_TEST(r = pgetprotobyname(name), NULL); + return r; } -struct protoent *win32_getprotobynumber(int num) +struct protoent * +win32_getprotobynumber(int num) { - struct protoent *r; + struct protoent *r; - SOCKET_TEST(r = pgetprotobynumber(num), NULL); - return r; + SOCKET_TEST(r = pgetprotobynumber(num), NULL); + return r; } -struct servent *win32_getservbyname(const char *name, const char *proto) +struct servent * +win32_getservbyname(const char *name, const char *proto) { - struct servent *r; - - SOCKET_TEST(r = pgetservbyname(name, proto), NULL); - if (r) { - r = win32_savecopyservent(&myservent, r, proto); - } - return r; + struct servent *r; + + SOCKET_TEST(r = pgetservbyname(name, proto), NULL); + if (r) { + r = win32_savecopyservent(&myservent, r, proto); + } + return r; } -struct servent *win32_getservbyport(int port, const char *proto) +struct servent * +win32_getservbyport(int port, const char *proto) { - struct servent *r; + struct servent *r; - SOCKET_TEST(r = pgetservbyport(port, proto), NULL); - if (r) { - r = win32_savecopyservent(&myservent, r, proto); - } - return r; + SOCKET_TEST(r = pgetservbyport(port, proto), NULL); + if (r) { + r = win32_savecopyservent(&myservent, r, proto); + } + return r; } -char FAR *win32_inet_ntoa(struct in_addr in) +char FAR * +win32_inet_ntoa(struct in_addr in) { - if(hWinSockDll == 0) LoadWinSock(); + if(hWinSockDll == 0) + LoadWinSock(); - return pinet_ntoa(in); + return pinet_ntoa(in); } -unsigned long win32_inet_addr(const char FAR *cp) +unsigned long +win32_inet_addr(const char FAR *cp) { - if(hWinSockDll == 0) LoadWinSock(); + if(hWinSockDll == 0) + LoadWinSock(); - return pinet_addr(cp); + return pinet_addr(cp); } -// -// Networking stubs -// + +/* + * Networking stubs + */ #undef CROAK #define CROAK croak -void win32_endhostent() +void +win32_endhostent() { - CROAK("endhostent not implemented!\n"); + CROAK("endhostent not implemented!\n"); } -void win32_endnetent() +void +win32_endnetent() { - CROAK("endnetent not implemented!\n"); + CROAK("endnetent not implemented!\n"); } -void win32_endprotoent() +void +win32_endprotoent() { - CROAK("endprotoent not implemented!\n"); + CROAK("endprotoent not implemented!\n"); } -void win32_endservent() +void +win32_endservent() { - CROAK("endservent not implemented!\n"); + CROAK("endservent not implemented!\n"); } -struct netent *win32_getnetent(void) +struct netent * +win32_getnetent(void) { - CROAK("getnetent not implemented!\n"); - return (struct netent *) NULL; + CROAK("getnetent not implemented!\n"); + return (struct netent *) NULL; } -struct netent *win32_getnetbyname(char *name) +struct netent * +win32_getnetbyname(char *name) { - CROAK("getnetbyname not implemented!\n"); - return (struct netent *)NULL; + CROAK("getnetbyname not implemented!\n"); + return (struct netent *)NULL; } -struct netent *win32_getnetbyaddr(long net, int type) +struct netent * +win32_getnetbyaddr(long net, int type) { - CROAK("getnetbyaddr not implemented!\n"); - return (struct netent *)NULL; + CROAK("getnetbyaddr not implemented!\n"); + return (struct netent *)NULL; } -struct protoent *win32_getprotoent(void) +struct protoent * +win32_getprotoent(void) { - CROAK("getprotoent not implemented!\n"); - return (struct protoent *) NULL; + CROAK("getprotoent not implemented!\n"); + return (struct protoent *) NULL; } -struct servent *win32_getservent(void) +struct servent * +win32_getservent(void) { - CROAK("getservent not implemented!\n"); - return (struct servent *) NULL; + CROAK("getservent not implemented!\n"); + return (struct servent *) NULL; } -void win32_sethostent(int stayopen) +void +win32_sethostent(int stayopen) { - CROAK("sethostent not implemented!\n"); + CROAK("sethostent not implemented!\n"); } -void win32_setnetent(int stayopen) +void +win32_setnetent(int stayopen) { - CROAK("setnetent not implemented!\n"); + CROAK("setnetent not implemented!\n"); } -void win32_setprotoent(int stayopen) +void +win32_setprotoent(int stayopen) { - CROAK("setprotoent not implemented!\n"); + CROAK("setprotoent not implemented!\n"); } -void win32_setservent(int stayopen) +void +win32_setservent(int stayopen) { - CROAK("setservent not implemented!\n"); + CROAK("setservent not implemented!\n"); } @@ -41,7 +41,7 @@ register STR *str; str->str_pok = 1; #ifdef DEBUGGING if (debug & 32) - fprintf(stderr,"0x%lx ptr(%s)\n",str,str->str_ptr); + fprintf(stderr,"0x%lx ptr(%s)\n",(unsigned long)str,str->str_ptr); #endif return str->str_ptr; } @@ -59,7 +59,7 @@ register STR *str; str->str_nok = 1; #ifdef DEBUGGING if (debug & 32) - fprintf(stderr,"0x%lx num(%g)\n",str,str->str_nval); + fprintf(stderr,"0x%lx num(%g)\n",(unsigned long)str,str->str_nval); #endif return str->str_nval; } diff --git a/x2p/util.c b/x2p/util.c index c70bab9f07..e8b666f393 100644 --- a/x2p/util.c +++ b/x2p/util.c @@ -33,7 +33,8 @@ MEM_SIZE size; ptr = malloc(size ? size : 1); #ifdef DEBUGGING if (debug & 128) - fprintf(stderr,"0x%x: (%05d) malloc %d bytes\n",ptr,an++,size); + fprintf(stderr,"0x%lx: (%05d) malloc %d bytes\n",(unsigned long)ptr, + an++,size); #endif if (ptr != Nullch) return ptr; @@ -57,8 +58,8 @@ MEM_SIZE size; ptr = realloc(where, size ? size : 1); #ifdef DEBUGGING if (debug & 128) { - fprintf(stderr,"0x%x: (%05d) rfree\n",where,an++); - fprintf(stderr,"0x%x: (%05d) realloc %d bytes\n",ptr,an++,size); + fprintf(stderr,"0x%lx: (%05d) rfree\n",(unsigned long)where,an++); + fprintf(stderr,"0x%lx: (%05d) realloc %d bytes\n",(unsigned long)ptr,an++,size); } #endif if (ptr != Nullch) @@ -78,7 +79,7 @@ Malloc_t where; { #ifdef DEBUGGING if (debug & 128) - fprintf(stderr,"0x%x: (%05d) free\n",where,an++); + fprintf(stderr,"0x%lx: (%05d) free\n",(unsigned long)where,an++); #endif free(where); } |