diff options
| -rw-r--r-- | .gitignore | 11 | ||||
| -rw-r--r-- | Build.PL | 1 | ||||
| -rw-r--r-- | Changes | 41 | ||||
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | META.json | 7 | ||||
| -rw-r--r-- | META.yml | 7 | ||||
| -rw-r--r-- | README | 3 | ||||
| -rw-r--r-- | SIGNATURE | 120 | ||||
| -rw-r--r-- | debian/changelog | 11 | ||||
| -rw-r--r-- | debian/control | 5 | ||||
| -rw-r--r-- | debian/copyright | 2 | ||||
| -rw-r--r-- | debian/patches/auto-gitignore | 25 | ||||
| -rw-r--r-- | debian/patches/series | 3 | ||||
| -rw-r--r-- | debian/patches/y2k20.patch | 39 | ||||
| -rw-r--r-- | lib/Perl4/CoreLibs.pm | 8 | ||||
| -rw-r--r-- | lib/abbrev.pl | 2 | ||||
| -rw-r--r-- | lib/assert.pl | 2 | ||||
| -rw-r--r-- | lib/bigfloat.pl | 58 | ||||
| -rw-r--r-- | lib/bigint.pl | 42 | ||||
| -rw-r--r-- | lib/bigrat.pl | 72 | ||||
| -rw-r--r-- | lib/cacheout.pl | 6 | ||||
| -rw-r--r-- | lib/chat2.pl | 50 | ||||
| -rw-r--r-- | lib/complete.pl | 2 | ||||
| -rw-r--r-- | lib/dotsh.pl | 2 | ||||
| -rw-r--r-- | lib/exceptions.pl | 4 | ||||
| -rw-r--r-- | lib/flush.pl | 2 | ||||
| -rw-r--r-- | lib/ftp.pl | 269 | ||||
| -rw-r--r-- | lib/getcwd.pl | 12 | ||||
| -rw-r--r-- | lib/getopt.pl | 2 | ||||
| -rw-r--r-- | lib/getopts.pl | 4 | ||||
| -rw-r--r-- | lib/hostname.pl | 2 | ||||
| -rw-r--r-- | lib/pwd.pl | 4 | ||||
| -rw-r--r-- | lib/stat.pl | 2 | ||||
| -rw-r--r-- | lib/syslog.pl | 46 | ||||
| -rw-r--r-- | lib/termcap.pl | 2 | ||||
| -rw-r--r-- | lib/validate.pl | 4 | ||||
| -rw-r--r-- | t/require.t | 30 | ||||
| -rw-r--r-- | t/timelocal.t | 93 |
38 files changed, 528 insertions, 468 deletions
diff --git a/.gitignore b/.gitignore deleted file mode 100644 index 4594861..0000000 --- a/.gitignore +++ /dev/null @@ -1,11 +0,0 @@ -/Build -/Makefile -/_build -/blib -/META.json -/META.yml -/MYMETA.json -/MYMETA.yml -/Makefile.PL -/SIGNATURE -/Perl4-CoreLibs-* @@ -49,6 +49,7 @@ my $build = Module::Build->new( "IPC::Open2" => 0, "IPC::Open3" => 0, "Socket" => 0, + "Sys::Syslog" => "0.19", "Text::ParseWords" => "3.25", "Time::Local" => 0, "perl" => "5.006", @@ -1,3 +1,44 @@ +version 0.005; 2023-03-13 + + * port chat2.pl and validate.pl to Perl 5.19.8, which abolished the + "do" syntax for subroutine calls, after it had started warning by + default in Perl 5.11.1 + + * port abbrev.pl, bigfloat.pl, bigint.pl, bigrat.pl, cacheout.pl, + chat2.pl, complete.pl, exceptions.pl, ftp.pl, getcwd.pl, pwd.pl, + and syslog.pl to Perl 5.37.9, which deprecated the old "'" package + separator + + * muffle ambiguity warnings that arose under -w from ambiguous use of + keywords "open", "close", and "select" + + * make the tests in t/timelocal.t robust against the way + Time::Local::time{local,gm}() interpret year inputs 0 to 99 based + on a sliding window + + * make the tests in t/timelocal.t accommodate OS-dependent limits on + the range of years that can be represented in a time_t + + * update chat2.pl, ftp.pl, and syslog.pl to get constants from + the Socket and Sys::Syslog modules, rather than from socket.ph, + sys/socket.ph, and syslog.ph, which may well not be available + + * test that all the library files can be loaded without causing + unintended warnings + + * update usage comments in getopt.pl, getopts.pl, stat.pl, syslog.pl, + and validate.pl for Perl 5.19.8, which abolished the "do" syntax + for subroutine calls + + * document that the core try/catch mechanism (from Perl 5.33.7) is + another alternative to exceptions.pl + + * in t/timelocal.t, apply most tests to both timelocal() and timegm() + + * in t/timelocal.t, test error for 2100-02-29 + + * in t/timelocal.t, don't load the unused Config module + version 0.004; 2017-07-30 * in doc, note when core versions started warning and were removed @@ -50,6 +50,7 @@ t/open2.t t/open3.t t/pod_cvg.t t/pod_syn.t +t/require.t t/shellwords.t t/timelocal.t SIGNATURE Added here by Module::Build @@ -22,7 +22,7 @@ "Andrew Main (Zefram) <zefram@fysh.org>" ], "dynamic_config" : 0, - "generated_by" : "Module::Build version 0.4224", + "generated_by" : "Module::Build version 0.4232", "license" : [ "perl_5" ], @@ -58,6 +58,7 @@ "IPC::Open2" : "0", "IPC::Open3" : "0", "Socket" : "0", + "Sys::Syslog" : "0.19", "Text::ParseWords" : "3.25", "Time::Local" : "0", "perl" : "5.006", @@ -70,7 +71,7 @@ "provides" : { "Perl4::CoreLibs" : { "file" : "lib/Perl4/CoreLibs.pm", - "version" : "0.004" + "version" : "0.005" } }, "release_status" : "stable", @@ -83,6 +84,6 @@ "http://dev.perl.org/licenses/" ] }, - "version" : "0.004", + "version" : "0.005", "x_serialization_backend" : "JSON::PP version 2.93" } @@ -34,7 +34,7 @@ configure_requires: strict: '0' warnings: '0' dynamic_config: 0 -generated_by: 'Module::Build version 0.4224, CPAN::Meta::Converter version 2.150010' +generated_by: 'Module::Build version 0.4232, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -43,13 +43,14 @@ name: Perl4-CoreLibs provides: Perl4::CoreLibs: file: lib/Perl4/CoreLibs.pm - version: '0.004' + version: '0.005' requires: File::Find: '0' Getopt::Long: '0' IPC::Open2: '0' IPC::Open3: '0' Socket: '0' + Sys::Syslog: '0.19' Text::ParseWords: '3.25' Time::Local: '0' perl: '5.006' @@ -59,5 +60,5 @@ requires: resources: bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Perl4-CoreLibs license: http://dev.perl.org/licenses/ -version: '0.004' +version: '0.005' x_serialization_backend: 'CPAN::Meta::YAML version 0.012' @@ -53,7 +53,8 @@ COPYRIGHT Copyright (C) 1987-2009 Larry Wall et al -Copyright (C) 2010, 2011, 2017 Andrew Main (Zefram) <zefram@fysh.org> +Copyright (C) 2010, 2011, 2017, 2023 +Andrew Main (Zefram) <zefram@fysh.org> LICENSE @@ -1,5 +1,5 @@ This file contains message digests of all files listed in MANIFEST, -signed via the Module::Signature module, version 0.81. +signed via the Module::Signature module, version 0.88. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: @@ -12,66 +12,66 @@ the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- -Hash: SHA1 +Hash: RIPEMD160 -SHA1 b62e2957b124b85389dc7c6006674bdd6ad71d80 .gitignore -SHA1 6c4f1a89b50e415af9d5f1f52fe35378aa81e453 Build.PL -SHA1 5381ffa20c2adfcceb6177f443c2fbdd9351e89f Changes -SHA1 490c4e56b47b0412e92446963876eec6a26a0fc9 MANIFEST -SHA1 45c93214eaf890d277fe2d121ea79fd5d4bda868 META.json -SHA1 aa5c914ef1a1260f17e57cd58d7104231d7089be META.yml -SHA1 e4b5e2d752168d5be5b89e64934019299c8ceedb README -SHA1 b3a813a4e87c2f39c133247db86772749f20994d lib/Perl4/CoreLibs.pm -SHA1 d34f3092d7fa015b1d79da59ba2ef6d1750c3235 lib/abbrev.pl -SHA1 e7baaba3c82cb56da45e12cf10e020df80403b89 lib/assert.pl -SHA1 e471939828ca3bcddc12e4642be4a2caffedf9f1 lib/bigfloat.pl -SHA1 e37f3486d2f8332bc79827d95d59675af60659cf lib/bigint.pl -SHA1 17bde82d2827efd5cd8109ea3fb4097b8c3c6acc lib/bigrat.pl -SHA1 d3ca8191fd7393ef5030693de34508f29f09acac lib/cacheout.pl -SHA1 ef9df026eaabadf4fdecbc6b098b104075eb116d lib/chat2.pl -SHA1 657351c7a4568e8f90b48806d0f47609bdb07dac lib/complete.pl -SHA1 2f2a1ea2e975c4bf5c4555288c303def01cfccf3 lib/ctime.pl -SHA1 a2f6ce5616df363b84e25cb2b836c510f66b8f25 lib/dotsh.pl -SHA1 6b1b3535825fc6e15183b951d3d7eb1c76dedd7d lib/exceptions.pl -SHA1 e47bb82e8c5ff31ac2ff5d949217188dfa211f5f lib/fastcwd.pl -SHA1 1dd888d493b32e37a8aed5cbba943b5a256547c8 lib/find.pl -SHA1 d027422019db280d71a372621d9f5cf2a593c267 lib/finddepth.pl -SHA1 05e69a428de4882694dc403651d42b5e09fbc17c lib/flush.pl -SHA1 0f0037bd2b4becff2b03dda38f687f9a6c4efa0a lib/ftp.pl -SHA1 f8f08a10b0674e6600d555707d3a92ddedd2679f lib/getcwd.pl -SHA1 8282dc3ff054c7e0c35fdc0f8eda6ae867410e49 lib/getopt.pl -SHA1 a562c6c5187a51fa4d8ff324b52fa1f5e5f4b7ac lib/getopts.pl -SHA1 d819110dbdc1ccdefe67d6bf857564ce4f8bc01c lib/hostname.pl -SHA1 bd8cfacf15c0f37a15c2d92bff595b6c0f287521 lib/importenv.pl -SHA1 cb87ad59e87c53073ae0d76e07279d4b27c92900 lib/look.pl -SHA1 d85b349f2273f8d08758d273e0feaec4a87a4205 lib/newgetopt.pl -SHA1 790620173473d02a94d5f71c961022b4d1a0305e lib/open2.pl -SHA1 a91b4032acf3921f37c812ca4ee56aaee0f9b168 lib/open3.pl -SHA1 b4471fd6239028bd94b3b941307b55509cfc1bc8 lib/pwd.pl -SHA1 97e226d3e297d0c6694d66b8ba893b588649819c lib/shellwords.pl -SHA1 4c65b2e93e1f40e336fd53e4213ee9f63fd59b26 lib/stat.pl -SHA1 7c2f990ba81f58c9e6525c2166407985b834e68d lib/syslog.pl -SHA1 eb33cfea8616e3cdf65c22536080651daca2b392 lib/tainted.pl -SHA1 17cbc392057ec8334b32c1448e003a0a96f3eaa0 lib/termcap.pl -SHA1 66d26c4a6ed5d4da8a5a8775ab9d54510b072d30 lib/timelocal.pl -SHA1 5d843e4eb829903350356374cb518e8677700c8e lib/validate.pl -SHA1 40f230ec0bb17dada0cf2be172939d2dacd2c99a t/abbrev.t -SHA1 99ea24386425a5eb1c8344bb67aa68a6bb78161f t/bigfloat.t -SHA1 26fbda818a5f5bbb207813132ad058dcbe88f251 t/bigint.t -SHA1 e06652dc0380006d2840932048ee19d3606a2b21 t/getopt.t -SHA1 93a46b0734c4f1d38eb5a5216686ff4545dead45 t/getopts.t -SHA1 f0a534fd2d52bfc88152dee7c818e3f25e70703c t/hostname.t -SHA1 3799e8dd6c2dab99863be5bd68fc17f593759e7f t/newgetopt.t -SHA1 6fd35abd4558d8787f5bb979e106b654af624eac t/open2.t -SHA1 8de9df6d39b090717ef7d5f2bae04e1bf46fb9be t/open3.t -SHA1 904d9a4f76525e2303e4b0c168c68230f223c8de t/pod_cvg.t -SHA1 65c75abdef6f01a5d1588a307f2ddfe2333dc961 t/pod_syn.t -SHA1 089234273a73f10e3bf39d636f7dbd21fb413060 t/shellwords.t -SHA1 4a3269c9d997504a12fc561088eff53d4cc61600 t/timelocal.t +SHA256 16412abca4c4445098998931b3d178fc60948f5ae38d02e8d19a9c24defe2b54 .gitignore +SHA256 3992a9c9da1f04d8303b5df293ac480552266010bfc63aa3fa4949787dc316ed Build.PL +SHA256 fe6129495f9677bc70c3b3a46bcf479f390b63733d6b3607aec5cbe918f6058e Changes +SHA256 97f635bc7653df80481f59cc5778e279a96efdb03a46e657ad273147d95a2b6a MANIFEST +SHA256 251c138401e725b170dfb87372ce5070025f948ef663278bd2c5e3083690e441 META.json +SHA256 f3e737e916c474bce79a57e3962d63798b7d963d092c01603ffe0f6efe5c9dc7 META.yml +SHA256 487f11881cf34e3fbfe239756cbc8e98a676cb7c85ae25b82d1c2b1a2fdfc49e README +SHA256 e6ca506e12409c68740bde69095cd1d811fe95902ea2d15cc0f69b87504e2d7f lib/Perl4/CoreLibs.pm +SHA256 ae47a2cac8828b72c011230703186d59ecd4b8e8abaa6556a95935c304ef2aa6 lib/abbrev.pl +SHA256 bbe77f92a6575aa53c1a72a89694fac382db2d5afc853e9080188efec61a626d lib/assert.pl +SHA256 93d5a57ac20a602faa5173edea703a79d51e38c08ab60a2aef3c5d765a12fa65 lib/bigfloat.pl +SHA256 0d5a3bb5a615ea084f9b49f943afe36275fc55d06f72d00c12efc258a8e30965 lib/bigint.pl +SHA256 13c50752efeef2341aeb27927b100a8529fd2bb9b661cf7414cab3d7003de8fa lib/bigrat.pl +SHA256 adde275d1e6be400e9ed899c5000ce7bd5c7867ebc217982e1929c803c736a0b lib/cacheout.pl +SHA256 d0ebc318ff476dc523f4bf2df21710b40b03a58e9ddf5c581d72a31743a73c6c lib/chat2.pl +SHA256 32b6069389c010d41b3b394f2a0382afc5224c150824f4ae91982dde72cee010 lib/complete.pl +SHA256 2a9117fd9195015b654d0cbd412f70ccb34abe784499bfe119cc0a8d7c19b640 lib/ctime.pl +SHA256 6ae1421de6a7982ec643f7d31c4171087a702f76d78d276612a0b4ca53d5e5d2 lib/dotsh.pl +SHA256 4b257183a194e41339f28ca9d7d373f1a968372a1f53a7cfb29a3f79971772b2 lib/exceptions.pl +SHA256 9aca77c93070499c89d5758cb3f5142537f551545583d9fa5f2860ecf14a7a87 lib/fastcwd.pl +SHA256 6a223c29869cc928bcf9ed43d6e7067163d02b71932cfef374ffdf4313db2045 lib/find.pl +SHA256 6efd0796abe365e06f85dc5b538356cec65d94463983782d021525c51bdbd74f lib/finddepth.pl +SHA256 7dce7b8f0b3ade2877c8e9d36958dd655c4c8ebc546ab46bcbfe177453634a88 lib/flush.pl +SHA256 7c64ee1e76a5d643a525c42a9dcefbe61b441779d046de79492554e34a748949 lib/ftp.pl +SHA256 38fcfe1ec963baf22da5ed72c1f57f24d933a8f0a618f126ec725c03b408d2b8 lib/getcwd.pl +SHA256 951c379261f7b63539fa0ec362de031ade7901ea5d8f41b4b4f415942fff10c4 lib/getopt.pl +SHA256 631214661a73abf55bf099342a8402c5d1e394e6233399cb7a1adb602944a48d lib/getopts.pl +SHA256 a49e14113b1336d025975341ebe7150d8b55c958157cfefe79131b6ec7b093d9 lib/hostname.pl +SHA256 b364da1fc208dfd55ae2893f5c5589b6e610e815fd0a3decf1a05edced9abb00 lib/importenv.pl +SHA256 26a50f8c1b6caf676ac114cc9538bb3c8de67078ce9f05c02175bb227e1106a6 lib/look.pl +SHA256 6cecbe42699ea2a94ad8f5e58bdd886387e407e7a2e746e70e7c9f4d63ba9141 lib/newgetopt.pl +SHA256 681928cbeba02ef8097ac5bd083a9ce9fd12686bc72744fcaae562fc27a8f6c4 lib/open2.pl +SHA256 0aa681e56329abf1452e53df17cec5636e914236619b6050498eb8dae85e039b lib/open3.pl +SHA256 374f0a2b86a08d3e5ed952ced676cc4914028d83709fdcfebabf3c889ccfdc10 lib/pwd.pl +SHA256 6b5b858ebeb75e380c193e6834c4d119b24be008ee9641d890b5a6995ab874cf lib/shellwords.pl +SHA256 7cd4af39b90e4fd72ad0220be6cabfc421268941db1b6e47c82f54820c39de27 lib/stat.pl +SHA256 8e5ed1fcfb6633641ff4549b68c38f574ceef3088631137a9f61c127129b4760 lib/syslog.pl +SHA256 04508460d08a62b536e4eb4ce8d27845d92c5e68af43704bef9d5f1f3b44418c lib/tainted.pl +SHA256 2c9714b4cc1e5580da7ab150215a5016f078764836fefe6ff8278da09489e8e6 lib/termcap.pl +SHA256 9c1586defd68326ca1537261279768a81ea508c713abbf30c38e8a37c581582b lib/timelocal.pl +SHA256 2f6061db086f5fd6b142db2111431b41798408440649443a1778c1641c9ea59c lib/validate.pl +SHA256 49e077cdc76253c72ba6d05edcff1d9540b8c8aefaa94fb922d99e1709f72d7f t/abbrev.t +SHA256 1e982b98fdea4b05f1e95bfd33a6186915d6ba71c6a788caa8c4839e044d00e9 t/bigfloat.t +SHA256 db97155772167c6fa6a38a44966eb6fe8b5d591a2f4dbd71d4ed260e5f811208 t/bigint.t +SHA256 e675e3b0a42632c63996a9638f1c5cbeb5225eb779c857099761cbb2312d884e t/getopt.t +SHA256 1acedae1cb6119ea8ce14861def2b2c2ab2d9498831fe08dec572c2ae9e23638 t/getopts.t +SHA256 be76e8eb8bb37ebed53830ed738e5b4c13e55d9b31fd2f65584619f832f122b5 t/hostname.t +SHA256 335c165d92601e43f1c0fce30d871d31fadfcbff8ced18094c7133b9c2ef7402 t/newgetopt.t +SHA256 f42c993d0e8de0f97130306af1f231d0e6f742ec5caece5fea488a8a19a0a3ff t/open2.t +SHA256 b797d1b234f6b33acd4fb2e64fa1bce2870a652c97d6301bcd0a24197d203a9e t/open3.t +SHA256 3679257bdfb4a07658e98a41325f82c1744f7dae6d1d0151f1b216af0c1df5c9 t/pod_cvg.t +SHA256 e16860066c4ca9b2ee9e7d4604297def8a58b53bf0ca03eed863b5d9c5a2ac91 t/pod_syn.t +SHA256 305bdf369789f57a1ef47bd1fcbaad93b9312aa8c2d1895cde94e962bdbef933 t/require.t +SHA256 38c9514059856bd06556b138f575132defa59aee99ddbdba74577ee63ae0f519 t/shellwords.t +SHA256 ba0eeb54bf6768a2e3890d840e198af9b2ace2ba348a7546bbca29afb354d52a t/timelocal.t -----BEGIN PGP SIGNATURE----- -Version: GnuPG v1 -iEYEARECAAYFAll9f8kACgkQOV9mt2VyAVEtEACeOlwYTBGd2JKvxj1cfMboCpEM -uGYAnjeq6pKvrRbvc27fWSMj/BkfP3Iq -=FOYv +iEYEAREDAAYFAmQO0H4ACgkQOV9mt2VyAVFxQwCfZnV/2Dt1wEKrRTKAW0XovMtb +8uUAn2YLd9Y+N0NVle0pkjYKuHSShgbE +=b4AC -----END PGP SIGNATURE----- diff --git a/debian/changelog b/debian/changelog index 49a00e0..21b32b6 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,14 @@ +libperl4-corelibs-perl (0.005-1) unstable; urgency=medium + + * Team upload. + * Import upstream version 0.005. + * Drop y2k20.patch, fixed upstream. + * Update years of upstream copyright. + * Declare compliance with Debian Policy 4.6.2. + * Set Rules-Requires-Root: no. + + -- gregor herrmann <gregoa@debian.org> Sun, 11 Jun 2023 17:27:30 +0200 + libperl4-corelibs-perl (0.004-3) unstable; urgency=medium [ gregor herrmann ] diff --git a/debian/control b/debian/control index ca220ab..4ef043a 100644 --- a/debian/control +++ b/debian/control @@ -7,16 +7,17 @@ Priority: optional Build-Depends: debhelper-compat (= 13), libmodule-build-perl, perl -Standards-Version: 4.6.0 +Standards-Version: 4.6.2 Vcs-Browser: https://salsa.debian.org/perl-team/modules/packages/libperl4-corelibs-perl Vcs-Git: https://salsa.debian.org/perl-team/modules/packages/libperl4-corelibs-perl.git Homepage: https://metacpan.org/release/Perl4-CoreLibs +Rules-Requires-Root: no Package: libperl4-corelibs-perl Architecture: all +Multi-Arch: foreign Depends: ${misc:Depends}, ${perl:Depends} -Multi-Arch: foreign Description: libraries historically supplied with Perl 4 Perl4::CoreLibs is a collection of .pl files that have historically been bundled with the Perl core but are not distributed with core version 5.15 or diff --git a/debian/copyright b/debian/copyright index 1fee836..4896487 100644 --- a/debian/copyright +++ b/debian/copyright @@ -5,7 +5,7 @@ Source: https://metacpan.org/release/Perl4-CoreLibs Files: * Copyright: 1987-2009 Larry Wall et al - 2010, 2011, 2017 Andrew Main (Zefram) <zefram@fysh.org> + 2010, 2011, 2017, 2023, Andrew Main (Zefram) <zefram@fysh.org> License: Artistic or GPL-1+ Files: debian/* diff --git a/debian/patches/auto-gitignore b/debian/patches/auto-gitignore new file mode 100644 index 0000000..d19e0cb --- /dev/null +++ b/debian/patches/auto-gitignore @@ -0,0 +1,25 @@ +Subject: Update .gitignore from Debian packaging branch + +The Debian packaging git branch contains these updates to the upstream +.gitignore file(s). This patch is autogenerated, to provide these +updates to users of the official Debian archive view of the package. + +[dgit (10.7) update-gitignore] +--- +diff --git a/.gitignore b/.gitignore +deleted file mode 100644 +index 4594861..0000000 +--- a/.gitignore ++++ /dev/null +@@ -1,11 +0,0 @@ +-/Build +-/Makefile +-/_build +-/blib +-/META.json +-/META.yml +-/MYMETA.json +-/MYMETA.yml +-/Makefile.PL +-/SIGNATURE +-/Perl4-CoreLibs-* diff --git a/debian/patches/series b/debian/patches/series index aaf2608..a22980a 100644 --- a/debian/patches/series +++ b/debian/patches/series @@ -1 +1,2 @@ -y2k20.patch + +auto-gitignore diff --git a/debian/patches/y2k20.patch b/debian/patches/y2k20.patch deleted file mode 100644 index bdbf47d..0000000 --- a/debian/patches/y2k20.patch +++ /dev/null @@ -1,39 +0,0 @@ -Description: turn the y2k20 into a y2k40 problem, or fix test failures starting in 2020 - t/timelocal.t fails with - not ok 31 - timelocal year for 1970 1 2 0 0 0 - # Failed test 'timelocal year for 1970 1 2 0 0 0' - # at t/timelocal.t line 36. - # got: '170' - # expected: '70' - not ok 37 - timegm year for 1970 1 2 0 0 0 - # Failed test 'timegm year for 1970 1 2 0 0 0' - # at t/timelocal.t line 49. - # got: '170' - # expected: '70' -Origin: vendor -Author: gregor herrmann <gregoa@debian.org> -Last-Update: 2020-09-17 -Forwarded: https://rt.cpan.org/Ticket/Display.html?id=131341 -Bug: https://rt.cpan.org/Ticket/Display.html?id=131341 -Applied-Upstream: no, but better patch available in the CPAN RT ticket - ---- a/t/timelocal.t -+++ b/t/timelocal.t -@@ -25,7 +25,7 @@ - - # Test timelocal() - { -- my $year_in = $year < 70 ? $year + 1900 : $year; -+ my $year_in = $year < 90 ? $year + 1900 : $year; - my $time = &timelocal($sec,$min,$hour,$mday,$mon,$year_in); - my($s,$m,$h,$D,$M,$Y) = localtime($time); - is $s, $sec, "timelocal second for @$_"; -@@ -38,7 +38,7 @@ - - # Test timegm() - { -- my $year_in = $year < 70 ? $year + 1900 : $year; -+ my $year_in = $year < 90 ? $year + 1900 : $year; - my $time = &timegm($sec,$min,$hour,$mday,$mon,$year_in); - my($s,$m,$h,$D,$M,$Y) = gmtime($time); - is $s, $sec, "timegm second for @$_"; diff --git a/lib/Perl4/CoreLibs.pm b/lib/Perl4/CoreLibs.pm index 26e1fe2..f3bd520 100644 --- a/lib/Perl4/CoreLibs.pm +++ b/lib/Perl4/CoreLibs.pm @@ -82,7 +82,8 @@ Inhale shell variables set by a shell script. =item exceptions.pl String-based exception handling built on C<eval> and C<die>. -Prefer L<Try::Tiny> or L<TryCatch>. +Prefer L<Try::Tiny>, L<TryCatch>, +or the core C<try>/C<catch> facility on Perl 5.33.7 or later. =item fastcwd.pl @@ -200,7 +201,7 @@ package Perl4::CoreLibs; use warnings; use strict; -our $VERSION = "0.004"; +our $VERSION = "0.005"; =head1 AUTHOR @@ -224,7 +225,8 @@ Andrew Main (Zefram) <zefram@fysh.org> built the Perl4::CoreLibs package. Copyright (C) 1987-2009 Larry Wall et al -Copyright (C) 2010, 2011, 2017 Andrew Main (Zefram) <zefram@fysh.org> +Copyright (C) 2010, 2011, 2017, 2023 +Andrew Main (Zefram) <zefram@fysh.org> =head1 LICENSE diff --git a/lib/abbrev.pl b/lib/abbrev.pl index ca281ac..38243ee 100644 --- a/lib/abbrev.pl +++ b/lib/abbrev.pl @@ -16,7 +16,7 @@ package abbrev; -sub main'abbrev { +sub main::abbrev { local(*domain) = @_; shift(@_); @cmp = @_; diff --git a/lib/assert.pl b/lib/assert.pl index 93e39ce..c75c165 100644 --- a/lib/assert.pl +++ b/lib/assert.pl @@ -11,6 +11,8 @@ # be printed out by &panic, which is just the stack-backtrace # routine shamelessly borrowed from the perl debugger. +no warnings "ambiguous"; + sub assert { &panic("ASSERTION BOTCHED: $_[0]",$@) unless eval $_[0]; } diff --git a/lib/bigfloat.pl b/lib/bigfloat.pl index 82eb188..a68c1ce 100644 --- a/lib/bigfloat.pl +++ b/lib/bigfloat.pl @@ -47,7 +47,7 @@ $rnd_mode = 'even'; # Convert a number to canonical string form. # Takes something that looks like a number and converts it to # the form /^[+-]\d+E[+-]\d+$/. -sub main'fnorm { #(string) return fnum_str +sub main::fnorm { #(string) return fnum_str local($_) = @_; s/\s+//g; # strip white space if (/^([+-]?)(\d*)(\.(\d*))?([Ee]([+-]?\d+))?$/ @@ -76,8 +76,8 @@ sub norm { #(mantissa, exponent) return fnum_str } # negation -sub main'fneg { #(fnum_str) return fnum_str - local($_) = &'fnorm($_[0]); +sub main::fneg { #(fnum_str) return fnum_str + local($_) = &::fnorm($_[0]); vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0E+0'; # flip sign if ( ord("\t") == 9 ) { # ascii s/^H/N/; @@ -89,48 +89,48 @@ sub main'fneg { #(fnum_str) return fnum_str } # absolute value -sub main'fabs { #(fnum_str) return fnum_str - local($_) = &'fnorm($_[0]); +sub main::fabs { #(fnum_str) return fnum_str + local($_) = &::fnorm($_[0]); s/^-/+/; # mash sign $_; } # multiplication -sub main'fmul { #(fnum_str, fnum_str) return fnum_str - local($x,$y) = (&'fnorm($_[0]),&'fnorm($_[1])); +sub main::fmul { #(fnum_str, fnum_str) return fnum_str + local($x,$y) = (&::fnorm($_[0]),&::fnorm($_[1])); if ($x eq 'NaN' || $y eq 'NaN') { 'NaN'; } else { local($xm,$xe) = split('E',$x); local($ym,$ye) = split('E',$y); - &norm(&'bmul($xm,$ym),$xe+$ye); + &norm(&::bmul($xm,$ym),$xe+$ye); } } # addition -sub main'fadd { #(fnum_str, fnum_str) return fnum_str - local($x,$y) = (&'fnorm($_[0]),&'fnorm($_[1])); +sub main::fadd { #(fnum_str, fnum_str) return fnum_str + local($x,$y) = (&::fnorm($_[0]),&::fnorm($_[1])); if ($x eq 'NaN' || $y eq 'NaN') { 'NaN'; } else { local($xm,$xe) = split('E',$x); local($ym,$ye) = split('E',$y); ($xm,$xe,$ym,$ye) = ($ym,$ye,$xm,$xe) if ($xe < $ye); - &norm(&'badd($ym,$xm.('0' x ($xe-$ye))),$ye); + &norm(&::badd($ym,$xm.('0' x ($xe-$ye))),$ye); } } # subtraction -sub main'fsub { #(fnum_str, fnum_str) return fnum_str - &'fadd($_[0],&'fneg($_[1])); +sub main::fsub { #(fnum_str, fnum_str) return fnum_str + &::fadd($_[0],&::fneg($_[1])); } # division # args are dividend, divisor, scale (optional) # result has at most max(scale, length(dividend), length(divisor)) digits -sub main'fdiv #(fnum_str, fnum_str[,scale]) return fnum_str +sub main::fdiv #(fnum_str, fnum_str[,scale]) return fnum_str { - local($x,$y,$scale) = (&'fnorm($_[0]),&'fnorm($_[1]),$_[2]); + local($x,$y,$scale) = (&::fnorm($_[0]),&::fnorm($_[1]),$_[2]); if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0E+0') { 'NaN'; } else { @@ -140,7 +140,7 @@ sub main'fdiv #(fnum_str, fnum_str[,scale]) return fnum_str $scale = length($xm)-1 if (length($xm)-1 > $scale); $scale = length($ym)-1 if (length($ym)-1 > $scale); $scale = $scale + length($ym) - length($xm); - &norm(&round(&'bdiv($xm.('0' x $scale),$ym),&'babs($ym)), + &norm(&round(&::bdiv($xm.('0' x $scale),$ym),&::babs($ym)), $xe-$ye-$scale); } } @@ -153,7 +153,7 @@ sub round { #(int_str, int_str, int_str) return int_str } elsif ($rnd_mode eq 'trunc') { $q; # just truncate } else { - local($cmp) = &'bcmp(&'bmul($r,'+2'),$base); + local($cmp) = &::bcmp(&::bmul($r,'+2'),$base); if ( $cmp < 0 || ($cmp == 0 && ( $rnd_mode eq 'zero' || @@ -163,15 +163,15 @@ sub round { #(int_str, int_str, int_str) return int_str ($rnd_mode eq 'odd' && $q =~ /[13579]$/) )) ) { $q; # round down } else { - &'badd($q, ((substr($q,0,1) eq '-') ? '-1' : '+1')); + &::badd($q, ((substr($q,0,1) eq '-') ? '-1' : '+1')); # round up } } } # round the mantissa of $x to $scale digits -sub main'fround { #(fnum_str, scale) return fnum_str - local($x,$scale) = (&'fnorm($_[0]),$_[1]); +sub main::fround { #(fnum_str, scale) return fnum_str + local($x,$scale) = (&::fnorm($_[0]),$_[1]); if ($x eq 'NaN' || $scale <= 0) { $x; } else { @@ -187,8 +187,8 @@ sub main'fround { #(fnum_str, scale) return fnum_str } # round $x at the 10 to the $scale digit place -sub main'ffround { #(fnum_str, scale) return fnum_str - local($x,$scale) = (&'fnorm($_[0]),$_[1]); +sub main::ffround { #(fnum_str, scale) return fnum_str + local($x,$scale) = (&::fnorm($_[0]),$_[1]); if ($x eq 'NaN') { 'NaN'; } else { @@ -216,9 +216,9 @@ sub main'ffround { #(fnum_str, scale) return fnum_str # compare 2 values returns one of undef, <0, =0, >0 # returns undef if either or both input value are not numbers -sub main'fcmp #(fnum_str, fnum_str) return cond_code +sub main::fcmp #(fnum_str, fnum_str) return cond_code { - local($x, $y) = (&'fnorm($_[0]),&'fnorm($_[1])); + local($x, $y) = (&::fnorm($_[0]),&::fnorm($_[1])); if ($x eq "NaN" || $y eq "NaN") { undef; } else { @@ -226,14 +226,14 @@ sub main'fcmp #(fnum_str, fnum_str) return cond_code || ( local($xm,$xe,$ym,$ye) = split('E', $x."E$y"), (($xe <=> $ye) * (substr($x,0,1).'1') - || &bigint'cmp($xm,$ym)) + || &bigint::cmp($xm,$ym)) ); } } # square root by Newtons method. -sub main'fsqrt { #(fnum_str[, scale]) return fnum_str - local($x, $scale) = (&'fnorm($_[0]), $_[1]); +sub main::fsqrt { #(fnum_str[, scale]) return fnum_str + local($x, $scale) = (&::fnorm($_[0]), $_[1]); if ($x eq 'NaN' || $x =~ /^-/) { 'NaN'; } elsif ($x eq '+0E+0') { @@ -244,10 +244,10 @@ sub main'fsqrt { #(fnum_str[, scale]) return fnum_str $scale = length($xm)-1 if ($scale < length($xm)-1); local($gs, $guess) = (1, sprintf("1E%+d", (length($xm)+$xe-1)/2)); while ($gs < 2*$scale) { - $guess = &'fmul(&'fadd($guess,&'fdiv($x,$guess,$gs*2)),".5"); + $guess = &::fmul(&::fadd($guess,&::fdiv($x,$guess,$gs*2)),".5"); $gs *= 2; } - &'fround($guess, $scale); + &::fround($guess, $scale); } } diff --git a/lib/bigint.pl b/lib/bigint.pl index 56727d5..33c2c0c 100644 --- a/lib/bigint.pl +++ b/lib/bigint.pl @@ -55,7 +55,7 @@ $zero = 0; # white space and add a sign, if missing. # Strings that are not numbers result the value 'NaN'. -sub main'bnorm { #(num_str) return num_str +sub main::bnorm { #(num_str) return num_str local($_) = @_; s/\s+//g; # strip white space if (s/^([+-]?)0*(\d+)$/$1$2/) { # test if number @@ -81,20 +81,20 @@ sub internal { #(num_str) return int_num_array sub external { #(int_num_array) return num_str $es = shift; grep($_ > 9999 || ($_ = substr('0000'.$_,-5)), @_); # zero pad - &'bnorm(join('', $es, reverse(@_))); # reverse concat and normalize + &::bnorm(join('', $es, reverse(@_))); # reverse concat and normalize } # Negate input value. -sub main'bneg { #(num_str) return num_str - local($_) = &'bnorm(@_); +sub main::bneg { #(num_str) return num_str + local($_) = &::bnorm(@_); vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0'; s/^./N/ unless /^[-+]/; # works both in ASCII and EBCDIC $_; } # Returns the absolute value of the input. -sub main'babs { #(num_str) return num_str - &abs(&'bnorm(@_)); +sub main::babs { #(num_str) return num_str + &abs(&::bnorm(@_)); } sub abs { # post-normalized abs for internal use @@ -104,8 +104,8 @@ sub abs { # post-normalized abs for internal use } # Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort) -sub main'bcmp { #(num_str, num_str) return cond_code - local($x,$y) = (&'bnorm($_[0]),&'bnorm($_[1])); +sub main::bcmp { #(num_str, num_str) return cond_code + local($x,$y) = (&::bnorm($_[0]),&::bnorm($_[1])); if ($x eq 'NaN') { undef; } elsif ($y eq 'NaN') { @@ -136,8 +136,8 @@ sub cmp { # post-normalized compare for internal use } -sub main'badd { #(num_str, num_str) return num_str - local(*x, *y); ($x, $y) = (&'bnorm($_[0]),&'bnorm($_[1])); +sub main::badd { #(num_str, num_str) return num_str + local(*x, *y); ($x, $y) = (&::bnorm($_[0]),&::bnorm($_[1])); if ($x eq 'NaN') { 'NaN'; } elsif ($y eq 'NaN') { @@ -159,17 +159,17 @@ sub main'badd { #(num_str, num_str) return num_str } } -sub main'bsub { #(num_str, num_str) return num_str - &'badd($_[0],&'bneg($_[1])); +sub main::bsub { #(num_str, num_str) return num_str + &::badd($_[0],&::bneg($_[1])); } # GCD -- Euclids algorithm Knuth Vol 2 pg 296 -sub main'bgcd { #(num_str, num_str) return num_str - local($x,$y) = (&'bnorm($_[0]),&'bnorm($_[1])); +sub main::bgcd { #(num_str, num_str) return num_str + local($x,$y) = (&::bnorm($_[0]),&::bnorm($_[1])); if ($x eq 'NaN' || $y eq 'NaN') { 'NaN'; } else { - ($x, $y) = ($y,&'bmod($x,$y)) while $y ne '+0'; + ($x, $y) = ($y,&::bmod($x,$y)) while $y ne '+0'; $x; } } @@ -203,8 +203,8 @@ sub sub { #(int_num_array, int_num_array) return int_num_array } # multiply two numbers -- stolen from Knuth Vol 2 pg 233 -sub main'bmul { #(num_str, num_str) return num_str - local(*x, *y); ($x, $y) = (&'bnorm($_[0]), &'bnorm($_[1])); +sub main::bmul { #(num_str, num_str) return num_str + local(*x, *y); ($x, $y) = (&::bnorm($_[0]), &::bnorm($_[1])); if ($x eq 'NaN') { 'NaN'; } elsif ($y eq 'NaN') { @@ -235,12 +235,12 @@ sub main'bmul { #(num_str, num_str) return num_str } # modulus -sub main'bmod { #(num_str, num_str) return num_str - (&'bdiv(@_))[1]; +sub main::bmod { #(num_str, num_str) return num_str + (&::bdiv(@_))[1]; } -sub main'bdiv { #(dividend: num_str, divisor: num_str) return num_str - local (*x, *y); ($x, $y) = (&'bnorm($_[0]), &'bnorm($_[1])); +sub main::bdiv { #(dividend: num_str, divisor: num_str) return num_str + local (*x, *y); ($x, $y) = (&::bnorm($_[0]), &::bnorm($_[1])); return wantarray ? ('NaN','NaN') : 'NaN' if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0'); return wantarray ? ('+0',$x) : '+0' if (&cmp(&abs($x),&abs($y)) < 0); diff --git a/lib/bigrat.pl b/lib/bigrat.pl index eb54794..7748555 100644 --- a/lib/bigrat.pl +++ b/lib/bigrat.pl @@ -40,7 +40,7 @@ require "bigint.pl"; # rsqrt(RAT, cycles) return RAT square root # Convert a number to the canonical string form m|^[+-]\d+/\d+|. -sub main'rnorm { #(string) return rat_num +sub main::rnorm { #(string) return rat_num local($_) = @_; s/\s+//g; if (m#^([+-]?\d+)(/(\d*[1-9]0*))?$#) { @@ -60,14 +60,14 @@ sub norm { #(bint, bint) return rat_num } elsif ($dom =~ /^[+-]?0+$/) { 'NaN'; } else { - local($gcd) = &'bgcd($num,$dom); + local($gcd) = &::bgcd($num,$dom); $gcd =~ s/^-/+/; if ($gcd ne '+1') { - $num = &'bdiv($num,$gcd); - $dom = &'bdiv($dom,$gcd); + $num = &::bdiv($num,$gcd); + $dom = &::bdiv($dom,$gcd); } else { - $num = &'bnorm($num); - $dom = &'bnorm($dom); + $num = &::bnorm($num); + $dom = &::bnorm($dom); } substr($dom,0,1) = ''; "$num/$dom"; @@ -75,58 +75,58 @@ sub norm { #(bint, bint) return rat_num } # negation -sub main'rneg { #(rat_num) return rat_num - local($_) = &'rnorm(@_); +sub main::rneg { #(rat_num) return rat_num + local($_) = &::rnorm(@_); tr/-+/+-/ if ($_ ne '+0/1'); $_; } # absolute value -sub main'rabs { #(rat_num) return $rat_num - local($_) = &'rnorm(@_); +sub main::rabs { #(rat_num) return $rat_num + local($_) = &::rnorm(@_); substr($_,0,1) = '+' unless $_ eq 'NaN'; $_; } # multipication -sub main'rmul { #(rat_num, rat_num) return rat_num - local($xn,$xd) = split('/',&'rnorm($_[0])); - local($yn,$yd) = split('/',&'rnorm($_[1])); - &norm(&'bmul($xn,$yn),&'bmul($xd,$yd)); +sub main::rmul { #(rat_num, rat_num) return rat_num + local($xn,$xd) = split('/',&::rnorm($_[0])); + local($yn,$yd) = split('/',&::rnorm($_[1])); + &norm(&::bmul($xn,$yn),&::bmul($xd,$yd)); } # division -sub main'rdiv { #(rat_num, rat_num) return rat_num - local($xn,$xd) = split('/',&'rnorm($_[0])); - local($yn,$yd) = split('/',&'rnorm($_[1])); - &norm(&'bmul($xn,$yd),&'bmul($xd,$yn)); +sub main::rdiv { #(rat_num, rat_num) return rat_num + local($xn,$xd) = split('/',&::rnorm($_[0])); + local($yn,$yd) = split('/',&::rnorm($_[1])); + &norm(&::bmul($xn,$yd),&::bmul($xd,$yn)); } # addition -sub main'radd { #(rat_num, rat_num) return rat_num - local($xn,$xd) = split('/',&'rnorm($_[0])); - local($yn,$yd) = split('/',&'rnorm($_[1])); - &norm(&'badd(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd)); +sub main::radd { #(rat_num, rat_num) return rat_num + local($xn,$xd) = split('/',&::rnorm($_[0])); + local($yn,$yd) = split('/',&::rnorm($_[1])); + &norm(&::badd(&::bmul($xn,$yd),&::bmul($yn,$xd)),&::bmul($xd,$yd)); } # subtraction -sub main'rsub { #(rat_num, rat_num) return rat_num - local($xn,$xd) = split('/',&'rnorm($_[0])); - local($yn,$yd) = split('/',&'rnorm($_[1])); - &norm(&'bsub(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd)); +sub main::rsub { #(rat_num, rat_num) return rat_num + local($xn,$xd) = split('/',&::rnorm($_[0])); + local($yn,$yd) = split('/',&::rnorm($_[1])); + &norm(&::bsub(&::bmul($xn,$yd),&::bmul($yn,$xd)),&::bmul($xd,$yd)); } # comparison -sub main'rcmp { #(rat_num, rat_num) return cond_code - local($xn,$xd) = split('/',&'rnorm($_[0])); - local($yn,$yd) = split('/',&'rnorm($_[1])); - &bigint'cmp(&'bmul($xn,$yd),&'bmul($yn,$xd)); +sub main::rcmp { #(rat_num, rat_num) return cond_code + local($xn,$xd) = split('/',&::rnorm($_[0])); + local($yn,$yd) = split('/',&::rnorm($_[1])); + &bigint::cmp(&::bmul($xn,$yd),&::bmul($yn,$xd)); } # int and frac parts -sub main'rmod { #(rat_num) return (rat_num,rat_num) - local($xn,$xd) = split('/',&'rnorm(@_)); - local($i,$f) = &'bdiv($xn,$xd); +sub main::rmod { #(rat_num) return (rat_num,rat_num) + local($xn,$xd) = split('/',&::rnorm(@_)); + local($i,$f) = &::bdiv($xn,$xd); if (wantarray) { ("$i/1", "$f/$xd"); } else { @@ -136,8 +136,8 @@ sub main'rmod { #(rat_num) return (rat_num,rat_num) # square root by Newtons method. # cycles specifies the number of iterations default: 5 -sub main'rsqrt { #(fnum_str[, cycles]) return fnum_str - local($x, $scale) = (&'rnorm($_[0]), $_[1]); +sub main::rsqrt { #(fnum_str[, cycles]) return fnum_str + local($x, $scale) = (&::rnorm($_[0]), $_[1]); if ($x eq 'NaN') { 'NaN'; } elsif ($x =~ /^-/) { @@ -146,7 +146,7 @@ sub main'rsqrt { #(fnum_str[, cycles]) return fnum_str local($gscale, $guess) = (0, '+1/1'); $scale = 5 if (!$scale); while ($gscale++ < $scale) { - $guess = &'rmul(&'radd($guess,&'rdiv($x,$guess)),"+1/2"); + $guess = &::rmul(&::radd($guess,&::rdiv($x,$guess)),"+1/2"); } "$guess"; # quotes necessary due to perl bug } diff --git a/lib/cacheout.pl b/lib/cacheout.pl index d2669a1..43906ac 100644 --- a/lib/cacheout.pl +++ b/lib/cacheout.pl @@ -9,13 +9,15 @@ # Open in their package. -sub cacheout'open { +no warnings "ambiguous"; + +sub cacheout::open { open($_[0], $_[1]); } # Close as well -sub cacheout'close { +sub cacheout::close { close($_[0]); } diff --git a/lib/chat2.pl b/lib/chat2.pl index 504fa7e..c65841a 100644 --- a/lib/chat2.pl +++ b/lib/chat2.pl @@ -15,21 +15,16 @@ package chat; -require 'sys/socket.ph'; +no warnings "ambiguous"; -if( defined( &main'PF_INET ) ){ - $pf_inet = &main'PF_INET; - $sock_stream = &main'SOCK_STREAM; +use Socket (); + +{ + $pf_inet = Socket::PF_INET; + $sock_stream = Socket::SOCK_STREAM; local($name, $aliases, $proto) = getprotobyname( 'tcp' ); $tcp_proto = $proto; } -else { - # XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp' - # but who the heck would change these anyway? (:-) - $pf_inet = 2; - $sock_stream = 1; - $tcp_proto = 6; -} $sockaddr = 'S n a4 x8'; @@ -40,7 +35,7 @@ $next = "chatsymbol000000"; # next one $nextpat = "^chatsymbol"; # patterns that match next++, ++, ++, ++ -## $handle = &chat'open_port("server.address",$port_number); +## $handle = &chat::open_port("server.address",$port_number); ## opens a named or numbered TCP server sub open_port { ## public @@ -84,7 +79,7 @@ sub open_port { ## public $next; # return symbol for switcharound } -## ($host, $port, $handle) = &chat'open_listen([$port_number]); +## ($host, $port, $handle) = &chat::open_listen([$port_number]); ## opens a TCP port on the current machine, ready to be listened to ## if $port_number is absent or zero, pick a default port number ## process must be uid 0 to listen to a low port number @@ -114,7 +109,7 @@ sub open_listen { ## public (@myaddr, $port, $next); # returning this } -## $handle = &chat'open_proc("command","arg1","arg2",...); +## $handle = &chat::open_proc("command","arg1","arg2",...); ## opens a /bin/sh on a pseudo-tty sub open_proc { ## public @@ -147,9 +142,9 @@ sub open_proc { ## public # $S is the read-ahead buffer -## $return = &chat'expect([$handle,] $timeout_time, +## $return = &chat::expect([$handle,] $timeout_time, ## $pat1, $body1, $pat2, $body2, ... ) -## $handle is from previous &chat'open_*(). +## $handle is from previous &chat::open_*(). ## $timeout_time is the time (either relative to the current time, or ## absolute, ala time(2)) at which a timeout event occurs. ## $pat1, $pat2, and so on are regexs which are matched against the input @@ -273,11 +268,11 @@ ESQ eval $cases; die "$cases:\n$@" if $@; } $eof = $timeout = 0; - do $subname(); + $subname->(); } -## &chat'print([$handle,] @data) -## $handle is from previous &chat'open(). +## &chat::print([$handle,] @data) +## $handle is from previous &chat::open(). ## like print $handle @data sub print { ## public @@ -287,14 +282,14 @@ sub print { ## public local $out = join $, , @_; syswrite(S, $out, length $out); - if( $chat'debug ){ + if( $chat::debug ){ print STDERR "printed:"; print STDERR @_; } } -## &chat'close([$handle,]) -## $handle is from previous &chat'open(). +## &chat::close([$handle,]) +## $handle is from previous &chat::open(). ## like close $handle sub close { ## public @@ -309,7 +304,7 @@ sub close { ## public } } -## @ready_handles = &chat'select($timeout, @handles) +## @ready_handles = &chat::select($timeout, @handles) ## select()'s the handles with a timeout value of $timeout seconds. ## Returns an array of handles that are ready for I/O. ## Both user handles and chat handles are supported (but beware of @@ -331,7 +326,8 @@ sub select { ## public } $handlename{fileno($_)} = $_; } else { - $handlename{fileno(/'/ ? $_ : "$caller\'$_")} = $_; + $handlename{fileno(/(?:::|')/ ? $_ : "$caller\::$_")} = + $_; } } for (sort keys %handlename) { @@ -344,7 +340,7 @@ sub select { ## public sort keys %ready; } -# ($pty,$tty) = $chat'_getpty(PTY,TTY): +# ($pty,$tty) = $chat::_getpty(PTY,TTY): # internal procedure to get the next available pty. # opens pty on handle PTY, and matching tty on handle TTY. # returns undef if can't find a pty. @@ -352,8 +348,8 @@ sub select { ## public sub _getpty { ## private local($_PTY,$_TTY) = @_; - $_PTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e; - $_TTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e; + $_PTY =~ s/^([^':]+)$/(caller)[$[]."::".$1/e; + $_TTY =~ s/^([^':]+)$/(caller)[$[]."::".$1/e; local($pty, $tty, $kind); if( -e "/dev/pts000" ){ ## mods by Joe Doupnik Dec 1992 $kind = "pts"; ## SVR4 Streams diff --git a/lib/complete.pl b/lib/complete.pl index 925ce86..d1cec46 100644 --- a/lib/complete.pl +++ b/lib/complete.pl @@ -16,7 +16,7 @@ ;# This routine provides word completion. ;# (TAB) attempts word completion. ;# (^D) prints completion list. -;# (These may be changed by setting $Complete'complete, etc.) +;# (These may be changed by setting $Complete::complete, etc.) ;# ;# Diagnostics: ;# Bell when word completion fails. diff --git a/lib/dotsh.pl b/lib/dotsh.pl index 810ebc4..20ac42a 100644 --- a/lib/dotsh.pl +++ b/lib/dotsh.pl @@ -31,6 +31,8 @@ # &dotsh ('/foo/bar'); # &dotsh ('/foo/bar arg1 ... argN'); # +no warnings "ambiguous"; + sub dotsh { local(@sh) = @_; local($tmp,$key,$shell,$command,$args,$vars) = ''; diff --git a/lib/exceptions.pl b/lib/exceptions.pl index ed1f927..0bf90b3 100644 --- a/lib/exceptions.pl +++ b/lib/exceptions.pl @@ -41,11 +41,11 @@ sub catch { local($__exception__); eval "package $__package__; $__code__"; - if ($__exception__ = &'thrown) { + if ($__exception__ = &::thrown) { for (@__exceptions__) { return $__exception__ if /$__exception__/; } - &'throw($__exception__); + &::throw($__exception__); } } diff --git a/lib/flush.pl b/lib/flush.pl index 8aa6d55..dd24490 100644 --- a/lib/flush.pl +++ b/lib/flush.pl @@ -13,6 +13,8 @@ ;# Usage: &printflush(FILEHANDLE, "prompt: ") ;# prints arguments and flushes filehandle +no warnings "ambiguous"; + sub flush { local($old) = select(shift); $| = 1; @@ -97,26 +97,21 @@ # Initial revision # +no warnings "ambiguous"; + +use Socket (); + require 'chat2.pl'; # into main -eval "require 'socket.ph'" || eval "require 'sys/socket.ph'" - || die "socket.ph missing: $!\n"; package ftp; -if( defined( &main'PF_INET ) ){ - $pf_inet = &main'PF_INET; - $sock_stream = &main'SOCK_STREAM; +{ + $pf_inet = Socket::PF_INET; + $sock_stream = Socket::SOCK_STREAM; local($name, $aliases, $proto) = getprotobyname( 'tcp' ); $tcp_proto = $proto; } -else { - # XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp' - # but who the heck would change these anyway? (:-) - $pf_inet = 2; - $sock_stream = 1; - $tcp_proto = 6; -} # If the remote ftp daemon doesn't respond within this time presume its dead # or something. @@ -130,25 +125,25 @@ $timeout_open = $timeout; # This is a "global" it contains the last response from the remote ftp server # for use in error messages -$ftp'response = ""; -# Also ftp'NS is the socket containing the data coming in from the remote ls +$ftp::response = ""; +# Also ftp::NS is the socket containing the data coming in from the remote ls # command. # The size of block to be read or written when talking to the remote # ftp server -$ftp'ftpbufsize = 4096; +$ftp::ftpbufsize = 4096; # How often to print a hash out, when debugging -$ftp'hashevery = 1024; +$ftp::hashevery = 1024; # Output a newline after this many hashes to prevent outputing very long lines -$ftp'hashnl = 70; +$ftp::hashnl = 70; # If a proxy connection then who am I really talking to? $real_site = ""; # This is just a tracing aid. $ftp_show = 0; -sub ftp'debug +sub ftp::debug { $ftp_show = $_[0]; # if( $ftp_show ){ @@ -156,7 +151,7 @@ sub ftp'debug # } } -sub ftp'set_timeout +sub ftp::set_timeout { $timeout = $_[0]; $timeout_open = $timeout; @@ -167,12 +162,12 @@ sub ftp'set_timeout } -sub ftp'open_alarm +sub ftp::open_alarm { die "timeout: open"; } -sub ftp'timed_open +sub ftp::timed_open { local( $site, $ftp_port, $retry_call, $attempts ) = @_; local( $connect_site, $connect_port ); @@ -207,7 +202,7 @@ sub ftp'timed_open $connect_site = $site; $connect_port = $ftp_port; } - if( ! &chat'open_port( $connect_site, $connect_port ) ){ + if( ! &chat::open_port( $connect_site, $connect_port ) ){ if( $retry_call ){ print STDERR "Failed to connect\n" if $ftp_show; next; @@ -218,12 +213,12 @@ sub ftp'timed_open return 0; } } - $res = &ftp'expect( $timeout, + $res = &ftp::expect( $timeout, 120, "service unavailable to $site", 0, 220, "ready for login to $site", 1, 421, "service unavailable to $site, closing connection", 0); if( ! $res ){ - &chat'close(); + &chat::close(); next; } return 1; @@ -235,11 +230,11 @@ sub ftp'timed_open return 0; } -sub ftp'open +sub ftp::open { local( $site, $ftp_port, $retry_call, $attempts ) = @_; - $SIG{ 'ALRM' } = "ftp\'open_alarm"; + $SIG{ 'ALRM' } = "ftp::open_alarm"; local( $ret ) = eval "&timed_open( '$site', $ftp_port, $retry_call, $attempts )"; alarm( 0 ); @@ -250,18 +245,18 @@ sub ftp'open return $ret; } -sub ftp'login +sub ftp::login { local( $remote_user, $remote_password ) = @_; if( $proxy ){ - &ftp'send( "USER $remote_user\@$site" ); + &ftp::send( "USER $remote_user\@$site" ); } else { - &ftp'send( "USER $remote_user" ); + &ftp::send( "USER $remote_user" ); } local( $val ) = - &ftp'expect($timeout, + &ftp::expect($timeout, 230, "$remote_user logged in", 1, 331, "send password for $remote_user", 2, @@ -276,9 +271,9 @@ sub ftp'login } if( $val == 2 ){ # A password is needed - &ftp'send( "PASS $remote_password" ); + &ftp::send( "PASS $remote_password" ); - $val = &ftp'expect( $timeout, + $val = &ftp::expect( $timeout, 230, "$remote_user logged in", 1, 202, "command not implemented", 0, @@ -299,22 +294,22 @@ sub ftp'login return 0; } -sub ftp'close +sub ftp::close { - &ftp'quit(); - &chat'close(); + &ftp::quit(); + &chat::close(); } # Change directory # return 1 if successful # 0 on a failure -sub ftp'cwd +sub ftp::cwd { local( $dir ) = @_; - &ftp'send( "CWD $dir" ); + &ftp::send( "CWD $dir" ); - return &ftp'expect( $timeout, + return &ftp::expect( $timeout, 200, "working directory = $dir", 1, 250, "working directory = $dir", 1, @@ -327,28 +322,28 @@ sub ftp'cwd } # Get a full directory listing: -# &ftp'dir( remote LIST options ) +# &ftp::dir( remote LIST options ) # Start a list goin with the given options. # Presuming that the remote deamon uses the ls command to generate the # data to send back then then you can send it some extra options (eg: -lRa) # return 1 if sucessful and 0 on a failure -sub ftp'dir_open +sub ftp::dir_open { local( $options ) = @_; local( $ret ); - if( ! &ftp'open_data_socket() ){ + if( ! &ftp::open_data_socket() ){ return 0; } if( $options ){ - &ftp'send( "LIST $options" ); + &ftp::send( "LIST $options" ); } else { - &ftp'send( "LIST" ); + &ftp::send( "LIST" ); } - $ret = &ftp'expect( $timeout, + $ret = &ftp::expect( $timeout, 150, "reading directory", 1, 125, "data connection already open?", 0, @@ -361,7 +356,7 @@ sub ftp'dir_open 421, "service unavailable, closing connection", 0 ); if( ! $ret ){ - &ftp'close_data_socket; + &ftp::close_data_socket; return 0; } @@ -378,13 +373,13 @@ sub ftp'dir_open # Close down reading the result of a remote ls command # return 1 if successful and 0 on failure -sub ftp'dir_close +sub ftp::dir_close { local( $ret ); # read the close # - $ret = &ftp'expect($timeout, + $ret = &ftp::expect($timeout, 226, "", 1, # transfer complete, closing connection 250, "", 1, # action completed @@ -394,7 +389,7 @@ sub ftp'dir_close 421, "service unavailable, closing connection", 0); # shut down our end of the socket - &ftp'close_data_socket; + &ftp::close_data_socket; if( ! $ret ){ return 0; @@ -405,33 +400,33 @@ sub ftp'dir_close # Quit from the remote ftp server # return 1 if successful and 0 on failure -sub ftp'quit +sub ftp::quit { $site_command_check = 0; @site_command_list = (); - &ftp'send("QUIT"); + &ftp::send("QUIT"); - return &ftp'expect($timeout, + return &ftp::expect($timeout, 221, "Goodbye", 1, # transfer complete, closing connection 500, "error quitting??", 0); } -sub ftp'read_alarm +sub ftp::read_alarm { die "timeout: read"; } -sub ftp'timed_read +sub ftp::timed_read { alarm( $timeout_read ); return sysread( NS, $buf, $ftpbufsize ); } -sub ftp'read +sub ftp::read { - $SIG{ 'ALRM' } = "ftp\'read_alarm"; + $SIG{ 'ALRM' } = "ftp::read_alarm"; local( $ret ) = eval '&timed_read()'; alarm( 0 ); @@ -445,7 +440,7 @@ sub ftp'read # Get a remote file back into a local file. # If no loc_fname passed then uses rem_fname. # returns 1 on success and 0 on failure -sub ftp'get +sub ftp::get { local($rem_fname, $loc_fname, $restart ) = @_; @@ -453,15 +448,15 @@ sub ftp'get $loc_fname = $rem_fname; } - if( ! &ftp'open_data_socket() ){ + if( ! &ftp::open_data_socket() ){ print STDERR "Cannot open data socket\n"; return 0; } if( $loc_fname ne '-' ){ # Find the size of the target file - local( $restart_at ) = &ftp'filesize( $loc_fname ); - if( $restart && $restart_at > 0 && &ftp'restart( $restart_at ) ){ + local( $restart_at ) = &ftp::filesize( $loc_fname ); + if( $restart && $restart_at > 0 && &ftp::restart( $restart_at ) ){ $restart = 1; # Make sure the file can be updated chmod( 0644, $loc_fname ); @@ -472,10 +467,10 @@ sub ftp'get } } - &ftp'send( "RETR $rem_fname" ); + &ftp::send( "RETR $rem_fname" ); local( $ret ) = - &ftp'expect($timeout, + &ftp::expect($timeout, 150, "receiving $rem_fname", 1, 125, "data connection already open?", 0, @@ -492,7 +487,7 @@ sub ftp'get print STDERR "Failure on RETR command\n"; # shut down our end of the socket - &ftp'close_data_socket; + &ftp::close_data_socket; return 0; } @@ -511,7 +506,7 @@ sub ftp'get print STDERR "Cannot create local file $loc_fname\n"; # shut down our end of the socket - &ftp'close_data_socket; + &ftp::close_data_socket; return 0; } @@ -522,22 +517,22 @@ sub ftp'get local( $start_time ) = time; local( $bytes, $lasthash, $hashes ) = (0, 0, 0); - while( ($len = &ftp'read()) > 0 ){ + while( ($len = &ftp::read()) > 0 ){ $bytes += $len; if( $strip_cr ){ - $ftp'buf =~ s/\r//g; + $ftp::buf =~ s/\r//g; } if( $ftp_show ){ - while( $bytes > ($lasthash + $ftp'hashevery) ){ + while( $bytes > ($lasthash + $ftp::hashevery) ){ print STDERR '#'; - $lasthash += $ftp'hashevery; + $lasthash += $ftp::hashevery; $hashes++; - if( ($hashes % $ftp'hashnl) == 0 ){ + if( ($hashes % $ftp::hashnl) == 0 ){ print STDERR "\n"; } } } - if( ! print FH $ftp'buf ){ + if( ! print FH $ftp::buf ){ print STDERR "\nfailed to write data"; return 0; } @@ -545,7 +540,7 @@ sub ftp'get close( FH ); # shut down our end of the socket - &ftp'close_data_socket; + &ftp::close_data_socket; if( $len < 0 ){ print STDERR "\ntimed out reading data!\n"; @@ -554,7 +549,7 @@ sub ftp'get } if( $ftp_show ){ - if( $hashes && ($hashes % $ftp'hashnl) != 0 ){ + if( $hashes && ($hashes % $ftp::hashnl) != 0 ){ print STDERR "\n"; } local( $secs ) = (time - $start_time); @@ -570,7 +565,7 @@ sub ftp'get # read the close # - $ret = &ftp'expect($timeout, + $ret = &ftp::expect($timeout, 226, "Got file", 1, # transfer complete, closing connection 250, "Got file", 1, # action completed @@ -583,19 +578,19 @@ sub ftp'get return $ret; } -sub ftp'delete +sub ftp::delete { local( $rem_fname, $val ) = @_; - &ftp'send("DELE $rem_fname" ); - $val = &ftp'expect( $timeout, + &ftp::send("DELE $rem_fname" ); + $val = &ftp::expect( $timeout, 250,"Deleted $rem_fname", 1, 550,"Permission denied",0 ); return $val == 1; } -sub ftp'deldir +sub ftp::deldir { local( $fname ) = @_; @@ -605,7 +600,7 @@ sub ftp'deldir # UPDATE ME!!!!!! # Add in the hash printing and newline conversion -sub ftp'put +sub ftp::put { local( $loc_fname, $rem_fname ) = @_; local( $strip_cr ); @@ -614,18 +609,18 @@ sub ftp'put $loc_fname = $rem_fname; } - if( ! &ftp'open_data_socket() ){ + if( ! &ftp::open_data_socket() ){ return 0; } - &ftp'send("STOR $rem_fname"); + &ftp::send("STOR $rem_fname"); # # the data should be coming at us now # local( $ret ) = - &ftp'expect($timeout, + &ftp::expect($timeout, 150, "sending $loc_fname", 1, 125, "data connection already open?", 0, @@ -643,7 +638,7 @@ sub ftp'put if( $ret != 1 ){ # shut down our end of the socket - &ftp'close_data_socket; + &ftp::close_data_socket; return 0; } @@ -663,7 +658,7 @@ sub ftp'put print STDERR "Cannot open local file $loc_fname\n"; # shut down our end of the socket - &ftp'close_data_socket; + &ftp::close_data_socket; return 0; } @@ -674,13 +669,13 @@ sub ftp'put close(FH); # shut down our end of the socket to signal EOF - &ftp'close_data_socket; + &ftp::close_data_socket; # # read the close # - $ret = &ftp'expect($timeout, + $ret = &ftp::expect($timeout, 226, "file put", 1, # transfer complete, closing connection 250, "file put", 1, # action completed @@ -698,16 +693,16 @@ sub ftp'put return $ret; } -sub ftp'restart +sub ftp::restart { local( $restart_point, $ret ) = @_; - &ftp'send("REST $restart_point"); + &ftp::send("REST $restart_point"); # # see what they say - $ret = &ftp'expect($timeout, + $ret = &ftp::expect($timeout, 350, "restarting at $restart_point", 1, 500, "syntax error", 0, @@ -721,16 +716,16 @@ sub ftp'restart } # Set the file transfer type -sub ftp'type +sub ftp::type { local( $type ) = @_; - &ftp'send("TYPE $type"); + &ftp::send("TYPE $type"); # # see what they say - $ret = &ftp'expect($timeout, + $ret = &ftp::expect($timeout, 200, "file type set to $type", 1, 500, "syntax error", 0, @@ -745,7 +740,7 @@ $site_command_check = 0; @site_command_list = (); # routine to query the remote server for 'SITE' commands supported -sub ftp'site_commands +sub ftp::site_commands { local( $ret ); @@ -754,11 +749,11 @@ sub ftp'site_commands $site_command_check = 1; - &ftp'send( "HELP SITE" ); + &ftp::send( "HELP SITE" ); # assume the line in the HELP SITE response with the 'HELP' # command is the one for us - $ret = &ftp'expect( $timeout, + $ret = &ftp::expect( $timeout, ".*HELP.*", "", "\$1", 214, "", "0", 202, "", "0" ); @@ -774,16 +769,16 @@ sub ftp'site_commands } # return the pwd, or null if we can't get the pwd -sub ftp'pwd +sub ftp::pwd { local( $ret, $cwd ); - &ftp'send( "PWD" ); + &ftp::send( "PWD" ); # # see what they say - $ret = &ftp'expect( $timeout, + $ret = &ftp::expect( $timeout, 257, "working dir is", 1, 500, "syntax error", 0, 501, "syntax error", 0, @@ -792,7 +787,7 @@ sub ftp'pwd 421, "service unavailable, closing connection", 0 ); if( $ret ){ - if( $ftp'response =~ /^257\s"(.*)"\s.*$/ ){ + if( $ftp::response =~ /^257\s"(.*)"\s.*$/ ){ $cwd = $1; } } @@ -800,17 +795,17 @@ sub ftp'pwd } # return 1 for success, 0 for failure -sub ftp'mkdir +sub ftp::mkdir { local( $path ) = @_; local( $ret ); - &ftp'send( "MKD $path" ); + &ftp::send( "MKD $path" ); # # see what they say - $ret = &ftp'expect( $timeout, + $ret = &ftp::expect( $timeout, 257, "made directory $path", 1, 500, "syntax error", 0, @@ -824,17 +819,17 @@ sub ftp'mkdir } # return 1 for success, 0 for failure -sub ftp'chmod +sub ftp::chmod { local( $path, $mode ) = @_; local( $ret ); - &ftp'send( sprintf( "SITE CHMOD %o $path", $mode ) ); + &ftp::send( sprintf( "SITE CHMOD %o $path", $mode ) ); # # see what they say - $ret = &ftp'expect( $timeout, + $ret = &ftp::expect( $timeout, 200, "chmod $mode $path succeeded", 1, 500, "syntax error", 0, @@ -848,17 +843,17 @@ sub ftp'chmod } # rename a file -sub ftp'rename +sub ftp::rename { local( $old_name, $new_name ) = @_; local( $ret ); - &ftp'send( "RNFR $old_name" ); + &ftp::send( "RNFR $old_name" ); # # see what they say - $ret = &ftp'expect( $timeout, + $ret = &ftp::expect( $timeout, 350, "", 1, 500, "syntax error", 0, @@ -873,12 +868,12 @@ sub ftp'rename # check if the "rename from" occurred ok if( $ret ) { - &ftp'send( "RNTO $new_name" ); + &ftp::send( "RNTO $new_name" ); # # see what they say - $ret = &ftp'expect( $timeout, + $ret = &ftp::expect( $timeout, 250, "rename $old_name to $new_name", 1, 500, "syntax error", 0, @@ -896,13 +891,13 @@ sub ftp'rename } -sub ftp'quote +sub ftp::quote { local( $cmd ) = @_; - &ftp'send( $cmd ); + &ftp::send( $cmd ); - return &ftp'expect( $timeout, + return &ftp::expect( $timeout, 200, "Remote '$cmd' OK", 1, 500, "error in remote '$cmd'", 0 ); } @@ -910,32 +905,32 @@ sub ftp'quote # ------------------------------------------------------------------------------ # These are the lower level support routines -sub ftp'expectgot +sub ftp::expectgot { - ($ftp'response, $ftp'fatalerror) = @_; + ($ftp::response, $ftp::fatalerror) = @_; if( $ftp_show ){ - print STDERR "$ftp'response\n"; + print STDERR "$ftp::response\n"; } } # -# create the list of parameters for chat'expect +# create the list of parameters for chat::expect # -# ftp'expect(time_out, {value, string_to_print, return value}); +# ftp::expect(time_out, {value, string_to_print, return value}); # if the string_to_print is "" then nothing is printed -# the last response is stored in $ftp'response +# the last response is stored in $ftp::response # # NOTE: lmjm has changed this code such that the string_to_print is # ignored and the string sent back from the remote system is printed # instead. # -sub ftp'expect { +sub ftp::expect { local( $ret ); local( $time_out ); local( $expect_args ); - $ftp'response = ''; - $ftp'fatalerror = 0; + $ftp::response = ''; + $ftp::fatalerror = 0; @expect_args = (); @@ -950,33 +945,33 @@ sub ftp'expect { push( @expect_args, "$pre(" . $code . " .*)\\015\\n" ); shift( @_ ); push( @expect_args, - "&ftp'expectgot( \$1, 0 ); " . shift( @_ ) ); + "&ftp::expectgot( \$1, 0 ); " . shift( @_ ) ); } # Treat all unrecognised lines as continuations push( @expect_args, "^(.*)\\015\\n" ); - push( @expect_args, "&ftp'expectgot( \$1, 0 ); 100" ); + push( @expect_args, "&ftp::expectgot( \$1, 0 ); 100" ); # add patterns TIMEOUT and EOF push( @expect_args, 'TIMEOUT' ); - push( @expect_args, "&ftp'expectgot( \"timed out\", 1 ); 0" ); + push( @expect_args, "&ftp::expectgot( \"timed out\", 1 ); 0" ); push( @expect_args, 'EOF' ); - push( @expect_args, "&ftp'expectgot( \"remote server gone away\", 1 ); 0" ); + push( @expect_args, "&ftp::expectgot( \"remote server gone away\", 1 ); 0" ); if( $ftp_show > 9 ){ &printargs( $time_out, @expect_args ); } - $ret = &chat'expect( $time_out, @expect_args ); + $ret = &chat::expect( $time_out, @expect_args ); if( $ret == 100 ){ # we saw a continuation line, wait for the end push( @expect_args, "^.*\n" ); push( @expect_args, "100" ); while( $ret == 100 ){ - $ret = &chat'expect( $time_out, @expect_args ); + $ret = &chat::expect( $time_out, @expect_args ); } } @@ -986,7 +981,7 @@ sub ftp'expect { # # opens NS for io # -sub ftp'open_data_socket +sub ftp::open_data_socket { local( $ret ); local( $hostname ); @@ -1005,10 +1000,10 @@ sub ftp'open_data_socket # ($name, $aliases, $type, $len, $thisaddr) = # gethostbyname( $hostname ); - ($a,$b,$c,$d) = unpack( 'C4', $chat'thisaddr ); + ($a,$b,$c,$d) = unpack( 'C4', $chat::thisaddr ); -# $this = pack( $sockaddr, &main'AF_INET, 0, $thisaddr ); - $this = $chat'thisproc; +# $this = pack( $sockaddr, Socket::AF_INET, 0, $thisaddr ); + $this = $chat::thisproc; socket(S, $pf_inet, $sock_stream, $proto ) || die "socket: $!"; bind(S, $this) || die "bind: $!"; @@ -1026,9 +1021,9 @@ sub ftp'open_data_socket # listen( S, 5 ) || die "listen"; - &ftp'send( "PORT $a,$b,$c,$d,$hi,$lo" ); + &ftp::send( "PORT $a,$b,$c,$d,$hi,$lo" ); - return &ftp'expect($timeout, + return &ftp::expect($timeout, 200, "PORT command successful", 1, 250, "PORT command successful", 1 , @@ -1039,12 +1034,12 @@ sub ftp'open_data_socket 421, "service unavailable, closing connection", 0); } -sub ftp'close_data_socket +sub ftp::close_data_socket { close(NS); } -sub ftp'send +sub ftp::send { local($send_cmd) = @_; if( $send_cmd =~ /\n/ ){ @@ -1060,17 +1055,17 @@ sub ftp'send print STDERR "---> $sc\n"; } - &chat'print( "$send_cmd\r\n" ); + &chat::print( "$send_cmd\r\n" ); } -sub ftp'printargs +sub ftp::printargs { while( @_ ){ print STDERR shift( @_ ) . "\n"; } } -sub ftp'filesize +sub ftp::filesize { local( $fname ) = @_; diff --git a/lib/getcwd.pl b/lib/getcwd.pl index 3cac4d9..06ee464 100644 --- a/lib/getcwd.pl +++ b/lib/getcwd.pl @@ -26,7 +26,7 @@ sub getcwd $dotdots .= '/' if $dotdots; $dotdots .= '..'; @pst = @cst; - unless (opendir(getcwd'PARENT, $dotdots)) #')) + unless (opendir(getcwd::PARENT, $dotdots)) { warn "opendir($dotdots): $!"; return ''; @@ -34,7 +34,7 @@ sub getcwd unless (@cst = stat($dotdots)) { warn "stat($dotdots): $!"; - closedir(getcwd'PARENT); #'); + closedir(getcwd::PARENT); return ''; } if ($pst[0] == $cst[0] && $pst[1] == $cst[1]) @@ -45,16 +45,16 @@ sub getcwd { do { - unless (defined ($dir = readdir(getcwd'PARENT))) #')) + unless (defined ($dir = readdir(getcwd::PARENT))) { warn "readdir($dotdots): $!"; - closedir(getcwd'PARENT); #'); + closedir(getcwd::PARENT); return ''; } unless (@tst = lstat("$dotdots/$dir")) { # warn "lstat($dotdots/$dir): $!"; - # closedir(getcwd'PARENT); #'); + # closedir(getcwd::PARENT); # return ''; } } @@ -62,7 +62,7 @@ sub getcwd $tst[1] != $pst[1]); } $cwd = "$dir/$cwd"; - closedir(getcwd'PARENT); #'); + closedir(getcwd::PARENT); } while ($dir ne ''); chop($cwd); $cwd; diff --git a/lib/getopt.pl b/lib/getopt.pl index 771db38..e2f2ae1 100644 --- a/lib/getopt.pl +++ b/lib/getopt.pl @@ -15,7 +15,7 @@ ;# whether there is a space between the switch and the argument. ;# Usage: -;# do Getopt('oDI'); # -o, -D & -I take arg. Sets opt_* as a side effect. +;# Getopt('oDI'); # -o, -D & -I take arg. Sets opt_* as a side effect. sub Getopt { local($argumentative) = @_; diff --git a/lib/getopts.pl b/lib/getopts.pl index 5b18fe0..32e892d 100644 --- a/lib/getopts.pl +++ b/lib/getopts.pl @@ -9,8 +9,8 @@ # Suggested alternatives: Getopt::Long or Getopt::Std # ;# Usage: -;# do Getopts('a:bc'); # -a takes arg. -b & -c not. Sets opt_* as a -;# # side effect. +;# Getopts('a:bc'); # -a takes arg. -b & -c not. Sets opt_* as a +;# # side effect. sub Getopts { local($argumentative) = @_; diff --git a/lib/hostname.pl b/lib/hostname.pl index 63eea8f..cdc170c 100644 --- a/lib/hostname.pl +++ b/lib/hostname.pl @@ -8,6 +8,8 @@ # # Suggested alternative: Sys::Hostname # +no warnings "ambiguous"; + sub hostname { local(*P,@tmp,$hostname,$_); @@ -21,7 +21,7 @@ package pwd; -sub main'initpwd { +sub main::initpwd { if ($ENV{'PWD'}) { local($dd,$di) = stat('.'); local($pd,$pi) = stat($ENV{'PWD'}); @@ -41,7 +41,7 @@ sub main'initpwd { } } -sub main'chdir { +sub main::chdir { local($newdir) = shift; $newdir =~ s|/{2,}|/|g; if (chdir $newdir) { diff --git a/lib/stat.pl b/lib/stat.pl index 5faa541..0ee682f 100644 --- a/lib/stat.pl +++ b/lib/stat.pl @@ -19,7 +19,7 @@ $ST_BLOCKS = 12; ;# Usage: ;# require 'stat.pl'; -;# do Stat('foo'); # sets st_* as a side effect +;# Stat('foo'); # sets st_* as a side effect ;# sub Stat { ($st_dev,$st_ino,$st_mode,$st_nlink,$st_uid,$st_gid,$st_rdev,$st_size, diff --git a/lib/syslog.pl b/lib/syslog.pl index f0dbb1c..9970d6e 100644 --- a/lib/syslog.pl +++ b/lib/syslog.pl @@ -15,37 +15,35 @@ # then (put these all in a script to test function) # # -# do openlog($program,'cons,pid','user'); -# do syslog('info','this is another test'); -# do syslog('mail|warning','this is a better test: %d', time); -# do closelog(); +# openlog($program,'cons,pid','user'); +# syslog('info','this is another test'); +# syslog('mail|warning','this is a better test: %d', time); +# closelog(); # -# do syslog('debug','this is the last test'); -# do openlog("$program $$",'ndelay','user'); -# do syslog('notice','fooprogram: this is really done'); +# syslog('debug','this is the last test'); +# openlog("$program $$",'ndelay','user'); +# syslog('notice','fooprogram: this is really done'); # # $! = 55; -# do syslog('info','problem was %m'); # %m == $! in syslog(3) +# syslog('info','problem was %m'); # %m == $! in syslog(3) package syslog; +no warnings "ambiguous"; use warnings::register; -$host = 'localhost' unless $host; # set $syslog'host to change +use Socket (); +use Sys::Syslog 0.19 qw(:macros); + +$host = 'localhost' unless $host; # set $syslog::host to change if ($] >= 5 && warnings::enabled()) { warnings::warn("You should 'use Sys::Syslog' instead; continuing"); } -require 'syslog.ph'; - - eval 'use Socket; 1' || - eval { require "socket.ph" } || - require "sys/socket.ph"; - $maskpri = &LOG_UPTO(&LOG_DEBUG); -sub main'openlog { +sub main::openlog { ($ident, $logopt, $facility) = @_; # package vars $lo_pid = $logopt =~ /\bpid\b/; $lo_ndelay = $logopt =~ /\bndelay\b/; @@ -54,18 +52,18 @@ sub main'openlog { &connect if $lo_ndelay; } -sub main'closelog { +sub main::closelog { $facility = $ident = ''; &disconnect; } -sub main'setlogmask { +sub main::setlogmask { local($oldmask) = $maskpri; $maskpri = shift; $oldmask; } -sub main'syslog { +sub main::syslog { local($priority) = shift; local($mask) = shift; local($message, $whoami); @@ -144,18 +142,18 @@ sub xlate { local($name) = @_; $name = uc $name; $name = "LOG_$name" unless $name =~ /^LOG_/; - $name = "syslog'$name"; + $name = "syslog::$name"; defined &$name ? &$name : -1; } sub connect { $pat = 'S n C4 x8'; - $af_unix = &AF_UNIX; - $af_inet = &AF_INET; + $af_unix = Socket::AF_UNIX; + $af_inet = Socket::AF_INET; - $stream = &SOCK_STREAM; - $datagram = &SOCK_DGRAM; + $stream = Socket::SOCK_STREAM; + $datagram = Socket::SOCK_DGRAM; ($name,$aliases,$proto) = getprotobyname('udp'); $udp = $proto; diff --git a/lib/termcap.pl b/lib/termcap.pl index 676d973..cbdb55e 100644 --- a/lib/termcap.pl +++ b/lib/termcap.pl @@ -18,6 +18,8 @@ ;# &Tputs(&Tgoto($TC{'cm'},$col,$row), 0, 'FILEHANDLE'); ;# &Tputs($TC{'dl'},$affcnt,'FILEHANDLE'); ;# +no warnings "ambiguous"; + sub Tgetent { local($TERM) = @_; local($TERMCAP,$_,$entry,$loop,$field); diff --git a/lib/validate.pl b/lib/validate.pl index c655872..3fff4eb 100644 --- a/lib/validate.pl +++ b/lib/validate.pl @@ -16,7 +16,7 @@ ;# Usage: ;# require "validate.pl"; -;# $warnings += do validate(' +;# $warnings += validate(' ;# /vmunix -e || die ;# /boot -e || die ;# /bin cd @@ -46,7 +46,7 @@ sub validate { $this =~ s/(-\w\b)/$1 \$file/g; $this =~ s/-Z/-$one/; $this .= ' || warn' unless $this =~ /\|\|/; - $this =~ s/^(.*\S)\s*\|\|\s*(die|warn)$/$1 || do valmess('$2','$1')/; + $this =~ s/^(.*\S)\s*\|\|\s*(die|warn)$/$1 || valmess('$2','$1')/; $this =~ s/\bcd\b/chdir (\$cwd = \$file)/g; eval $this; last if $warnings > $oldwarnings; diff --git a/t/require.t b/t/require.t new file mode 100644 index 0000000..c81426f --- /dev/null +++ b/t/require.t @@ -0,0 +1,30 @@ +use warnings; +use strict; + +use Test::More tests => 2*33; + +# None of the libraries set a lexical warning state, so they're all +# subject to the -w switch. Turn that on here so that we'll detect +# warnings that would only show up under -w. +$^W = 1; + +foreach my $libfile (qw( + abbrev.pl assert.pl bigfloat.pl bigint.pl bigrat.pl cacheout.pl + chat2.pl complete.pl ctime.pl dotsh.pl exceptions.pl fastcwd.pl find.pl + finddepth.pl flush.pl ftp.pl getcwd.pl getopt.pl getopts.pl hostname.pl + importenv.pl look.pl newgetopt.pl open2.pl open3.pl pwd.pl + shellwords.pl stat.pl syslog.pl tainted.pl termcap.pl timelocal.pl + validate.pl +)) { + my @warnings; + local $SIG{__WARN__} = sub { push @warnings, $_[0] }; + require_ok $libfile; + if($libfile eq "syslog.pl" && @warnings && + $warnings[0] =~ /\AYou\ should\ 'use\ Sys::Syslog' + \ instead;\ continuing\ /x) { + shift @warnings; + } + is_deeply \@warnings, []; +} + +1; diff --git a/t/timelocal.t b/t/timelocal.t index d7cd52b..48ca461 100644 --- a/t/timelocal.t +++ b/t/timelocal.t @@ -1,52 +1,48 @@ use warnings; use strict; -use Config; -use Test::More tests => 135; +use Test::More tests => 85; require_ok "timelocal.pl"; +my $min_ok_year = $^O eq "VMS" || !defined((localtime(-259200))[0]) ? 1970 : + $^O eq "vos" ? 1980 : 1904; +my $current_year = (gmtime)[5] + 1900; + foreach( #year,mon,day,hour,min,sec + [1904, 2, 29, 0, 0, 0], [1950, 4, 12, 9, 30, 31], [1969, 12, 31, 16, 59, 59], - [1970, 1, 2, 00, 00, 00], + [1970, 1, 3, 00, 00, 00], [1980, 2, 28, 12, 00, 00], [1980, 2, 29, 12, 00, 00], + [1996, 2, 29, 0, 0, 0], [1999, 12, 31, 23, 59, 59], [2000, 1, 1, 00, 00, 00], + [2000, 2, 29, 0, 0, 0], + [2004, 2, 29, 0, 0, 0], [2010, 10, 12, 14, 13, 12], [2020, 2, 29, 12, 59, 59], [2030, 7, 4, 17, 07, 06], ) { my($year, $mon, $mday, $hour, $min, $sec) = @$_; - $year -= 1900; - $mon--; - - # Test timelocal() - { - my $year_in = $year < 90 ? $year + 1900 : $year; - my $time = &timelocal($sec,$min,$hour,$mday,$mon,$year_in); - my($s,$m,$h,$D,$M,$Y) = localtime($time); - is $s, $sec, "timelocal second for @$_"; - is $m, $min, "timelocal minute for @$_"; - is $h, $hour, "timelocal hour for @$_"; - is $D, $mday, "timelocal day for @$_"; - is $M, $mon, "timelocal month for @$_"; - is $Y, $year, "timelocal year for @$_"; - } - - # Test timegm() - { - my $year_in = $year < 90 ? $year + 1900 : $year; - my $time = &timegm($sec,$min,$hour,$mday,$mon,$year_in); - my($s,$m,$h,$D,$M,$Y) = gmtime($time); - is $s, $sec, "timegm second for @$_"; - is $m, $min, "timegm minute for @$_"; - is $h, $hour, "timegm hour for @$_"; - is $D, $mday, "timegm day for @$_"; - is $M, $mon, "timegm month for @$_"; - is $Y, $year, "timegm year for @$_"; + SKIP: { + skip "$year is too early for this OS", 4 + if $year < $min_ok_year; + my @out = ($sec, $min, $hour, $mday, $mon-1, $year-1900); + foreach my $year_in ( + $year, + $year-$current_year >= -40 && + $year-$current_year <= 40 ? + $year % 100 : $year, + ) { + my @in = ($sec, $min, $hour, $mday, $mon-1, $year_in); + is_deeply [(localtime(&timelocal(@in)))[0..5]], \@out, + "localtime(timelocal(@{[join(q(, ), @in)]}))"; + is_deeply [(gmtime(&timegm(@in)))[0..5]], \@out, + "gmtime(timegm(@{[join(q(, ), @in)]}))"; + } } } @@ -64,20 +60,23 @@ foreach( [1995, 02, 10, 01, 01, 60], ) { my($year, $mon, $mday, $hour, $min, $sec) = @$_; - $year -= 1900; - $mon--; - eval { &timegm($sec,$min,$hour,$mday,$mon,$year) }; - like $@, qr/.*out of range.*/, 'invalid time caused an error'; + foreach my $year_in ($year, $year % 100) { + my @in = ($sec, $min, $hour, $mday, $mon-1, $year_in); + eval { &timelocal(@in) }; + like $@, qr/.*out of range.*/, 'invalid time caused an error'; + eval { &timegm(@in) }; + like $@, qr/.*out of range.*/, 'invalid time caused an error'; + } } -is &timelocal(0,0,1,1,0,90) - &timelocal(0,0,0,1,0,90), 3600, +is &timelocal(0,0,1,1,0,1990) - &timelocal(0,0,0,1,0,1990), 3600, 'one hour difference between two calls to timelocal'; -is &timelocal(1,2,3,1,0,100) - &timelocal(1,2,3,31,11,99), 24 * 3600, +is &timelocal(1,2,3,1,0,2000) - &timelocal(1,2,3,31,11,1999), 24 * 3600, 'one day difference between two calls to timelocal'; # Diff beween Jan 1, 1980 and Mar 1, 1980 = (31 + 29 = 60 days) -is &timegm(0,0,0, 1, 2, 80) - &timegm(0,0,0, 1, 0, 80), 60 * 24 * 3600, +is &timegm(0,0,0, 1, 2, 1980) - &timegm(0,0,0, 1, 0, 1980), 60 * 24 * 3600, '60 day difference between two calls to timegm'; # bugid #19393 @@ -86,25 +85,19 @@ is &timegm(0,0,0, 1, 2, 80) - &timegm(0,0,0, 1, 0, 80), 60 * 24 * 3600, # treated like 03:00:00 rather than 01:00:00 - negative zone offsets used # to do the latter { - my $hour = (localtime(&timelocal(0, 0, 2, 7, 3, 102)))[2]; + my $hour = (localtime(&timelocal(0, 0, 2, 7, 3, 2002)))[2]; # testers in US/Pacific should get 3, # other testers should get 2 ok $hour == 2 || $hour == 3, 'hour should be 2 or 3'; } +eval { &timelocal(0,0,0,29,1,1900) }; +like $@, qr/Day '29' out of range 1\.\.28/, 'does not accept leap day in 1900'; eval { &timegm(0,0,0,29,1,1900) }; like $@, qr/Day '29' out of range 1\.\.28/, 'does not accept leap day in 1900'; - -eval { &timegm(0,0,0,29,1,0) }; -is $@, '', 'no error with leap day of 2000 (year passed as 0)'; - -eval { &timegm(0,0,0,29,1,1904) }; -is $@, '', 'no error with leap day of 1904'; - -eval { &timegm(0,0,0,29,1,4) }; -is $@, '', 'no error with leap day of 2004 (year passed as 4)'; - -eval { &timegm(0,0,0,29,1,96) }; -is $@, '', 'no error with leap day of 1996 (year passed as 96)'; +eval { &timelocal(0,0,0,29,1,2100) }; +like $@, qr/Day '29' out of range 1\.\.28/, 'does not accept leap day in 2100'; +eval { &timegm(0,0,0,29,1,2100) }; +like $@, qr/Day '29' out of range 1\.\.28/, 'does not accept leap day in 2100'; 1; |