From 118d81daf2c83856401d6ee4a1b34562fac4ff6c Mon Sep 17 00:00:00 2001 From: DongHun Kwak Date: Wed, 28 Jun 2017 10:48:06 +0900 Subject: [PATCH] Imported Upstream version 5.25.2 Change-Id: I29931c16ca50b0a49c9068949ac5183851cc74bb Signed-off-by: DongHun Kwak --- AUTHORS | 1 + Configure | 20 +- Cross/config.sh-arm-linux | 42 +- Cross/config.sh-arm-linux-n770 | 40 +- INSTALL | 37 +- MANIFEST | 21 +- META.json | 4 +- META.yml | 2 +- Makefile.SH | 14 +- NetWare/Makefile | 4 +- NetWare/config.wc | 2 + NetWare/config_H.wc | 10 +- Porting/Maintainers.pl | 79 +- Porting/bench.pl | 149 +- Porting/bisect-runner.pl | 24 +- Porting/config.sh | 44 +- Porting/config_H | 18 +- Porting/epigraphs.pod | 19 + Porting/make_modlib_cpan.pl | 117 +- Porting/perldelta_template.pod | 7 +- Porting/pumpkin.pod | 4 - Porting/release_schedule.pod | 4 +- Porting/todo.pod | 115 +- README.aix | 4 +- README.haiku | 4 +- README.macosx | 8 +- README.os2 | 58 +- README.solaris | 8 +- README.synology | 21 +- README.tw | 4 - README.vms | 6 +- README.win32 | 6 +- charclass_invlists.h | 2 +- config_h.SH | 18 +- configpm | 11 +- configure.com | 2 + cop.h | 4 +- cpan/CPAN/lib/App/Cpan.pm | 224 +- cpan/CPAN/lib/CPAN.pm | 80 +- cpan/CPAN/lib/CPAN/Distribution.pm | 172 +- cpan/CPAN/lib/CPAN/FTP.pm | 14 +- cpan/CPAN/lib/CPAN/FirstTime.pm | 9 +- cpan/CPAN/lib/CPAN/HandleConfig.pm | 12 +- cpan/CPAN/lib/CPAN/Index.pm | 4 +- cpan/CPAN/lib/CPAN/Mirrors.pm | 6 +- cpan/CPAN/lib/CPAN/Plugin.pm | 6 +- cpan/CPAN/lib/CPAN/Shell.pm | 16 +- cpan/CPAN/scripts/cpan | 106 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command.pm | 3 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm | 20 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm | 9 +- .../ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm | 5 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm | 3 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm | 44 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm | 579 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm | 3 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm | 38 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm | 3 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm | 3 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm | 3 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm | 173 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm | 53 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm | 3 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm | 3 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm | 881 ++- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm | 403 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm | 3 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win32.pm | 212 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm | 52 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm | 3 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm | 419 +- .../lib/ExtUtils/MakeMaker/Config.pm | 3 +- .../lib/ExtUtils/MakeMaker/FAQ.pod | 239 +- .../lib/ExtUtils/MakeMaker/Locale.pm | 5 +- .../lib/ExtUtils/MakeMaker/Tutorial.pod | 3 +- .../lib/ExtUtils/MakeMaker/version.pm | 5 +- .../lib/ExtUtils/MakeMaker/version/regex.pm | 3 +- .../ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm | 21 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm | 5 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm | 3 +- cpan/ExtUtils-MakeMaker/t/01perl_bugs.t | 4 +- cpan/ExtUtils-MakeMaker/t/02-xsdynamic.t | 23 + cpan/ExtUtils-MakeMaker/t/03-xsstatic.t | 27 + cpan/ExtUtils-MakeMaker/t/FIRST_MAKEFILE.t | 14 +- cpan/ExtUtils-MakeMaker/t/INST.t | 16 +- cpan/ExtUtils-MakeMaker/t/INSTALL_BASE.t | 23 +- cpan/ExtUtils-MakeMaker/t/INST_PREFIX.t | 16 +- cpan/ExtUtils-MakeMaker/t/MM_Cygwin.t | 2 +- cpan/ExtUtils-MakeMaker/t/MM_NW5.t | 2 - cpan/ExtUtils-MakeMaker/t/MM_OS2.t | 2 +- cpan/ExtUtils-MakeMaker/t/MM_Unix.t | 8 +- cpan/ExtUtils-MakeMaker/t/MM_Win32.t | 23 +- cpan/ExtUtils-MakeMaker/t/MakeMaker_Parameters.t | 4 +- cpan/ExtUtils-MakeMaker/t/Mkbootstrap.t | 2 +- cpan/ExtUtils-MakeMaker/t/PL_FILES.t | 109 +- cpan/ExtUtils-MakeMaker/t/WriteEmptyMakefile.t | 1 + cpan/ExtUtils-MakeMaker/t/basic.t | 110 +- cpan/ExtUtils-MakeMaker/t/build_man.t | 37 +- cpan/ExtUtils-MakeMaker/t/cd.t | 1 + cpan/ExtUtils-MakeMaker/t/dir_target.t | 1 + cpan/ExtUtils-MakeMaker/t/echo.t | 8 +- cpan/ExtUtils-MakeMaker/t/fixin.t | 10 +- cpan/ExtUtils-MakeMaker/t/hints.t | 4 +- cpan/ExtUtils-MakeMaker/t/installed_file.t | 5 +- .../t/lib/MakeMaker/Test/Setup/BFD.pm | 16 +- .../t/lib/MakeMaker/Test/Setup/MPV.pm | 67 - .../t/lib/MakeMaker/Test/Setup/PL_FILES.pm | 119 - .../t/lib/MakeMaker/Test/Setup/Problem.pm | 62 - .../t/lib/MakeMaker/Test/Setup/Recurs.pm | 72 - .../t/lib/MakeMaker/Test/Setup/SAS.pm | 67 - .../t/lib/MakeMaker/Test/Setup/Unicode.pm | 90 - .../t/lib/MakeMaker/Test/Setup/XS.pm | 385 +- .../t/lib/MakeMaker/Test/Utils.pm | 114 +- cpan/ExtUtils-MakeMaker/t/meta_convert.t | 211 +- cpan/ExtUtils-MakeMaker/t/metafile_data.t | 721 +- cpan/ExtUtils-MakeMaker/t/min_perl_version.t | 53 +- cpan/ExtUtils-MakeMaker/t/parse_abstract.t | 21 +- cpan/ExtUtils-MakeMaker/t/parse_version.t | 29 + cpan/ExtUtils-MakeMaker/t/pm_to_blib.t | 12 +- cpan/ExtUtils-MakeMaker/t/postamble.t | 7 +- cpan/ExtUtils-MakeMaker/t/prereq.t | 78 +- cpan/ExtUtils-MakeMaker/t/prereq_print.t | 11 +- cpan/ExtUtils-MakeMaker/t/problems.t | 29 +- cpan/ExtUtils-MakeMaker/t/prompt.t | 21 +- cpan/ExtUtils-MakeMaker/t/recurs.t | 104 +- cpan/ExtUtils-MakeMaker/t/several_authors.t | 57 +- cpan/ExtUtils-MakeMaker/t/test_boilerplate.t | 6 +- cpan/ExtUtils-MakeMaker/t/unicode.t | 69 +- cpan/ExtUtils-MakeMaker/t/vstrings.t | 86 +- cpan/ExtUtils-MakeMaker/t/writemakefile_args.t | 8 +- cpan/ExtUtils-MakeMaker/t/xs.t | 53 - cpan/Getopt-Long/lib/Getopt/Long.pm | 12 +- cpan/HTTP-Tiny/corpus/get-02.txt | 4 + cpan/HTTP-Tiny/corpus/get-22.txt | 10 + cpan/HTTP-Tiny/lib/HTTP/Tiny.pm | 316 +- cpan/HTTP-Tiny/t/001_api.t | 1 + cpan/HTTP-Tiny/t/100_get.t | 3 + cpan/HTTP-Tiny/t/110_mirror.t | 5 + cpan/HTTP-Tiny/t/130_redirect.t | 12 +- cpan/HTTP-Tiny/t/Util.pm | 3 +- cpan/JSON-PP/bin/json_pp | 2 +- cpan/JSON-PP/lib/JSON/PP.pm | 86 +- cpan/JSON-PP/t/018_json_checker.t | 2 +- cpan/JSON-PP/t/021_evans_bugrep.t | 2 +- cpan/JSON-PP/t/108_decode.t | 2 +- cpan/Locale-Codes/lib/Locale/Codes.pm | 2 +- cpan/Locale-Codes/lib/Locale/Codes/Changes.pod | 19 +- cpan/Locale-Codes/lib/Locale/Codes/Constants.pm | 33 +- cpan/Locale-Codes/lib/Locale/Codes/Country.pm | 2 +- cpan/Locale-Codes/lib/Locale/Codes/Country.pod | 30 +- .../Locale-Codes/lib/Locale/Codes/Country_Codes.pm | 7057 +++++++++++++++++++- .../lib/Locale/Codes/Country_Retired.pm | 34 +- cpan/Locale-Codes/lib/Locale/Codes/Currency.pm | 2 +- .../lib/Locale/Codes/Currency_Codes.pm | 4 +- .../lib/Locale/Codes/Currency_Retired.pm | 4 +- cpan/Locale-Codes/lib/Locale/Codes/LangExt.pm | 2 +- .../Locale-Codes/lib/Locale/Codes/LangExt_Codes.pm | 4 +- .../lib/Locale/Codes/LangExt_Retired.pm | 4 +- cpan/Locale-Codes/lib/Locale/Codes/LangFam.pm | 2 +- .../Locale-Codes/lib/Locale/Codes/LangFam_Codes.pm | 4 +- .../lib/Locale/Codes/LangFam_Retired.pm | 2 +- cpan/Locale-Codes/lib/Locale/Codes/LangVar.pm | 2 +- .../Locale-Codes/lib/Locale/Codes/LangVar_Codes.pm | 4 +- .../lib/Locale/Codes/LangVar_Retired.pm | 4 +- cpan/Locale-Codes/lib/Locale/Codes/Language.pm | 2 +- .../lib/Locale/Codes/Language_Codes.pm | 4 +- .../lib/Locale/Codes/Language_Retired.pm | 4 +- cpan/Locale-Codes/lib/Locale/Codes/Script.pm | 2 +- cpan/Locale-Codes/lib/Locale/Codes/Script_Codes.pm | 4 +- .../lib/Locale/Codes/Script_Retired.pm | 4 +- cpan/Locale-Codes/lib/Locale/Country.pm | 2 +- cpan/Locale-Codes/lib/Locale/Country.pod | 30 +- cpan/Locale-Codes/lib/Locale/Currency.pm | 2 +- cpan/Locale-Codes/lib/Locale/Language.pm | 2 +- cpan/Locale-Codes/lib/Locale/Script.pm | 2 +- cpan/Pod-Checker/lib/Pod/Checker.pm | 2420 +++---- cpan/Pod-Checker/scripts/podchecker.PL | 371 +- cpan/Pod-Checker/t/pod/contains_bad_pod.xr | 10 +- cpan/Pod-Checker/t/pod/podchkenc.t | 58 +- cpan/Pod-Checker/t/pod/podchkenc.xr | 2 +- cpan/Pod-Checker/t/pod/podchklink.t | 275 + cpan/Pod-Checker/t/pod/poderrs.t | 565 +- cpan/Pod-Checker/t/pod/poderrs.xr | 131 +- cpan/Pod-Checker/t/pod/selfcheck.t | 90 +- cpan/Pod-Checker/t/pod/testcmp.pl | 188 +- cpan/Pod-Checker/t/pod/testpchk.pl | 261 +- cpan/Pod-Usage/lib/Pod/Usage.pm | 2 +- cpan/Pod-Usage/t/inc/Pod/InputObjects.pm | 942 +++ cpan/Pod-Usage/t/inc/Pod/Parser.pm | 1836 +++++ cpan/Pod-Usage/t/inc/Pod/PlainText.pm | 744 +++ cpan/Pod-Usage/t/inc/Pod/Select.pm | 748 +++ cpan/Pod-Usage/t/pod/pod2usage2.t | 12 +- cpan/Pod-Usage/t/pod/testp2pt.pl | 8 +- cpan/Test-Simple/lib/Test/Builder.pm | 63 +- cpan/Test-Simple/lib/Test/Builder/Formatter.pm | 4 +- cpan/Test-Simple/lib/Test/Builder/Module.pm | 7 +- cpan/Test-Simple/lib/Test/Builder/Tester.pm | 4 +- cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm | 2 +- cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm | 4 +- cpan/Test-Simple/lib/Test/FAQ.pod | 4 +- cpan/Test-Simple/lib/Test/More.pm | 26 +- cpan/Test-Simple/lib/Test/Simple.pm | 4 +- cpan/Test-Simple/lib/Test/Tester.pm | 14 +- cpan/Test-Simple/lib/Test/Tester/Capture.pm | 2 +- cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm | 2 +- cpan/Test-Simple/lib/Test/Tester/Delegate.pm | 2 +- cpan/Test-Simple/lib/Test/use/ok.pm | 2 +- cpan/Test-Simple/lib/Test2.pm | 12 +- cpan/Test-Simple/lib/Test2/API.pm | 60 +- cpan/Test-Simple/lib/Test2/API/Breakage.pm | 6 +- cpan/Test-Simple/lib/Test2/API/Context.pm | 10 +- cpan/Test-Simple/lib/Test2/API/Instance.pm | 57 +- cpan/Test-Simple/lib/Test2/API/Stack.pm | 10 +- cpan/Test-Simple/lib/Test2/Event.pm | 8 +- cpan/Test-Simple/lib/Test2/Event/Bail.pm | 4 +- cpan/Test-Simple/lib/Test2/Event/Diag.pm | 4 +- cpan/Test-Simple/lib/Test2/Event/Exception.pm | 4 +- cpan/Test-Simple/lib/Test2/Event/Generic.pm | 263 + cpan/Test-Simple/lib/Test2/Event/Note.pm | 4 +- cpan/Test-Simple/lib/Test2/Event/Ok.pm | 4 +- cpan/Test-Simple/lib/Test2/Event/Plan.pm | 4 +- cpan/Test-Simple/lib/Test2/Event/Skip.pm | 4 +- cpan/Test-Simple/lib/Test2/Event/Subtest.pm | 4 +- cpan/Test-Simple/lib/Test2/Event/Waiting.pm | 4 +- cpan/Test-Simple/lib/Test2/Formatter.pm | 6 +- cpan/Test-Simple/lib/Test2/Formatter/TAP.pm | 8 +- cpan/Test-Simple/lib/Test2/Hub.pm | 10 +- cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm | 4 +- .../lib/Test2/Hub/Interceptor/Terminator.pm | 2 +- cpan/Test-Simple/lib/Test2/Hub/Subtest.pm | 4 +- cpan/Test-Simple/lib/Test2/IPC.pm | 8 +- cpan/Test-Simple/lib/Test2/IPC/Driver.pm | 6 +- cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm | 35 +- cpan/Test-Simple/lib/Test2/Transition.pod | 10 +- cpan/Test-Simple/lib/Test2/Util.pm | 46 +- cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm | 10 +- cpan/Test-Simple/lib/Test2/Util/HashBase.pm | 63 +- cpan/Test-Simple/lib/Test2/Util/Trace.pm | 4 +- cpan/Test-Simple/lib/ok.pm | 2 +- cpan/Test-Simple/t/00compile.t | 43 - cpan/Test-Simple/t/Legacy/Regression/637.t | 16 +- cpan/Test-Simple/t/Legacy/Tester/tbt_06errormess.t | 2 +- cpan/Test-Simple/t/Legacy/Tester/tbt_07args.t | 2 +- cpan/Test-Simple/t/Test2/acceptance/try_it_todo.t | 1 - cpan/Test-Simple/t/Test2/modules/API/Instance.t | 14 +- cpan/Test-Simple/t/Test2/modules/Event/Generic.t | 129 + .../Test-Simple/t/Test2/modules/IPC/Driver/Files.t | 24 +- cpan/Test-Simple/t/Test2/modules/Util.t | 5 + cpan/Test-Simple/t/regression/662-tbt-no-plan.t | 25 + cpan/Test-Simple/t/tools.t | 2 +- dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm | 2 +- dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pod | 2 +- .../lib/ExtUtils/ParseXS/Constants.pm | 2 +- .../lib/ExtUtils/ParseXS/CountLines.pm | 2 +- dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm | 2 +- .../lib/ExtUtils/ParseXS/Utilities.pm | 2 +- dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm | 12 +- dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm | 2 +- .../lib/ExtUtils/Typemaps/InputMap.pm | 2 +- .../lib/ExtUtils/Typemaps/OutputMap.pm | 2 +- .../ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm | 2 +- dist/Module-CoreList/Changes | 3 + dist/Module-CoreList/lib/Module/CoreList.pm | 178 +- .../lib/Module/CoreList/TieHashDelta.pm | 2 +- dist/Module-CoreList/lib/Module/CoreList/Utils.pm | 9 +- dist/PathTools/Changes | 3 + dist/PathTools/Cwd.pm | 2 +- dist/PathTools/lib/File/Spec.pm | 2 +- dist/PathTools/lib/File/Spec/Cygwin.pm | 2 +- dist/PathTools/lib/File/Spec/Epoc.pm | 2 +- dist/PathTools/lib/File/Spec/Functions.pm | 2 +- dist/PathTools/lib/File/Spec/Mac.pm | 6 +- dist/PathTools/lib/File/Spec/OS2.pm | 2 +- dist/PathTools/lib/File/Spec/Unix.pm | 2 +- dist/PathTools/lib/File/Spec/VMS.pm | 2 +- dist/PathTools/lib/File/Spec/Win32.pm | 2 +- dist/Thread-Queue/lib/Thread/Queue.pm | 11 +- dist/Thread-Queue/t/07_lock.t | 7 +- dist/Time-HiRes/HiRes.pm | 2 +- dist/Time-HiRes/HiRes.xs | 2 +- dist/constant/t/constant.t | 12 +- dist/threads/lib/threads.pm | 16 +- dist/threads/t/exit.t | 10 +- dist/threads/t/thread.t | 2 +- doop.c | 15 +- embed.fnc | 8 +- embed.h | 7 + embedvar.h | 4 + ext/Devel-Peek/Peek.pm | 8 +- ext/DynaLoader/DynaLoader_pm.PL | 2 +- ext/DynaLoader/dl_dlopen.xs | 3 +- ext/ExtUtils-Miniperl/lib/ExtUtils/Miniperl.pm | 30 +- ext/File-Glob/Glob.pm | 19 +- ext/Opcode/Opcode.pm | 4 +- ext/POSIX/POSIX.xs | 5 + ext/POSIX/lib/POSIX.pm | 2 +- ext/POSIX/t/sigaction.t | 4 +- ext/Pod-Functions/Functions_pm.PL | 4 +- ext/VMS-DCLsym/DCLsym.pm | 6 +- ext/XS-APItest/APItest.pm | 2 +- ext/XS-APItest/APItest.xs | 3 +- ext/XS-APItest/t/lexsub.t | 13 +- feature.h | 12 - gv.c | 12 +- handy.h | 12 +- hints/catamount.sh | 4 +- hints/gnu.sh | 33 +- intrpvar.h | 5 + lib/B/Deparse.t | 10 +- lib/B/Op_private.pm | 230 +- lib/CORE.pod | 6 +- lib/File/Copy.pm | 7 +- lib/FileHandle.pm | 8 +- lib/Unicode/UCD.pm | 5 +- lib/Unicode/UCD.t | 13 +- lib/diagnostics.pm | 21 +- lib/diagnostics.t | 25 +- lib/feature.pm | 33 +- lib/locale.t | 81 +- locale.c | 790 ++- make_ext.pl | 45 +- mathoms.c | 58 +- metaconfig.h | 2 + miniperlmain.c | 13 +- myconfig.SH | 68 +- op.c | 64 +- opcode.h | 73 +- opnames.h | 29 +- patchlevel.h | 4 +- perl.c | 7 +- perl.h | 10 +- perlio.c | 114 +- perly.act | 6 +- perly.h | 2 +- perly.tab | 2 +- perly.y | 4 +- plan9/config.plan9 | 10 +- plan9/config_sh.sample | 40 +- pod/.gitignore | 2 +- pod/perl.pod | 1 + pod/perl5004delta.pod | 2 +- pod/perl5005delta.pod | 4 +- pod/perl5101delta.pod | 2 +- pod/perl5120delta.pod | 4 +- pod/perl5251delta.pod | 421 ++ pod/perl561delta.pod | 8 +- pod/perl56delta.pod | 8 +- pod/perl581delta.pod | 2 +- pod/perl58delta.pod | 2 +- pod/perlapio.pod | 18 +- pod/perlcommunity.pod | 3 - pod/perldata.pod | 2 +- pod/perldebug.pod | 4 +- pod/perldelta.pod | 390 +- pod/perldiag.pod | 198 +- pod/perlebcdic.pod | 2 +- pod/perlembed.pod | 4 +- pod/perlexperiment.pod | 18 +- pod/perlform.pod | 2 +- pod/perlguts.pod | 20 +- pod/perlhacktips.pod | 2 +- pod/perlhist.pod | 1 + pod/perllocale.pod | 106 +- pod/perlmodinstall.pod | 6 +- pod/perlmodlib.PL | 782 +-- pod/perlnewmod.pod | 15 +- pod/perlnumber.pod | 2 +- pod/perlobj.pod | 2 +- pod/perlootut.pod | 2 +- pod/perlop.pod | 22 +- pod/perlpacktut.pod | 4 +- pod/perlport.pod | 10 +- pod/perlre.pod | 14 +- pod/perlrecharclass.pod | 2 +- pod/perlreguts.pod | 2 +- pod/perlretut.pod | 2 +- pod/perlrun.pod | 88 +- pod/perlsub.pod | 29 +- pod/perlsyn.pod | 6 +- pp.c | 79 +- pp_proto.h | 1 + pp_sys.c | 4 +- proto.h | 13 +- regcharclass.h | 2 +- regcomp.c | 294 +- regen/feature.pl | 36 +- regen/op_private | 9 +- regen/opcodes | 11 +- regexec.c | 2 +- scope.c | 4 + sv.c | 4 +- symbian/config.sh | 2 + t/comp/parser.t | 28 +- t/harness | 2 +- t/io/socket.t | 22 + t/lib/croak/op | 72 + t/lib/croak/toke | 33 +- t/lib/warnings/op | 26 +- t/lib/warnings/toke | 5 +- t/op/coreamp.t | 160 + t/op/kvhslice.t | 8 +- t/op/lex.t | 9 +- t/op/lex_assign.t | 16 +- t/op/lexsub.t | 16 +- t/op/smartkve.t | 5 +- t/op/stat.t | 14 +- t/op/sub_lval.t | 9 +- t/op/substr.t | 10 +- t/op/svleak.t | 12 +- t/op/vec.t | 10 +- t/porting/customized.dat | 38 +- t/porting/dual-life.t | 6 +- t/porting/known_pod_issues.dat | 7 +- t/porting/libperl.t | 26 +- t/porting/podcheck.t | 684 +- t/re/re_tests | 2 + t/re/reg_mesg.t | 19 +- t/run/switchDx.t | 50 + toke.c | 76 +- uconfig.h | 22 +- uconfig.sh | 2 + uconfig64.sh | 2 + vms/descrip_mms.template | 2 +- vms/myconfig.com | 2 +- win32/GNUmakefile | 6 +- win32/Makefile | 6 +- win32/config.ce | 2 + win32/config.gc | 2 + win32/config.vc | 2 + win32/makefile.mk | 6 +- win32/pod.mak | 4 + win32/vdir.h | 6 +- 432 files changed, 23424 insertions(+), 8276 deletions(-) create mode 100644 cpan/ExtUtils-MakeMaker/t/02-xsdynamic.t create mode 100644 cpan/ExtUtils-MakeMaker/t/03-xsstatic.t delete mode 100644 cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/MPV.pm delete mode 100644 cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/PL_FILES.pm delete mode 100644 cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/Problem.pm delete mode 100644 cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/Recurs.pm delete mode 100644 cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/SAS.pm delete mode 100644 cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/Unicode.pm delete mode 100644 cpan/ExtUtils-MakeMaker/t/xs.t create mode 100644 cpan/HTTP-Tiny/corpus/get-22.txt create mode 100644 cpan/Pod-Checker/t/pod/podchklink.t create mode 100644 cpan/Pod-Usage/t/inc/Pod/InputObjects.pm create mode 100644 cpan/Pod-Usage/t/inc/Pod/Parser.pm create mode 100644 cpan/Pod-Usage/t/inc/Pod/PlainText.pm create mode 100644 cpan/Pod-Usage/t/inc/Pod/Select.pm create mode 100644 cpan/Test-Simple/lib/Test2/Event/Generic.pm delete mode 100644 cpan/Test-Simple/t/00compile.t create mode 100644 cpan/Test-Simple/t/Test2/modules/Event/Generic.t create mode 100644 cpan/Test-Simple/t/regression/662-tbt-no-plan.t create mode 100644 pod/perl5251delta.pod create mode 100644 t/run/switchDx.t diff --git a/AUTHORS b/AUTHORS index a055b67..dfda0e1 100644 --- a/AUTHORS +++ b/AUTHORS @@ -872,6 +872,7 @@ Mike W Ellwood Mikhail Zabaluev Milosz Tanski Milton L. Hankins +Misty De Meo Moritz Lenz Moshe Kaminsky Mottaqui Karim diff --git a/Configure b/Configure index 1cd411a..2b2cd07 100755 --- a/Configure +++ b/Configure @@ -681,6 +681,7 @@ d_nearbyint='' d_duplocale='' d_freelocale='' d_newlocale='' +d_querylocale='' d_uselocale='' i_xlocale='' d_nextafter='' @@ -861,6 +862,7 @@ d_strerrm='' d_strerror='' d_sysernlst='' d_syserrlst='' +d_strerror_l='' d_strerror_r='' strerror_r_proto='' d_strftime='' @@ -14149,6 +14151,10 @@ eval $inlibc set duplocale d_duplocale eval $inlibc +: see if querylocale exists +set querylocale d_querylocale +eval $inlibc + : see if frexpl exists set frexpl d_frexpl eval $inlibc @@ -19275,6 +19281,10 @@ if test "X$d_strerror" = X -o "X$d_syserrlst" = X; then fi fi +: see if strerror_l exists +set strerror_l d_strerror_l +eval $inlibc + : see if strerror_r exists set strerror_r d_strerror_r eval $inlibc @@ -24518,6 +24528,7 @@ d_pwpasswd='$d_pwpasswd' d_pwquota='$d_pwquota' d_qgcvt='$d_qgcvt' d_quad='$d_quad' +d_querylocale='$d_querylocale' d_random_r='$d_random_r' d_re_comp='$d_re_comp' d_readdir64_r='$d_readdir64_r' @@ -24637,6 +24648,7 @@ d_strcoll='$d_strcoll' d_strctcpy='$d_strctcpy' d_strerrm='$d_strerrm' d_strerror='$d_strerror' +d_strerror_l='$d_strerror_l' d_strerror_r='$d_strerror_r' d_strftime='$d_strftime' d_strlcat='$d_strlcat' @@ -25316,8 +25328,7 @@ Id='$Id' : Finish up by extracting the .SH files case "$alldone" in exit) - $rm -rf UU - echo "Extraction done." + echo "Stopping at your request, leaving temporary files around." exit 0 ;; cont) @@ -25392,11 +25403,10 @@ the policy defaults. EOM fi -if $test -f config.msg; then +if $test -f UU/config.msg; then echo "Hmm. I also noted the following information while running:" echo " " - $cat config.msg >&4 - $rm -f config.msg + $cat UU/config.msg >&4 fi $rm -f kit*isdone ark*isdone $rm -rf UU diff --git a/Cross/config.sh-arm-linux b/Cross/config.sh-arm-linux index e82ac96..ba0eabf 100644 --- a/Cross/config.sh-arm-linux +++ b/Cross/config.sh-arm-linux @@ -32,12 +32,12 @@ alignbytes='4' ansi2knr='' aphostname='/bin/hostname' api_revision='5' -api_subversion='1' +api_subversion='2' api_version='25' -api_versionstring='5.25.1' +api_versionstring='5.25.2' ar='ar' -archlib='/usr/lib/perl5/5.25.1/armv4l-linux' -archlibexp='/usr/lib/perl5/5.25.1/armv4l-linux' +archlib='/usr/lib/perl5/5.25.2/armv4l-linux' +archlibexp='/usr/lib/perl5/5.25.2/armv4l-linux' archname64='' archname='armv4l-linux' archobjs='' @@ -56,7 +56,7 @@ castflags='0' cat='cat' cc='cc' cccdlflags='-fpic' -ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.25.1/armv4l-linux/CORE' +ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.25.2/armv4l-linux/CORE' ccflags='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64' ccflags_uselargefiles='-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64' ccname='arm-linux-gcc' @@ -432,6 +432,7 @@ d_pwpasswd='define' d_pwquota='undef' d_qgcvt='define' d_quad='define' +d_querylocale='undef' d_random_r='undef' d_readdir64_r='undef' d_readdir='define' @@ -548,6 +549,7 @@ d_strcoll='define' d_strctcpy='define' d_strerrm='strerror(e)' d_strerror='define' +d_strerror_l='undef' d_strerror_r='undef' d_strftime='define' d_strlcat='undef' @@ -808,7 +810,7 @@ inc_version_list=' ' inc_version_list_init='0' incpath='' inews='' -installarchlib='./install_me_here/usr/lib/perl5/5.25.1/armv4l-linux' +installarchlib='./install_me_here/usr/lib/perl5/5.25.2/armv4l-linux' installbin='./install_me_here/usr/bin' installhtml1dir='' installhtml3dir='' @@ -816,13 +818,13 @@ installman1dir='./install_me_here/usr/share/man/man1' installman3dir='./install_me_here/usr/share/man/man3' installprefix='./install_me_here/usr' installprefixexp='./install_me_here/usr' -installprivlib='./install_me_here/usr/lib/perl5/5.25.1' +installprivlib='./install_me_here/usr/lib/perl5/5.25.2' installscript='./install_me_here/usr/bin' -installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.25.1/armv4l-linux' +installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.25.2/armv4l-linux' installsitebin='./install_me_here/usr/bin' installsitehtml1dir='' installsitehtml3dir='' -installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.25.1' +installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.25.2' installsiteman1dir='./install_me_here/usr/share/man/man1' installsiteman3dir='./install_me_here/usr/share/man/man3' installsitescript='./install_me_here/usr/bin' @@ -956,8 +958,8 @@ pmake='' pr='' prefix='/usr' prefixexp='/usr' -privlib='/usr/lib/perl5/5.25.1' -privlibexp='/usr/lib/perl5/5.25.1' +privlib='/usr/lib/perl5/5.25.2' +privlibexp='/usr/lib/perl5/5.25.2' procselfexe='"/proc/self/exe"' prototype='define' ptrsize='4' @@ -1022,17 +1024,17 @@ 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 sig_num_init='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, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 6, 17, 29, 31, 0' sig_size='68' signal_t='void' -sitearch='/usr/lib/perl5/site_perl/5.25.1/armv4l-linux' -sitearchexp='/usr/lib/perl5/site_perl/5.25.1/armv4l-linux' +sitearch='/usr/lib/perl5/site_perl/5.25.2/armv4l-linux' +sitearchexp='/usr/lib/perl5/site_perl/5.25.2/armv4l-linux' sitebin='/usr/bin' sitebinexp='/usr/bin' sitehtml1dir='' sitehtml1direxp='' sitehtml3dir='' sitehtml3direxp='' -sitelib='/usr/lib/perl5/site_perl/5.25.1' +sitelib='/usr/lib/perl5/site_perl/5.25.2' sitelib_stem='/usr/lib/perl5/site_perl' -sitelibexp='/usr/lib/perl5/site_perl/5.25.1' +sitelibexp='/usr/lib/perl5/site_perl/5.25.2' siteman1dir='/usr/share/man/man1' siteman1direxp='/usr/share/man/man1' siteman3dir='/usr/share/man/man3' @@ -1071,7 +1073,7 @@ stdio_stream_array='' strerror_r_proto='0' strings='/usr/include/string.h' submit='' -subversion='1' +subversion='2' sysman='/usr/share/man/man1' tail='' tar='' @@ -1163,8 +1165,8 @@ vendorprefix='' vendorprefixexp='' vendorscript='' vendorscriptexp='' -version='5.25.1' -version_patchlevel_string='version 25 subversion 1' +version='5.25.2' +version_patchlevel_string='version 25 subversion 2' versiononly='undef' vi='' xlibpth='/usr/lib/386 /lib/386' @@ -1178,9 +1180,9 @@ config_args='' config_argc=0 PERL_REVISION=5 PERL_VERSION=25 -PERL_SUBVERSION=1 +PERL_SUBVERSION=2 PERL_API_REVISION=5 PERL_API_VERSION=25 -PERL_API_SUBVERSION=1 +PERL_API_SUBVERSION=2 PERL_PATCHLEVEL= PERL_CONFIG_SH=true diff --git a/Cross/config.sh-arm-linux-n770 b/Cross/config.sh-arm-linux-n770 index 5db904e..81dc543 100644 --- a/Cross/config.sh-arm-linux-n770 +++ b/Cross/config.sh-arm-linux-n770 @@ -32,12 +32,12 @@ alignbytes='4' ansi2knr='' aphostname='/bin/hostname' api_revision='5' -api_subversion='1' +api_subversion='2' api_version='25' -api_versionstring='5.25.1' +api_versionstring='5.25.2' ar='ar' -archlib='/usr/lib/perl5/5.25.1/armv4l-linux' -archlibexp='/usr/lib/perl5/5.25.1/armv4l-linux' +archlib='/usr/lib/perl5/5.25.2/armv4l-linux' +archlibexp='/usr/lib/perl5/5.25.2/armv4l-linux' archname64='' archname='armv4l-linux' archobjs='' @@ -55,7 +55,7 @@ castflags='0' cat='cat' cc='arm-none-linux-gnueabi-gcc' cccdlflags='-fpic' -ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.25.1/armv4l-linux/CORE' +ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.25.2/armv4l-linux/CORE' ccflags='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64' ccflags_uselargefiles='-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64' ccname='arm-linux-gcc' @@ -699,7 +699,7 @@ inc_version_list=' ' inc_version_list_init='0' incpath='' inews='' -installarchlib='./install_me_here/usr/lib/perl5/5.25.1/armv4l-linux' +installarchlib='./install_me_here/usr/lib/perl5/5.25.2/armv4l-linux' installbin='./install_me_here/usr/bin' installhtml1dir='' installhtml3dir='' @@ -707,13 +707,13 @@ installman1dir='./install_me_here/usr/share/man/man1' installman3dir='./install_me_here/usr/share/man/man3' installprefix='./install_me_here/usr' installprefixexp='./install_me_here/usr' -installprivlib='./install_me_here/usr/lib/perl5/5.25.1' +installprivlib='./install_me_here/usr/lib/perl5/5.25.2' installscript='./install_me_here/usr/bin' -installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.25.1/armv4l-linux' +installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.25.2/armv4l-linux' installsitebin='./install_me_here/usr/bin' installsitehtml1dir='' installsitehtml3dir='' -installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.25.1' +installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.25.2' installsiteman1dir='./install_me_here/usr/share/man/man1' installsiteman3dir='./install_me_here/usr/share/man/man3' installsitescript='./install_me_here/usr/bin' @@ -841,8 +841,8 @@ pmake='' pr='' prefix='/usr' prefixexp='/usr' -privlib='/usr/lib/perl5/5.25.1' -privlibexp='/usr/lib/perl5/5.25.1' +privlib='/usr/lib/perl5/5.25.2' +privlibexp='/usr/lib/perl5/5.25.2' procselfexe='"/proc/self/exe"' prototype='define' ptrsize='4' @@ -903,17 +903,17 @@ 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 sig_num_init='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, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 6, 17, 29, 31, 0' sig_size='68' signal_t='void' -sitearch='/usr/lib/perl5/site_perl/5.25.1/armv4l-linux' -sitearchexp='/usr/lib/perl5/site_perl/5.25.1/armv4l-linux' +sitearch='/usr/lib/perl5/site_perl/5.25.2/armv4l-linux' +sitearchexp='/usr/lib/perl5/site_perl/5.25.2/armv4l-linux' sitebin='/usr/bin' sitebinexp='/usr/bin' sitehtml1dir='' sitehtml1direxp='' sitehtml3dir='' sitehtml3direxp='' -sitelib='/usr/lib/perl5/site_perl/5.25.1' +sitelib='/usr/lib/perl5/site_perl/5.25.2' sitelib_stem='/usr/lib/perl5/site_perl' -sitelibexp='/usr/lib/perl5/site_perl/5.25.1' +sitelibexp='/usr/lib/perl5/site_perl/5.25.2' siteman1dir='/usr/share/man/man1' siteman1direxp='/usr/share/man/man1' siteman3dir='/usr/share/man/man3' @@ -950,7 +950,7 @@ stdio_stream_array='' strerror_r_proto='0' strings='/usr/include/string.h' submit='' -subversion='1' +subversion='2' sysman='/usr/share/man/man1' tail='' tar='' @@ -1035,8 +1035,8 @@ vendorprefix='' vendorprefixexp='' vendorscript='' vendorscriptexp='' -version='5.25.1' -version_patchlevel_string='version 25 subversion 1' +version='5.25.2' +version_patchlevel_string='version 25 subversion 2' versiononly='undef' vi='' xlibpth='/usr/lib/386 /lib/386' @@ -1050,9 +1050,9 @@ config_args='' config_argc=0 PERL_REVISION=5 PERL_VERSION=25 -PERL_SUBVERSION=1 +PERL_SUBVERSION=2 PERL_API_REVISION=5 PERL_API_VERSION=25 -PERL_API_SUBVERSION=1 +PERL_API_SUBVERSION=2 PERL_PATCHLEVEL= PERL_CONFIG_SH=true diff --git a/INSTALL b/INSTALL index 7af4f99..6d594f3 100644 --- a/INSTALL +++ b/INSTALL @@ -581,7 +581,7 @@ The directories set up by Configure fall into three broad categories. =item Directories for the perl distribution -By default, Configure will use the following directories for 5.25.1. +By default, Configure will use the following directories for 5.25.2. $version is the full perl version number, including subversion, e.g. 5.12.3, and $archname is a string like sun4-sunos, determined by Configure. The full definitions of all Configure @@ -2389,10 +2389,9 @@ to report problems, as it automatically includes summary configuration information about your perl, which may help us track down problems far more quickly. But first you should read the advice in this file, carefully re-read the error message and check the relevant manual pages -on your system, as these may help you find an immediate solution. If -you are not sure whether what you are seeing is a bug, you can send a -message describing the problem to the comp.lang.perl.misc newsgroup to -get advice. +on your system, as these may help you find an immediate solution. +Once you've exhausted the documentation, please report bugs to us using +the 'perlbug' tool. The perlbug tool is installed along with perl, so after you have completed C it should be possible to run it with plain @@ -2437,7 +2436,7 @@ http://www.chiark.greenend.org.uk/~sgtatham/bugs.html =head1 Coexistence with earlier versions of perl 5 -Perl 5.25.1 is not binary compatible with earlier versions of Perl. +Perl 5.25.2 is not binary compatible with earlier versions of Perl. In other words, you will have to recompile your XS modules. In general, you can usually safely upgrade from one version of Perl @@ -2512,9 +2511,9 @@ won't interfere with another version. (The defaults guarantee this for libraries after 5.6.0, but not for executables. TODO?) One convenient way to do this is by using a separate prefix for each version, such as - sh Configure -Dprefix=/opt/perl5.25.1 + sh Configure -Dprefix=/opt/perl5.25.2 -and adding /opt/perl5.25.1/bin to the shell PATH variable. Such users +and adding /opt/perl5.25.2/bin to the shell PATH variable. Such users may also wish to add a symbolic link /usr/local/bin/perl so that scripts can still start with #!/usr/local/bin/perl. @@ -2527,13 +2526,13 @@ seriously consider using a separate directory, since development subversions may not have all the compatibility wrinkles ironed out yet. -=head2 Upgrading from v5.22 or earlier +=head2 Upgrading from 5.25.1 or earlier -B Perl modules having binary parts (meaning that a C compiler is used) will have to be recompiled to be -used with 5.25.1. If you find you do need to rebuild an extension with -5.25.1, you may safely do so without disturbing the older +used with 5.25.2. If you find you do need to rebuild an extension with +5.25.2, you may safely do so without disturbing the older installations. (See L<"Coexistence with earlier versions of perl 5"> above.) @@ -2566,15 +2565,15 @@ Firstly, the bare minimum to run this script print("$f\n"); } -in Linux with perl-5.25.1 is as follows (under $Config{prefix}): +in Linux with perl-5.25.2 is as follows (under $Config{prefix}): ./bin/perl - ./lib/perl5/5.25.1/strict.pm - ./lib/perl5/5.25.1/warnings.pm - ./lib/perl5/5.25.1/i686-linux/File/Glob.pm - ./lib/perl5/5.25.1/feature.pm - ./lib/perl5/5.25.1/XSLoader.pm - ./lib/perl5/5.25.1/i686-linux/auto/File/Glob/Glob.so + ./lib/perl5/5.25.2/strict.pm + ./lib/perl5/5.25.2/warnings.pm + ./lib/perl5/5.25.2/i686-linux/File/Glob.pm + ./lib/perl5/5.25.2/feature.pm + ./lib/perl5/5.25.2/XSLoader.pm + ./lib/perl5/5.25.2/i686-linux/auto/File/Glob/Glob.so Secondly, for perl-5.10.1, the Debian perl-base package contains 591 files, (of which 510 are for lib/unicore) totaling about 3.5MB in its diff --git a/MANIFEST b/MANIFEST index eaeb89c..c1638fc 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1089,6 +1089,8 @@ cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm MakeMaker user override class cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm Fixes up @INC to use just-built extension cpan/ExtUtils-MakeMaker/t/00compile.t See if MakeMaker modules compile cpan/ExtUtils-MakeMaker/t/01perl_bugs.t +cpan/ExtUtils-MakeMaker/t/02-xsdynamic.t +cpan/ExtUtils-MakeMaker/t/03-xsstatic.t cpan/ExtUtils-MakeMaker/t/arch_check.t Test MakeMaker's arch_check() cpan/ExtUtils-MakeMaker/t/backwards.t Check MakeMaker's backwards compatibility cpan/ExtUtils-MakeMaker/t/basic.t See if MakeMaker can build a module @@ -1111,12 +1113,6 @@ cpan/ExtUtils-MakeMaker/t/is_of_type.t Test for ExtUtils::MakeMaker cpan/ExtUtils-MakeMaker/t/Liblist.t See if ExtUtils::Liblist works cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/NoXS.pm MakeMaker test utilities cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/BFD.pm MakeMaker test utilities -cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/MPV.pm MakeMaker test utilities -cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/PL_FILES.pm MakeMaker test utilities -cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/Problem.pm MakeMaker test utilities -cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/Recurs.pm MakeMaker test utilities -cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/SAS.pm MakeMaker test utilities -cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/Unicode.pm cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/XS.pm MakeMaker test utilities cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Utils.pm MakeMaker test utilities cpan/ExtUtils-MakeMaker/t/lib/TieIn.pm Testing library for dummy input handles @@ -1167,7 +1163,6 @@ cpan/ExtUtils-MakeMaker/t/VERSION_FROM.t See if MakeMaker's VERSION_FROM works cpan/ExtUtils-MakeMaker/t/vstrings.t cpan/ExtUtils-MakeMaker/t/WriteEmptyMakefile.t See if WriteEmptyMakefile works cpan/ExtUtils-MakeMaker/t/writemakefile_args.t See if WriteMakefile works -cpan/ExtUtils-MakeMaker/t/xs.t Part of MakeMaker's test suite cpan/ExtUtils-Manifest/lib/ExtUtils/Manifest.pm Utilities to write MANIFEST files cpan/ExtUtils-Manifest/lib/ExtUtils/MANIFEST.SKIP The default MANIFEST.SKIP cpan/ExtUtils-Manifest/t/Manifest.t See if ExtUtils::Manifest works @@ -1243,6 +1238,7 @@ cpan/HTTP-Tiny/corpus/get-18.txt cpan/HTTP-Tiny/corpus/get-19.txt cpan/HTTP-Tiny/corpus/get-20.txt cpan/HTTP-Tiny/corpus/get-21.txt +cpan/HTTP-Tiny/corpus/get-22.txt cpan/HTTP-Tiny/corpus/head-01.txt cpan/HTTP-Tiny/corpus/keepalive-01.txt cpan/HTTP-Tiny/corpus/keepalive-02.txt @@ -1850,6 +1846,7 @@ cpan/Pod-Checker/t/pod/contains_bad_pod.xr cpan/Pod-Checker/t/pod/empty.xr cpan/Pod-Checker/t/pod/podchkenc.t cpan/Pod-Checker/t/pod/podchkenc.xr +cpan/Pod-Checker/t/pod/podchklink.t cpan/Pod-Checker/t/pod/poderrs.t cpan/Pod-Checker/t/pod/poderrs.xr cpan/Pod-Checker/t/pod/selfcheck.t @@ -2175,6 +2172,10 @@ cpan/Pod-Simple/t/xhtml-bkb.t cpan/Pod-Simple/t/x_nixer.t Pod::Simple test file cpan/Pod-Usage/lib/Pod/Usage.pm cpan/Pod-Usage/scripts/pod2usage.PL +cpan/Pod-Usage/t/inc/Pod/InputObjects.pm +cpan/Pod-Usage/t/inc/Pod/Parser.pm +cpan/Pod-Usage/t/inc/Pod/PlainText.pm +cpan/Pod-Usage/t/inc/Pod/Select.pm cpan/Pod-Usage/t/pod/headwithmarkup.pl cpan/Pod-Usage/t/pod/headwithmarkup.t cpan/Pod-Usage/t/pod/p2u_data.pl @@ -2471,6 +2472,7 @@ cpan/Test-Simple/lib/Test2/API/Stack.pm cpan/Test-Simple/lib/Test2/Event/Bail.pm cpan/Test-Simple/lib/Test2/Event/Diag.pm cpan/Test-Simple/lib/Test2/Event/Exception.pm +cpan/Test-Simple/lib/Test2/Event/Generic.pm cpan/Test-Simple/lib/Test2/Event/Note.pm cpan/Test-Simple/lib/Test2/Event/Ok.pm cpan/Test-Simple/lib/Test2/Event/Plan.pm @@ -2509,7 +2511,6 @@ cpan/Test-Simple/lib/Test/Tester/Delegate.pm cpan/Test-Simple/lib/Test/Tester.pm cpan/Test-Simple/lib/Test/Tutorial.pod cpan/Test-Simple/lib/Test/use/ok.pm -cpan/Test-Simple/t/00compile.t cpan/Test-Simple/t/Legacy/00test_harness_check.t cpan/Test-Simple/t/Legacy/01-basic.t cpan/Test-Simple/t/Legacy/478-cmp_ok_hash.t @@ -2660,6 +2661,7 @@ cpan/Test-Simple/t/lib/Test/Simple/sample_tests/too_few.plx cpan/Test-Simple/t/lib/Test/Simple/sample_tests/two_fail.plx cpan/Test-Simple/t/lib/TieOut.pm cpan/Test-Simple/t/regression/642_persistent_end.t +cpan/Test-Simple/t/regression/662-tbt-no-plan.t cpan/Test-Simple/t/regression/no_name_in_subtest.t cpan/Test-Simple/t/Test2/acceptance/try_it_done_testing.t cpan/Test-Simple/t/Test2/acceptance/try_it_fork.t @@ -2685,6 +2687,7 @@ cpan/Test-Simple/t/Test2/modules/API.t cpan/Test-Simple/t/Test2/modules/Event/Bail.t cpan/Test-Simple/t/Test2/modules/Event/Diag.t cpan/Test-Simple/t/Test2/modules/Event/Exception.t +cpan/Test-Simple/t/Test2/modules/Event/Generic.t cpan/Test-Simple/t/Test2/modules/Event/Note.t cpan/Test-Simple/t/Test2/modules/Event/Ok.t cpan/Test-Simple/t/Test2/modules/Event/Plan.t @@ -4740,6 +4743,7 @@ pod/perl5221delta.pod Perl changes in version 5.22.1 pod/perl5222delta.pod Perl changes in version 5.22.2 pod/perl5240delta.pod Perl changes in version 5.24.0 pod/perl5250delta.pod Perl changes in version 5.25.0 +pod/perl5251delta.pod Perl changes in version 5.25.1 pod/perl561delta.pod Perl changes in version 5.6.1 pod/perl56delta.pod Perl changes in version 5.6 pod/perl581delta.pod Perl changes in version 5.8.1 @@ -5628,6 +5632,7 @@ t/run/switcha.t Test the -a switch t/run/switchC.t Test the -C switch t/run/switchd-78586.t See whether bug 78586 is fixed t/run/switchd.t Test the -d switch +t/run/switchDx.t Test the -D switch t/run/switches.t Tests for the other switches (-0, -l, -c, -s, -M, -m, -V, -v, -h, -z, -i) t/run/switchF1.t Pathological tests for the -F switch t/run/switchF2.t Pathological tests for the -F switch diff --git a/META.json b/META.json index 121ac2e..44ff645 100644 --- a/META.json +++ b/META.json @@ -124,6 +124,6 @@ "url" : "http://perl5.git.perl.org/" } }, - "version" : "5.025001", - "x_serialization_backend" : "JSON::PP version 2.27300" + "version" : "5.025002", + "x_serialization_backend" : "JSON::PP version 2.27400" } diff --git a/META.yml b/META.yml index 7035c9b..7eecc96 100644 --- a/META.yml +++ b/META.yml @@ -111,5 +111,5 @@ resources: homepage: http://www.perl.org/ license: http://dev.perl.org/licenses/ repository: http://perl5.git.perl.org/ -version: '5.025001' +version: '5.025002' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff --git a/Makefile.SH b/Makefile.SH index f398359..5c28589 100755 --- a/Makefile.SH +++ b/Makefile.SH @@ -522,7 +522,7 @@ miniperl_objs = $(miniperl_objs_nodt) $(DTRACE_MINI_O) perllib_objs = $(perllib_objs_nodt) $(DTRACE_PERLLIB_O) perlmain_objs = perlmain$(OBJ_EXT) $(DTRACE_MAIN_O) -perltoc_pod_prereqs = extra.pods pod/perl5251delta.pod pod/perlapi.pod pod/perlintern.pod pod/perlmodlib.pod pod/perluniprops.pod +perltoc_pod_prereqs = extra.pods pod/perl5252delta.pod pod/perlapi.pod pod/perlintern.pod pod/perlmodlib.pod pod/perluniprops.pod generated_pods = pod/perltoc.pod $(perltoc_pod_prereqs) generated_headers = uudmap.h bitcount.h mg_data.h @@ -635,7 +635,7 @@ esac $spitshell >>$Makefile <>$Makefile <<'!NO!SUBS!' perlmain.c: $(MINIPERL_EXE) ext/ExtUtils-Miniperl/pm_to_blib - $(MINIPERL) -Ilib -MExtUtils::Miniperl -e 'writemain(\\"perlmain.c", @ARGV)' DynaLoader $(static_ext) + $(MINIPERL) -MExtUtils::Miniperl -e 'writemain(\\"perlmain.c", @ARGV)' DynaLoader $(static_ext) # The file ext.libs is a list of libraries that must be linked in # for static extensions, e.g. -lm -lgdbm, etc. The individual @@ -744,7 +744,7 @@ ext.libs: $(static_ext) *) $spitshell >>$Makefile <<'!NO!SUBS!' perlmain.c: $(MINIPERL_EXE) ext/ExtUtils-Miniperl/pm_to_blib - $(MINIPERL) -Ilib -MExtUtils::Miniperl -e 'writemain(\"perlmain.c", @ARGV)' DynaLoader $(static_ext) + $(MINIPERL) -MExtUtils::Miniperl -e 'writemain(\"perlmain.c", @ARGV)' DynaLoader $(static_ext) # The file ext.libs is a list of libraries that must be linked in # for static extensions, e.g. -lm -lgdbm, etc. The individual @@ -1085,9 +1085,9 @@ pod/perlintern.pod: $(MINIPERL_EXE) autodoc.pl embed.fnc pod/perlmodlib.pod: $(MINIPERL_EXE) pod/perlmodlib.PL MANIFEST $(MINIPERL) pod/perlmodlib.PL -q -pod/perl5251delta.pod: pod/perldelta.pod - $(RMS) pod/perl5251delta.pod - $(LNS) perldelta.pod pod/perl5251delta.pod +pod/perl5252delta.pod: pod/perldelta.pod + $(RMS) pod/perl5252delta.pod + $(LNS) perldelta.pod pod/perl5252delta.pod extra.pods: $(MINIPERL_EXE) -@test ! -f extra.pods || rm -f `cat extra.pods` diff --git a/NetWare/Makefile b/NetWare/Makefile index faa7aa7..e0f0eed 100644 --- a/NetWare/Makefile +++ b/NetWare/Makefile @@ -86,7 +86,7 @@ NLM_VERSION = 3,20,0 # Here comes the CW tools - TO BE FILLED TO BUILD WITH CW - -MODULE_DESC = "Perl 5.25.1 for NetWare" +MODULE_DESC = "Perl 5.25.2 for NetWare" CCTYPE = CodeWarrior C_COMPILER = mwccnlm -c CPP_COMPILER = mwccnlm @@ -462,7 +462,7 @@ INST_NW_TOP2 = $(INST_NW_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a # path that includes an arbitrary version string. # -INST_VER = \5.25.1 +INST_VER = \5.25.2 # # Comment this out if you DON'T want your perl installation to have diff --git a/NetWare/config.wc b/NetWare/config.wc index a06d89c..7ae8d4f 100644 --- a/NetWare/config.wc +++ b/NetWare/config.wc @@ -421,6 +421,7 @@ d_pwpasswd='undef' d_pwquota='undef' d_qgcvt='undef' d_quad='undef' +d_querylocale='undef' d_random_r='undef' d_readdir64_r='undef' d_readdir='define' @@ -538,6 +539,7 @@ d_strcoll='define' d_strctcpy='define' d_strerrm='strerror(e)' d_strerror='define' +d_strerror_l='undef' d_strerror_r='undef' d_strftime='define' d_strlcat='undef' diff --git a/NetWare/config_H.wc b/NetWare/config_H.wc index 270f4a2..e2f4d96 100644 --- a/NetWare/config_H.wc +++ b/NetWare/config_H.wc @@ -1042,7 +1042,7 @@ * 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 "c:\\perl\\5.25.1\\lib\\NetWare-x86-multi-thread" /**/ +#define ARCHLIB "c:\\perl\\5.25.2\\lib\\NetWare-x86-multi-thread" /**/ /*#define ARCHLIB_EXP "" /**/ /* ARCHNAME: @@ -1073,8 +1073,8 @@ * 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 "c:\\perl\\5.25.1\\bin\\NetWare-x86-multi-thread" /**/ -#define BIN_EXP "c:\\perl\\5.25.1\\bin\\NetWare-x86-multi-thread" /**/ +#define BIN "c:\\perl\\5.25.2\\bin\\NetWare-x86-multi-thread" /**/ +#define BIN_EXP "c:\\perl\\5.25.2\\bin\\NetWare-x86-multi-thread" /**/ /* BYTEORDER: * This symbol holds the hexadecimal constant defined in byteorder, @@ -3047,7 +3047,7 @@ * 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 "c:\\perl\\site\\5.25.1\\lib\\NetWare-x86-multi-thread" /**/ +#define SITEARCH "c:\\perl\\site\\5.25.2\\lib\\NetWare-x86-multi-thread" /**/ /*#define SITEARCH_EXP "" /**/ /* SITELIB: @@ -3070,7 +3070,7 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "c:\\perl\\site\\5.25.1\\lib" /**/ +#define SITELIB "c:\\perl\\site\\5.25.2\\lib" /**/ /*#define SITELIB_EXP "" /**/ #define SITELIB_STEM "" /**/ diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 9905417..d130d6c 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -248,7 +248,7 @@ use File::Glob qw(:case); }, 'CPAN' => { - 'DISTRIBUTION' => 'ANDK/CPAN-2.10.tar.gz', + 'DISTRIBUTION' => 'ANDK/CPAN-2.14-TRIAL.tar.gz', 'FILES' => q[cpan/CPAN], 'EXCLUDED' => [ qr{^distroprefs/}, @@ -283,8 +283,6 @@ use File::Glob qw(:case); t/yaml_code.yml ), ], - # See commit 3198fda65dbcd975c56916e4b98f515fab7f02e5 - 'CUSTOMIZED' => [ qw[ lib/CPAN.pm ] ], }, # Note: When updating CPAN-Meta the META.* files will need to be regenerated @@ -390,8 +388,8 @@ use File::Glob qw(:case); 'DISTRIBUTION' => 'DANKOGAI/Encode-2.80.tar.gz', 'FILES' => q[cpan/Encode], CUSTOMIZED => [ - qw( encoding.pm - ), + qw( encoding.pm ), + 'Byte/Makefile.PL', ], }, @@ -464,7 +462,7 @@ use File::Glob qw(:case); }, 'ExtUtils::MakeMaker' => { - 'DISTRIBUTION' => 'BINGOS/ExtUtils-MakeMaker-7.10.tar.gz', + 'DISTRIBUTION' => 'BINGOS/ExtUtils-MakeMaker-7.18.tar.gz', 'FILES' => q[cpan/ExtUtils-MakeMaker], 'EXCLUDED' => [ qr{^t/lib/Test/}, @@ -476,48 +474,7 @@ use File::Glob qw(:case); 'README.packaging', 'lib/ExtUtils/MakeMaker/version/vpp.pm', ], - # Upstreamed as https://github.com/Perl-Toolchain-Gang/ExtUtils-MakeMaker/commit/ede9ea4a - 'CUSTOMIZED' => [ - qq[lib/ExtUtils/MakeMaker.pm], - qq[t/prereq.t], - qq[t/vstrings.t], - # Upstreamed as https://github.com/Perl-Toolchain-Gang/ExtUtils-MakeMaker/commit/dd1e236ab - qq[lib/ExtUtils/MM_VMS.pm], - # Not yet submitted - qq[t/lib/MakeMaker/Test/NoXS.pm], - # Backported commits from upstream - qw(lib/ExtUtils/Command/MM.pm - lib/ExtUtils/Liblist.pm - lib/ExtUtils/Liblist/Kid.pm - lib/ExtUtils/MM.pm - lib/ExtUtils/MM_AIX.pm - lib/ExtUtils/MM_Any.pm - lib/ExtUtils/MM_BeOS.pm - lib/ExtUtils/MM_Cygwin.pm - lib/ExtUtils/MM_DOS.pm - lib/ExtUtils/MM_Darwin.pm - lib/ExtUtils/MM_MacOS.pm - lib/ExtUtils/MM_NW5.pm - lib/ExtUtils/MM_OS2.pm - lib/ExtUtils/MM_QNX.pm - lib/ExtUtils/MM_UWIN.pm - lib/ExtUtils/MM_Unix.pm - lib/ExtUtils/MM_VOS.pm - lib/ExtUtils/MM_Win32.pm - lib/ExtUtils/MM_Win95.pm - lib/ExtUtils/MY.pm - lib/ExtUtils/MakeMaker/Config.pm - lib/ExtUtils/MakeMaker/FAQ.pod - lib/ExtUtils/MakeMaker/Tutorial.pod - lib/ExtUtils/MakeMaker/version.pm - lib/ExtUtils/MakeMaker/version/regex.pm - lib/ExtUtils/Mkbootstrap.pm - lib/ExtUtils/Mksymlists.pm - lib/ExtUtils/testlib.pm - t/cd.t - t/echo.t - ), - ], + 'CUSTOMIZED' => [ qw( t/basic.t ) ], }, 'ExtUtils::Manifest' => { @@ -607,7 +564,7 @@ use File::Glob qw(:case); }, 'Getopt::Long' => { - 'DISTRIBUTION' => 'JV/Getopt-Long-2.48.tar.gz', + 'DISTRIBUTION' => 'JV/Getopt-Long-2.49.tar.gz', 'FILES' => q[cpan/Getopt-Long], 'EXCLUDED' => [ qr{^examples/}, @@ -619,7 +576,7 @@ use File::Glob qw(:case); }, 'HTTP::Tiny' => { - 'DISTRIBUTION' => 'DAGOLDEN/HTTP-Tiny-0.056.tar.gz', + 'DISTRIBUTION' => 'DAGOLDEN/HTTP-Tiny-0.058.tar.gz', 'FILES' => q[cpan/HTTP-Tiny], 'EXCLUDED' => [ 't/00-report-prereqs.t', @@ -694,7 +651,7 @@ use File::Glob qw(:case); }, 'JSON::PP' => { - 'DISTRIBUTION' => 'MAKAMAKA/JSON-PP-2.27300.tar.gz', + 'DISTRIBUTION' => 'MAKAMAKA/JSON-PP-2.27400.tar.gz', 'FILES' => q[cpan/JSON-PP], }, @@ -724,7 +681,7 @@ use File::Glob qw(:case); }, 'Locale-Codes' => { - 'DISTRIBUTION' => 'SBECK/Locale-Codes-3.38.tar.gz', + 'DISTRIBUTION' => 'SBECK/Locale-Codes-3.39.tar.gz', 'FILES' => q[cpan/Locale-Codes], 'EXCLUDED' => [ qw( README.first @@ -834,7 +791,7 @@ use File::Glob qw(:case); }, 'Module::CoreList' => { - 'DISTRIBUTION' => 'BINGOS/Module-CoreList-5.20160507.tar.gz', + 'DISTRIBUTION' => 'BINGOS/Module-CoreList-5.20160520.tar.gz', 'FILES' => q[dist/Module-CoreList], }, @@ -927,7 +884,7 @@ use File::Glob qw(:case); }, 'Pod::Checker' => { - 'DISTRIBUTION' => 'MAREKR/Pod-Checker-1.60.tar.gz', + 'DISTRIBUTION' => 'MAREKR/Pod-Checker-1.73.tar.gz', 'FILES' => q[cpan/Pod-Checker], }, @@ -965,7 +922,7 @@ use File::Glob qw(:case); }, 'Pod::Usage' => { - 'DISTRIBUTION' => 'MAREKR/Pod-Usage-1.68.tar.gz', + 'DISTRIBUTION' => 'MAREKR/Pod-Usage-1.69.tar.gz', 'FILES' => q[cpan/Pod-Usage], }, @@ -1097,17 +1054,23 @@ use File::Glob qw(:case); }, 'Test::Simple' => { - 'DISTRIBUTION' => 'EXODIST/Test-Simple-1.001014.tar.gz', + 'DISTRIBUTION' => 'EXODIST/Test-Simple-1.302026.tar.gz', 'FILES' => q[cpan/Test-Simple], 'EXCLUDED' => [ qr{^t/xt}, qr{^xt}, qw( .perlcriticrc .perltidyrc + perltidyrc + dist.ini examples/indent.pl examples/subtest.t + examples/tools.t + examples/tools.t t/00compile.t t/xxx-changes_updated.t + t/00-report.t + t/zzz-check-breaks.t ), ], }, @@ -1153,7 +1116,7 @@ use File::Glob qw(:case); # correct for this (and Thread::Semaphore, threads, and threads::shared) # to be under dist/ rather than cpan/ 'Thread::Queue' => { - 'DISTRIBUTION' => 'JDHEDDEN/Thread-Queue-3.09.tar.gz', + 'DISTRIBUTION' => 'JDHEDDEN/Thread-Queue-3.11.tar.gz', 'FILES' => q[dist/Thread-Queue], 'EXCLUDED' => [ qr{^examples/}, @@ -1177,7 +1140,7 @@ use File::Glob qw(:case); }, 'threads' => { - 'DISTRIBUTION' => 'JDHEDDEN/threads-2.08.tar.gz', + 'DISTRIBUTION' => 'JDHEDDEN/threads-2.09.tar.gz', 'FILES' => q[dist/threads], 'EXCLUDED' => [ qr{^examples/}, diff --git a/Porting/bench.pl b/Porting/bench.pl index 94732fe..fb06040 100755 --- a/Porting/bench.pl +++ b/Porting/bench.pl @@ -14,7 +14,12 @@ perls. # Basic: run the tests in t/perf/benchmarks against two or # more perls - bench.pl [options] perl1[=label1] perl2[=label2] ... + bench.pl [options] -- perlA[=labelA] perlB[=labelB] ... + + # run the tests against same perlA 2x, with and without extra + # options + + bench.pl [options] -- perlA=fast PerlA=slow -Mstrict -Dpsltoc # Run bench.pl's own built-in sanity tests @@ -111,7 +116,70 @@ If only one field is selected, the output is in more compact form. --grindargs=I -Optional command-line arguments to pass to cachegrind invocations. +Optional command-line arguments to pass to all cachegrind invocations. + +This option is appended to those which bench.pl uses for its own +purposes; so it can be used to override them (see --debug output +below), and can also be 'abused' to add redirects into the valgrind +command invocation. + +For example, this writes PERL_MEM_LOG activity to foobar.$$, because +3>foobar.$$ redirects fd 3, then perl under PERL_MEM_LOG writes to fd 3. + + $ perl Porting/bench.pl --jobs=2 --verbose --debug \ + --tests=call::sub::amp_empty \ + \ + --grindargs='--cachegrind-out-file=junk.$$ 3>foobar.$$' \ + -- \ + perl5.24.0 perl5.24.0:+memlog:PERL_MEM_LOG=3mst + +for the +memlog tests, this executes as: (shown via --debug, then prettyfied) + + Command: PERL_HASH_SEED=0 PERL_MEM_LOG=3mst + valgrind --tool=cachegrind --branch-sim=yes + --cachegrind-out-file=/dev/null --cachegrind-out-file=junk.$$ + 3>foobar.$$ perl5.24.0 - 10 2>&1 + +The result is that a set of junk.$$ files containing raw cachegrind +output are written, and foobar.$$ contains the expected memlog output. + +Notes: + +Theres no obvious utility for those junk.$$ and foobar.$$ files, but +you can have them anyway. + +The 3 in PERL_MEM_LOG=3mst is needed because the output would +otherwize go to STDERR, and cause parse_cachegrind() to reject the +test and die. + +The --grindargs redirect is needed to capture the memlog output; +without it, the memlog output is written to fd3, around +parse_cachegrind and effectively into /dev/null + +PERL_MEM_LOG is expensive when used. + +call::sub::amp_empty +&foo function call with no args or body + + perl5.24.0 perl5.24.0+memlog + ---------- ----------------- + Ir 394.0 543477.5 + Dr 161.0 146814.1 + Dw 72.0 122304.6 + COND 58.0 66796.4 + IND 5.0 5537.7 + +COND_m 0.0 6743.1 + IND_m 5.0 1490.2 + + Ir_m1 0.0 683.7 + Dr_m1 0.0 65.9 + Dw_m1 0.0 8.5 + + Ir_mm 0.0 11.6 + Dr_mm 0.0 10.6 + Dw_mm 0.0 4.7 + =item * @@ -140,8 +208,8 @@ It defaults to the leftmost column. --perlargs=I -Optional command-line arguments to pass to each perl that is run as part of -a cachegrind session. For example, C<--perlargs=-Ilib>. +Optional command-line arguments to pass to each perl-under-test +(perlA, perlB in synopsis) For example, C<--perlargs=-Ilib>. =item * @@ -209,7 +277,7 @@ Requires C to be available. use 5.010000; use warnings; use strict; -use Getopt::Long qw(:config no_auto_abbrev); +use Getopt::Long qw(:config no_auto_abbrev require_order); use IPC::Open2 (); use IO::Select; use IO::File; @@ -227,7 +295,7 @@ my %VALID_FIELDS = map { $_ => 1 } sub usage { die <{$_}; + die "Error: no such test found: '$_'\n" + . ($OPTS{verbose} ? " have: @{[ sort keys %$tests ]}\n" : "") + unless exists $tests->{$_}; $t{$_} = 1; } for (keys %$tests) { @@ -475,19 +545,39 @@ sub select_a_perl { } -# Validate the list of perl=label on the command line. -# Return a list of [ exe, label ] pairs. +# Validate the list of perl=label (+ cmdline options) on the command line. +# Return a list of [ exe, label, cmdline-options ] tuples, ie PUTs + +sub process_puts { + my @res_puts; # returned, each item is [ perlexe, label, @putargs ] + my %seen; + my @putargs; # collect not-perls into args per PUT + + for my $p (reverse @_) { + push @putargs, $p and next if $p =~ /^-/; # not-perl, dont send to qx// -sub process_perls { - my @results; - for my $p (@_) { - my ($perl, $label) = split /=/, $p, 2; + my ($perl, $label, $env) = split /[=:,]/, $p, 3; $label //= $perl; + $label = $perl.$label if $label =~ /^\+/; + die "$label cannot be used on 2 different PUTs\n" if $seen{$label}++; + + my %env; + if ($env) { + %env = split /[=,]/, $env; + } my $r = qx($perl -e 'print qq(ok\n)' 2>&1); - die "Error: unable to execute '$perl': $r" if $r ne "ok\n"; - push @results, [ $perl, $label ]; + if ($r eq "ok\n") { + push @res_puts, [ $perl, $label, \%env, reverse @putargs ]; + @putargs = (); + warn "Added Perl-Under-Test: [ @{[@{$res_puts[-1]}]} ]\n" + if $OPTS{verbose}; + } else { + warn "PUT-args: @putargs + a not-perl: $p $r\n" + if $OPTS{verbose}; + push @putargs, $p; # not-perl + } } - return @results; + return reverse @res_puts; } @@ -615,7 +705,7 @@ sub do_grind { die "Error: only a single test may be specified with --bisect\n" if defined $OPTS{bisect} and keys %$tests != 1; - $perls = [ process_perls(@$perl_args) ]; + $perls = [ process_puts(@$perl_args) ]; $results = grind_run($tests, $order, $perls, $loop_counts); @@ -702,20 +792,24 @@ sub grind_run { ); for my $p (@$perls) { - my ($perl, $label) = @$p; + my ($perl, $label, $env, @putargs) = @$p; # Run both the empty loop and the active loop # $counts->[0] and $counts->[1] times. for my $i (0,1) { for my $j (0,1) { - my $cmd = "PERL_HASH_SEED=0 " + my $envstr = ''; + if (ref $env) { + $envstr .= "$_=$env->{$_} " for sort keys %$env; + } + my $cmd = "PERL_HASH_SEED=0 $envstr" . "valgrind --tool=cachegrind --branch-sim=yes " . "--cachegrind-out-file=/dev/null " . "$OPTS{grindargs} " - . "$perl $OPTS{perlargs} - $counts->[$j] 2>&1"; + . "$perl $OPTS{perlargs} @putargs - $counts->[$j] 2>&1"; # for debugging and error messages - my $id = "$test/$perl " + my $id = "$test/$label " . ($i ? "active" : "empty") . "/" . ($j ? "long" : "short") . " loop"; @@ -843,7 +937,7 @@ sub grind_run { . "Output\n$o"; } - $results{$j->{test}}{$j->{perl}}[$j->{active}][$j->{loopix}] + $results{$j->{test}}{$j->{plabel}}[$j->{active}][$j->{loopix}] = parse_cachegrind($output, $j->{id}, $j->{perl}); } @@ -932,7 +1026,7 @@ sub grind_process { my %counts; my %data; - my $perl_norm = $perls->[$OPTS{norm}][0]; # the name of the reference perl + my $perl_norm = $perls->[$OPTS{norm}][1]; # the label of the reference perl for my $test_name (keys %$res) { my $res1 = $res->{$test_name}; @@ -1088,6 +1182,7 @@ sub grind_print { my ($results, $averages, $perls, $tests, $order) = @_; my @perl_names = map $_->[0], @$perls; + my @perl_labels = map $_->[1], @$perls; my %perl_labels; $perl_labels{$_->[0]} = $_->[1] for @$perls; @@ -1095,7 +1190,7 @@ sub grind_print { # Calculate the width to display for each column. my $min_width = $OPTS{raw} ? 8 : 6; my @widths = map { length($_) < $min_width ? $min_width : length($_) } - @perl_labels{@perl_names}; + @perl_labels; # Print standard header. grind_blurb($perls); @@ -1125,7 +1220,7 @@ sub grind_print { print " " x $field_label_width; for (0..$#widths) { printf " %*s", $widths[$_], - $i ? ('-' x$widths[$_]) : $perl_labels{$perl_names[$_]}; + $i ? ('-' x$widths[$_]) : $perl_labels[$_]; } print "\n"; } @@ -1147,7 +1242,7 @@ sub grind_print { print " " x $field_label_width; for (0..$#widths) { printf " %*s", $widths[$_], - $i ? ('-' x$widths[$_]) : $perl_labels{$perl_names[$_]}; + $i ? ('-' x$widths[$_]) : $perl_labels[$_]; } print "\n"; } @@ -1177,7 +1272,7 @@ sub grind_print { } for my $i (0..$#widths) { - my $res2 = $res1->{$perl_names[$i]}; + my $res2 = $res1->{$perl_labels[$i]}; my $p = $res2->{$field}; if (!defined $p) { printf " %*s", $widths[$i], '-'; diff --git a/Porting/bisect-runner.pl b/Porting/bisect-runner.pl index 360c186..b127540 100755 --- a/Porting/bisect-runner.pl +++ b/Porting/bisect-runner.pl @@ -67,6 +67,7 @@ unless(GetOptions(\%options, 'all-fixups', 'early-fixup=s@', 'late-fixup=s@', 'valgrind', 'check-args', 'check-shebang!', 'usage|help|?', 'gold=s', 'module=s', 'with-module=s', 'cpan-config-dir=s', + 'no-module-tests', 'A=s@', 'D=s@' => sub { my (undef, $val) = @_; @@ -130,6 +131,10 @@ pod2usage(exitval => 255, verbose => 1) unless @ARGV || $match || $options{'test-build'} || defined $options{'one-liner'} || defined $options{module}; pod2usage(exitval => 255, verbose => 1) if !$options{'one-liner'} && ($options{l} || $options{w}); +if ($options{'no-module-tests'} && $options{module}) { + print STDERR "--module and --no-module-tests are exclusive.\n\n"; + pod2usage(exitval => 255, verbose => 1) +} check_shebang($ARGV[0]) if $options{'check-shebang'} && @ARGV && !$options{match}; @@ -598,6 +603,18 @@ For example: =item * +--no-module-tests + +Use in conjunction with I<--with-module> to install the modules without +running their tests. This can be a big time saver. + +For example: + + .../Porting/bisect.pl --with-module=Moose --no-module-tests \ + -e 'use Moose; ...' + +=item * + --cpan-config-dir /home/blah/custom If defined, this will cause L to look for F inside of @@ -1509,8 +1526,13 @@ if ($options{module} || $options{'with-module'}) { s/-/::/g if /-/ and !m|/|; } my $install = join ",", map { "'$_'" } @m; + if ($options{'no-module-tests'}) { + $install = "notest('install',$install)"; + } else { + $install = "install($install)"; + } my $last = $m[-1]; - my $shellcmd = "install($install); die unless CPAN::Shell->expand(Module => '$last')->uptodate;"; + my $shellcmd = "$install; die unless CPAN::Shell->expand(Module => '$last')->uptodate;"; if ($options{module}) { run_report_and_exit(@cpanshell, $shellcmd); diff --git a/Porting/config.sh b/Porting/config.sh index 96e7ba2..df96265 100644 --- a/Porting/config.sh +++ b/Porting/config.sh @@ -39,12 +39,12 @@ alignbytes='8' ansi2knr='' aphostname='/bin/hostname' api_revision='5' -api_subversion='1' +api_subversion='2' api_version='25' -api_versionstring='5.25.1' +api_versionstring='5.25.2' ar='ar' -archlib='/tmp/mblead/lib/perl5/5.25.1/darwin-2level' -archlibexp='/tmp/mblead/lib/perl5/5.25.1/darwin-2level' +archlib='/tmp/mblead/lib/perl5/5.25.2/darwin-2level' +archlibexp='/tmp/mblead/lib/perl5/5.25.2/darwin-2level' archname64='' archname='darwin-2level' archobjs='' @@ -442,6 +442,7 @@ d_pwpasswd='define' d_pwquota='undef' d_qgcvt='undef' d_quad='define' +d_querylocale='undef' d_random_r='undef' d_re_comp='undef' d_readdir64_r='undef' @@ -561,6 +562,7 @@ d_strcoll='define' d_strctcpy='define' d_strerrm='strerror(e)' d_strerror='define' +d_strerror_l='undef' d_strerror_r='undef' d_strftime='define' d_strlcat='define' @@ -829,7 +831,7 @@ incpath='' incpth='/usr/local/include /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin/../lib/clang/6.0/include /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/include /usr/include /usr/local/include /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin/../lib/clang/6.0/include /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/include /usr/include /usr/local/include /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin/../lib/clang/6.0/include /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/include /usr/include' inews='' initialinstalllocation='/tmp/mblead/bin' -installarchlib='/tmp/mblead/lib/perl5/5.25.1/darwin-2level' +installarchlib='/tmp/mblead/lib/perl5/5.25.2/darwin-2level' installbin='/tmp/mblead/bin' installhtml1dir='' installhtml3dir='' @@ -837,13 +839,13 @@ installman1dir='/tmp/mblead/man/man1' installman3dir='/tmp/mblead/man/man3' installprefix='/tmp/mblead' installprefixexp='/tmp/mblead' -installprivlib='/tmp/mblead/lib/perl5/5.25.1' +installprivlib='/tmp/mblead/lib/perl5/5.25.2' installscript='/tmp/mblead/bin' -installsitearch='/tmp/mblead/lib/perl5/site_perl/5.25.1/darwin-2level' +installsitearch='/tmp/mblead/lib/perl5/site_perl/5.25.2/darwin-2level' installsitebin='/tmp/mblead/bin' installsitehtml1dir='' installsitehtml3dir='' -installsitelib='/tmp/mblead/lib/perl5/site_perl/5.25.1' +installsitelib='/tmp/mblead/lib/perl5/site_perl/5.25.2' installsiteman1dir='/tmp/mblead/man/man1' installsiteman3dir='/tmp/mblead/man/man3' installsitescript='/tmp/mblead/bin' @@ -968,7 +970,7 @@ perl_patchlevel='' perl_static_inline='static __inline__' perladmin='aaron@daybreak.nonet' perllibs='-lpthread -ldl -lm -lutil -lc' -perlpath='/tmp/mblead/bin/perl5.25.1' +perlpath='/tmp/mblead/bin/perl5.25.2' pg='pg' phostname='hostname' pidtype='pid_t' @@ -977,8 +979,8 @@ pmake='' pr='' prefix='/tmp/mblead' prefixexp='/tmp/mblead' -privlib='/tmp/mblead/lib/perl5/5.25.1' -privlibexp='/tmp/mblead/lib/perl5/5.25.1' +privlib='/tmp/mblead/lib/perl5/5.25.2' +privlibexp='/tmp/mblead/lib/perl5/5.25.2' procselfexe='' prototype='define' ptrsize='8' @@ -1044,17 +1046,17 @@ 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 sig_num_init='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, 0' sig_size='33' signal_t='void' -sitearch='/tmp/mblead/lib/perl5/site_perl/5.25.1/darwin-2level' -sitearchexp='/tmp/mblead/lib/perl5/site_perl/5.25.1/darwin-2level' +sitearch='/tmp/mblead/lib/perl5/site_perl/5.25.2/darwin-2level' +sitearchexp='/tmp/mblead/lib/perl5/site_perl/5.25.2/darwin-2level' sitebin='/tmp/mblead/bin' sitebinexp='/tmp/mblead/bin' sitehtml1dir='' sitehtml1direxp='' sitehtml3dir='' sitehtml3direxp='' -sitelib='/tmp/mblead/lib/perl5/site_perl/5.25.1' +sitelib='/tmp/mblead/lib/perl5/site_perl/5.25.2' sitelib_stem='/tmp/mblead/lib/perl5/site_perl' -sitelibexp='/tmp/mblead/lib/perl5/site_perl/5.25.1' +sitelibexp='/tmp/mblead/lib/perl5/site_perl/5.25.2' siteman1dir='/tmp/mblead/man/man1' siteman1direxp='/tmp/mblead/man/man1' siteman3dir='/tmp/mblead/man/man3' @@ -1080,7 +1082,7 @@ src='.' ssizetype='ssize_t' st_ino_sign='1' st_ino_size='8' -startperl='#!/tmp/mblead/bin/perl5.25.1' +startperl='#!/tmp/mblead/bin/perl5.25.2' startsh='#!/bin/sh' static_ext=' ' stdchar='char' @@ -1093,7 +1095,7 @@ stdio_stream_array='' strerror_r_proto='0' strings='/usr/include/string.h' submit='' -subversion='1' +subversion='2' sysman='/usr/share/man/man1' sysroot='' tail='' @@ -1192,8 +1194,8 @@ vendorprefix='' vendorprefixexp='' vendorscript='' vendorscriptexp='' -version='5.25.1' -version_patchlevel_string='version 25 subversion 1' +version='5.25.2' +version_patchlevel_string='version 25 subversion 2' versiononly='define' vi='' xlibpth='/usr/lib/386 /lib/386' @@ -1203,9 +1205,9 @@ zcat='' zip='zip' PERL_REVISION=5 PERL_VERSION=25 -PERL_SUBVERSION=1 +PERL_SUBVERSION=2 PERL_API_REVISION=5 PERL_API_VERSION=25 -PERL_API_SUBVERSION=1 +PERL_API_SUBVERSION=2 PERL_PATCHLEVEL='' PERL_CONFIG_SH=true diff --git a/Porting/config_H b/Porting/config_H index 97fb777..a5b6d78 100644 --- a/Porting/config_H +++ b/Porting/config_H @@ -960,8 +960,8 @@ * 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 "/pro/lib/perl5/5.25.1/i686-linux-64int-ld" /**/ -#define ARCHLIB_EXP "/pro/lib/perl5/5.25.1/i686-linux-64int-ld" /**/ +#define ARCHLIB "/pro/lib/perl5/5.25.2/i686-linux-64int-ld" /**/ +#define ARCHLIB_EXP "/pro/lib/perl5/5.25.2/i686-linux-64int-ld" /**/ /* ARCHNAME: * This symbol holds a string representing the architecture name. @@ -2068,8 +2068,8 @@ * 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 "/pro/lib/perl5/5.25.1" /**/ -#define PRIVLIB_EXP "/pro/lib/perl5/5.25.1" /**/ +#define PRIVLIB "/pro/lib/perl5/5.25.2" /**/ +#define PRIVLIB_EXP "/pro/lib/perl5/5.25.2" /**/ /* PTRSIZE: * This symbol contains the size of a pointer, so that the C preprocessor @@ -2119,8 +2119,8 @@ * 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 "/pro/lib/perl5/site_perl/5.25.1/i686-linux-64int-ld" /**/ -#define SITEARCH_EXP "/pro/lib/perl5/site_perl/5.25.1/i686-linux-64int-ld" /**/ +#define SITEARCH "/pro/lib/perl5/site_perl/5.25.2/i686-linux-64int-ld" /**/ +#define SITEARCH_EXP "/pro/lib/perl5/site_perl/5.25.2/i686-linux-64int-ld" /**/ /* SITELIB: * This symbol contains the name of the private library for this package. @@ -2142,8 +2142,8 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "/pro/lib/perl5/site_perl/5.25.1" /**/ -#define SITELIB_EXP "/pro/lib/perl5/site_perl/5.25.1" /**/ +#define SITELIB "/pro/lib/perl5/site_perl/5.25.2" /**/ +#define SITELIB_EXP "/pro/lib/perl5/site_perl/5.25.2" /**/ #define SITELIB_STEM "/pro/lib/perl5/site_perl" /**/ /* SSize_t: @@ -4282,7 +4282,7 @@ * script to make sure (one hopes) that it runs with perl and not * some shell. */ -#define STARTPERL "#!/pro/bin/perl5.25.1" /**/ +#define STARTPERL "#!/pro/bin/perl5.25.2" /**/ /* HAS_STDIO_STREAM_ARRAY: * This symbol, if defined, tells that there is an array diff --git a/Porting/epigraphs.pod b/Porting/epigraphs.pod index 80a213a..48b91f7 100644 --- a/Porting/epigraphs.pod +++ b/Porting/epigraphs.pod @@ -17,6 +17,25 @@ Consult your favorite dictionary for details. =head1 EPIGRAPHS +=head2 v5.25.1 - Eli Pariser, "The Filter Bubble" + +L + +Imagine that you're a smart high school student on the low end of the social +totem pole. You're alienated from adult authority, but unlike many teenagers, +you're also alienated from the power structures of your peers -- an existence +that can feel lonely and peripheral. Systems and equations are intuitive, but +people aren't -- social signals are confusing and messy, difficult to interpret. + +Then you discover code. You may be powerless at the lunch table, but code +gives you power over an infinitely malleable world and opens the door to a +symbolic system that's perfectly clear and ordered. The jostling for position +and status fades away. The nagging parental voices disappear. There's just a +clean, white page for you to fill, an opportunity to build a better place, a +home, from the ground up. + +No wonder you're a geek. + =head2 v5.25.0 - Robert Frost, "The Trial by Existence" L diff --git a/Porting/make_modlib_cpan.pl b/Porting/make_modlib_cpan.pl index ea0878b..39f4ff9 100644 --- a/Porting/make_modlib_cpan.pl +++ b/Porting/make_modlib_cpan.pl @@ -7,26 +7,35 @@ use warnings; use 5.14.0; use autodie; use HTTP::Tiny; +use JSON::PP; + +$|=1; my $http = HTTP::Tiny->new; -my $url = 'http://www.cpan.org/SITES'; -my $filename = 'SITES'; -my $response = $http->mirror( $url, $filename ); +my $url = 'http://www.cpan.org/indices/mirrors.json'; + +my $response = $http->get($url); + unless ( $response->{success} ) { die "Error downloading $url"; } -my $fh = IO::File->new($filename); +die "No content" unless $response->{content}; -while ( my $line = <$fh> ) { - chomp $line; - last - if $line eq - '[Africa] [Asia] [Australasia] [Central America] [Europe] [North America] [South America]'; -} +my $json = JSON::PP->new->utf8; +my $mirrors = $json->decode( $response->{content} ); +my %sorted; +my @rsync; -my $line = <$fh>; +foreach my $mirror ( sort { $a->{continent} cmp $b->{continent} || $a->{country} cmp $b->{country} } @{ $mirrors } ) { + if ( $mirror->{country} eq 'United States' ) { + push @{ $sorted{ $mirror->{continent} }{ $mirror->{country} }{ $mirror->{region} } }, $mirror; + } + else { + push @{ $sorted{ $mirror->{continent} }{ $mirror->{country} } }, $mirror; + } +} say 'Registered CPAN sites'; say ''; @@ -34,58 +43,48 @@ say '=for maintainers'; say 'Generated by Porting/make_modlib_cpan.pl'; say ''; -my $continent; -my $country; -my $state; - -while ( my $line = <$fh> ) { - chomp $line; - next if $line =~ /^\s+$/; - last if $line eq 'Feedback'; - - if ( $line =~ /^(?\w.+)$/ ) { - if ($continent) { - say ''; - if ($continent) { - say "=back"; - say ''; - } - if ( $continent eq 'North America' ) { - say "=back"; - say ''; - } - } - $continent = $+{continent}; - undef $country; - say "=head2 $continent"; - say ''; - say '=over 4'; - say ''; - } elsif ( $line =~ /^\s{3}(?\w.+)$/ ) { - if ($country) { - say ''; - } - $country = $+{country}; - undef $state; - say "=item $country"; +foreach my $continent ( sort { $a cmp $b } keys %sorted ) { + say "=head2 $continent"; + say ''; + say '=over 4'; + say ''; + foreach my $country ( sort { $a cmp $b } keys %{ $sorted{ $continent } } ) { + say "=item $country"; + say ''; + if ( $country eq 'United States' ) { + say '=over 8'; + say ''; + foreach my $state ( sort { $a cmp $b } keys %{ $sorted{ $continent }{ $country } } ) { + say "=item $state"; say ''; - if ( $country eq 'United States' ) { - say '=over 8'; - say ''; - } - } elsif ( $line =~ /^\s{5}(?\w.+)$/ ) { - if ($state) { - say ''; + foreach my $mirror ( @{ $sorted{ $continent }{ $country }{ $state } } ) { + say " " . $mirror->{http} if $mirror->{http}; + say " " . $mirror->{ftp} if $mirror->{ftp}; + push @rsync, $mirror->{rsync} if $mirror->{rsync}; } - $state = $+{state}; - say "=item $state"; say ''; - } elsif ( $line =~ /^\s{22}(?\w.+$)/ ) { - say " $+{site}"; - } else { - die "Unknown line: $line"; + } + say '=back'; + say ''; + } + else { + foreach my $mirror ( @{ $sorted{ $continent }{ $country } } ) { + say " " . $mirror->{http} if $mirror->{http}; + say " " . $mirror->{ftp} if $mirror->{ftp}; + push @rsync, $mirror->{rsync} if $mirror->{rsync}; + } + say ''; } + } + say '=back'; + say ''; +} + +say '=head2 RSYNC Mirrors'; +say ''; + +foreach my $rsync ( @rsync ) { + say "\t\t$rsync"; } say ''; -say '=back'; diff --git a/Porting/perldelta_template.pod b/Porting/perldelta_template.pod index 27c9952..fd4825b 100644 --- a/Porting/perldelta_template.pod +++ b/Porting/perldelta_template.pod @@ -378,13 +378,12 @@ here. XXX Generate this with: - perl Porting/acknowledgements.pl v5.25.1..HEAD + perl Porting/acknowledgements.pl v5.25.2..HEAD =head1 Reporting Bugs -If you find what you think is a bug, you might check the articles recently -posted to the comp.lang.perl.misc newsgroup and the perl bug database at -L . There may also be information at +If you find what you think is a bug, you might check the perl bug database +at L . There may also be information at L , the Perl Home Page. If you believe you have an unreported bug, please run the L program diff --git a/Porting/pumpkin.pod b/Porting/pumpkin.pod index 3618eec..69da88b 100644 --- a/Porting/pumpkin.pod +++ b/Porting/pumpkin.pod @@ -1129,10 +1129,6 @@ out http://www.cpan.org/CPAN.html ). =head1 Help Save the World You should definitely announce your patch on the perl5-porters list. -You should also consider announcing your patch on -comp.lang.perl.announce, though you should make it quite clear that a -subversion is not a production release, and be prepared to deal with -people who will not read your disclaimer. =head1 Todo diff --git a/Porting/release_schedule.pod b/Porting/release_schedule.pod index 310c3c4..2bc09f5 100644 --- a/Porting/release_schedule.pod +++ b/Porting/release_schedule.pod @@ -49,7 +49,7 @@ you should reset the version numbers to the next blead series. =head2 Perl 5.25 2016-04-08 5.25.0 ✓ Ricardo Signes - 2016-05-20 5.25.1 Sawyer X + 2016-05-20 5.25.1 ✓ Sawyer X 2016-06-20 5.25.2 Matthew Horsfall 2016-07-20 5.25.3 Steve Hay 2016-08-20 5.25.4 BinGOs @@ -57,6 +57,8 @@ you should reset the version numbers to the next blead series. 2016-10-20 5.25.6 Sawyer X 2016-11-20 5.25.7 Aaron Crane 2016-12-20 5.25.8 ? + 2017-01-20 5.25.9 ? + 2017-02-20 5.25.10 Renée Bäcker (RC0 for 5.26.0 will be released once we think that all the blockers have been addressed. This typically means some time in April or May.) diff --git a/Porting/todo.pod b/Porting/todo.pod index 37ba31b..f0f01cb 100644 --- a/Porting/todo.pod +++ b/Porting/todo.pod @@ -23,20 +23,6 @@ not, but if your patch is incorporated, then we'll add your name to the F file, which ships in the official distribution. How many other programming languages offer you 1 line of immortality? -=head1 Tasks that need only a little Perl knowledge - -=head2 Fix POD errors in Perl documentation - -Perl documentation is furnished in POD (Plain Old Documentation); see -L. We also have a utility that checks for various errors in -this documentation: F. Unfortunately many files -have errors in them, and there is a database of known problems, kept in -F. The most prevalent errors are lines -too wide to fit in a standard terminal window, but there are more -serious problems as well; and there are items listed there that are not -in fact errors. The task would be to go through and clean up the -documentation. This would be a good way to learn more about Perl. - =head1 Tasks that only need Perl knowledge =head2 Classify bug tickets by type @@ -201,6 +187,38 @@ Sometimes bugs get fixed as a side effect of something else, and the bug remains open because no one realizes that it has been fixed. Ideally, every open bug should have a TODO test in the core test suite. +=head2 deparse warnings nicely + +Currently Deparse punts on deparsing the bitmask for warnings, which it +dumps uglily as-is. Try running this: + + $ ./perl -Ilib -MO=Deparse -e 'use warnings "pipe"; die' + +Deparse.pm could use the package variables in warnings.pm that warnings.pm +itself uses to convert the list passed to it into a bitfield. Deparse just +needs to reverse that. + +=head2 test and fix Deparse with perl's test suite + +If you run perl's tests with the TEST_ARGS environment variable set to +C<-deparse> (e.g., run C), each test file will be +deparsed and the deparsed output will be run. Currently there are many +failures, which ought to be fixed. There is in F +a list of tests known to fail, but it is out of date. Updating it would +also help. + +This is an incremental task. Every small bit helps. It is also a task that +may never end. As new tests are added, they tickle corner cases that +B::Deparse cannot yet handle correctly. + +This task I need a bit of perl guts knowledge. But what changes need +to be made is usually easy to see by dumping op trees with B::Concise: + + $ ./perl -Ilib -MO=Concise -e 'foo(); print @_; die $$_' + +and adjusting B::Deparse to handle whatever you see B::Concise produce. +This is also a good way to I how perl's op trees work. + =head1 Tasks that need a little sysadmin-type knowledge Or if you prefer, tasks that you would learn from, and broaden your skills @@ -467,7 +485,7 @@ Natively 64-bit systems need neither -Duse64bitint nor -Duse64bitall. On these systems, it might be the default compilation mode, and there is currently no guarantee that passing no use64bitall option to the Configure process will build a 32bit perl. Implementing -Duse32bit* -options would be nice for perl 5.25.1. +options would be nice for perl 5.25.2. =head2 Profile Perl - am I hot or not? @@ -543,19 +561,6 @@ the correct answer. been written so that it reflects the state of the read-only attribute, even for directories (whatever CRT is being used), for symmetry with chmod().) -=head2 strcat(), strcpy(), strncat(), strncpy(), sprintf(), vsprintf() - -Maybe create a utility that checks after each libperl.a creation that -none of the above (nor sprintf(), vsprintf(), or *SHUDDER* gets()) -ever creep back to libperl.a. - - nm libperl.a | ./miniperl -alne '$o = $F[0] if /:$/; - print "$o $F[1]" if $F[0] eq "U" && $F[1] - =~ /^(?:strn?c(?:at|py)|v?sprintf|gets)$/' - -Note, of course, that this will only tell whether B platform -is using those naughty interfaces. - =head2 Arenas for GPs? For MAGIC? C and C are both currently allocated by C. @@ -622,6 +627,11 @@ term, once the run-time implementation is proven, it should be possible to progressively update ExtUtils::ParseXS to generate OP implementations for some XSUBs. +=head2 Document how XS modules can install lexical subs + +There is an example in XS::APItest (look for C in +F). The documentation could be based on it. + =head2 Remove the use of SVs as temporaries in dump.c F contains debugging routines to dump out the contains of perl data @@ -788,7 +798,9 @@ allow taint to "leak" everywhere within an expression. system() accepts a LIST syntax (and a PROGRAM LIST syntax) to avoid running a shell. readpipe() (the function behind qx//) could be similarly -extended. +extended. Note that changing readpipe() itself may not be the solution, as +it currently has unary precedence, and allowing a list would change the +precedence. =head2 Audit the code for destruction ordering assumptions @@ -856,6 +868,35 @@ also the warning messages (see L, F). These tasks would need C knowledge, and knowledge of how the interpreter works, or a willingness to learn. +=head2 fix refaliasing with nested and recursive subroutines + +Currently aliasing lexical variables via reference only applies to the +current subroutine, and does not propagate to inner closures, nor does +aliasing of outer variables within closures propagate to the outer +subroutine. This is because each subroutine has its own lexical pad and the +aliasing works by changing which SV the pad points to. + +One possible way to fix this would be to create new ops for accessing +variables that are closed over. So C would use a new op +type, say C, instead of the C currently used in the +sub. That new op would possibly check a flag or some such and see if it +needs to fetch the variable from an outer pad. If we follow this approach, +it should be possible at compile time to detect cases where the more +complex C op is unnecessary and revert back to the simpler, +faster C. There would need to be corresponding ops for arrays, +hashes, and subs, too. + +There is also a related issue with recursion and C variables. A +subroutine actually has a list of lexical pads, each one used at a +different recursion level. If a C variable is aliased to another +variable after a recursive call to the same subroutine, that higher call +depth will not see the effect of aliasing, because the second pad will have +been created already. Similarly, aliasing a state variable within a +recursive call will not affect outer calls, even though all call depths are +supposed to share the same C variables. + +Both of these bugs affect C aliasing, too. + =head2 forbid labels with keyword names Currently C "computes" the label value: @@ -870,7 +911,7 @@ bareword expressions after a "goto" as a label and never as a keyword. =head2 truncate() prototype The prototype of truncate() is currently C<$$>. It should probably -be C<*$> instead. (This is changed in F) +be C<*$> instead. (This is changed in F.) =head2 error reporting of [$a ; $b] @@ -962,11 +1003,6 @@ program if you pass the process ID. It would be good to do this with the Perl debugger on a running Perl program, although I'm not sure how it would be done." ssh and screen do this with named pipes in /tmp. Maybe we can too. -=head2 LVALUE functions for lists - -The old perltodo notes that lvalue functions don't work for list or hash -slices. This would be good to fix. - =head2 regexp optimizer optional The regexp optimizer is not optional. It should be configurable to be optional @@ -999,10 +1035,6 @@ have a general mechanism for this, backwards compatible and little speed hit. This would allow proposals such as short circuiting sort to be implemented as a module on CPAN. -=head2 lexical aliases - -Allow lexical aliases (maybe via the syntax C). - =head2 Self-ties Self-ties are currently illegal because they caused too many segfaults. Maybe @@ -1051,6 +1083,9 @@ See also L. =head2 repack the optree +B This entry was written in reference to the I slab allocator, +removed in commit 7aef8e5bd14. + Repacking the optree after execution order is determined could allow removal of NULL ops, and optimal ordering of OPs with respect to cache-line filling. I think that @@ -1170,7 +1205,7 @@ L =head1 Big projects Tasks that will get your name mentioned in the description of the "Highlights -of 5.25.1" +of 5.25.2" =head2 make ithreads more robust diff --git a/README.aix b/README.aix index 2b02db9..be28327 100644 --- a/README.aix +++ b/README.aix @@ -14,7 +14,7 @@ is compiled and/or runs. =head2 Compiling Perl 5 on AIX -For information on compilers on older versions of AIX, see L. When compiling Perl, you must use an ANSI C compiler. AIX does not ship @@ -31,7 +31,7 @@ works on your system. If you plan to link Perl to any module that requires thread-support, like DBD::Oracle, it is better to use the _r version of the compiler. This will not build a threaded Perl, but a thread-enabled Perl. See -also L later on. +also L later on. As of writing (2010-09) only the I or I compiler is supported by IBM on AIX 5L/6.1/7.1. diff --git a/README.haiku b/README.haiku index b833f7d..8296add 100644 --- a/README.haiku +++ b/README.haiku @@ -22,9 +22,9 @@ The build procedure is completely standard: Make perl executable and create a symlink for libperl: chmod a+x /boot/common/bin/perl - cd /boot/common/lib; ln -s perl5/5.25.1/BePC-haiku/CORE/libperl.so . + cd /boot/common/lib; ln -s perl5/5.25.2/BePC-haiku/CORE/libperl.so . -Replace C<5.25.1> with your respective version of Perl. +Replace C<5.25.2> with your respective version of Perl. =head1 KNOWN PROBLEMS diff --git a/README.macosx b/README.macosx index 17034c7..63cf0fd 100644 --- a/README.macosx +++ b/README.macosx @@ -10,9 +10,9 @@ perlmacosx - Perl under Mac OS X This document briefly describes Perl under Mac OS X. - curl -O http://www.cpan.org/src/perl-5.25.1.tar.gz - tar -xzf perl-5.25.1.tar.gz - cd perl-5.25.1 + curl -O http://www.cpan.org/src/perl-5.25.2.tar.gz + tar -xzf perl-5.25.2.tar.gz + cd perl-5.25.2 ./Configure -des -Dprefix=/usr/local/ make make test @@ -20,7 +20,7 @@ This document briefly describes Perl under Mac OS X. =head1 DESCRIPTION -The latest Perl release (5.25.1 as of this writing) builds without changes +The latest Perl release (5.25.2 as of this writing) builds without changes under all versions of Mac OS X from 10.3 "Panther" onwards. In order to build your own version of Perl you will need 'make', diff --git a/README.os2 b/README.os2 index db39d4e..80581bd 100644 --- a/README.os2 +++ b/README.os2 @@ -180,7 +180,7 @@ Since OS/2 port of perl uses a remarkable EMX environment, it can run (and build extensions, and - possibly - be built itself) under any environment which can run EMX. The current list is DOS, DOS-inside-OS/2, Win0.3*, Win0.95 and WinNT. Out of many perl flavors, -only one works, see L<"perl_.exe">. +only one works, see L">. Note that not all features of Perl are available under these environments. This depends on the features the I - most @@ -224,7 +224,7 @@ will work as well.) To run Perl on DPMI platforms one needs RSX runtime. This is needed under DOS-inside-OS/2, Win0.3*, Win0.95 and WinNT (see -L<"Other OSes">). RSX would not work with VCPI +L). RSX would not work with VCPI only, as EMX would, it requires DMPI. Having RSX and the latest F one gets a fully functional @@ -261,7 +261,7 @@ To start external programs with complicated command lines (like with pipes in between, and/or quoting of arguments), Perl uses an external shell. With EMX port such shell should be named F, and located either in the wired-in-during-compile locations (usually F), -or in configurable location (see L<"PERL_SH_DIR">). +or in configurable location (see L">). For best results use EMX pdksh. The standard binary (5.2.14 or later) runs under DOS (with L) as well, see @@ -328,9 +328,9 @@ are for. (Avoid exec() (see L) unless you know what you do). Note however that to use some of these operators you need to have a -sh-syntax shell installed (see L<"Pdksh">, -L<"Frequently asked questions">), and perl should be able to find it -(see L<"PERL_SH_DIR">). +sh-syntax shell installed (see L, +L), and perl should be able to find it +(see L">). The cases when the shell is used are: @@ -475,12 +475,12 @@ should be done "correctly". =head2 C<``> and pipe-C do not work under DOS. -This may a variant of just L<"I cannot run external programs">, or a +This may a variant of just L, or a deeper problem. Basically: you I RSX (see L) for these commands to work, and you may need a port of F which understands command arguments. One of such ports is listed in L under RSX. Do not forget to set variable -C> as well. +L"> as well. DPMI is required for RSX. @@ -535,11 +535,11 @@ B =item C may be needed if you change your codepage I perl installation, -and the new value is not supported by EMX. See L<"PERL_BADLANG">. +and the new value is not supported by EMX. See L">. =item C -see L<"PERL_BADFREE">. +see L">. =item F @@ -558,7 +558,7 @@ of this file. B. Because of a typo the binary installer of 5.00305 would install a variable C into F. Please -remove this variable and put C> instead. +remove this variable and put L> instead. =head2 Manual binary installation @@ -615,11 +615,11 @@ If this directory is exactly the same as the prefix which was compiled into F, you do not need to change anything. However, for perl to find the library if you use a different path, you need to -C in F, see L<"PERLLIB_PREFIX">. +C in F, see L">. =item Additional Perl modules - unzip perl_ste.zip -d f:/perllib/lib/site_perl/5.25.1/ + unzip perl_ste.zip -d f:/perllib/lib/site_perl/5.25.2/ Same remark as above applies. Additionally, if this directory is not one of directories on @INC (and @INC is influenced by C), you @@ -675,7 +675,7 @@ This is used by perl to run external commands which explicitly require shell, like the commands using I and I. It is also used instead of explicit F. -Set C (see L<"PERL_SH_DIR">) if you move F from +Set C (see L">) if you move F from the above location. B It may be possible to use some other sh-compatible shell (untested). @@ -696,7 +696,7 @@ currently start with C). The automatic and manual perl installation leave precompiled paths inside perl executables. While these paths are overwriteable (see -L<"PERLLIB_PREFIX">, L<"PERL_SH_DIR">), some people may prefer +L">, L">), some people may prefer binary editing of paths inside the executables/DLLs. =head1 Accessing documentation @@ -714,7 +714,7 @@ Most probably the most convenient form. Under OS/2 view it as view perl ExtUtils::MakeMaker (currently the last two may hit a wrong location, but this may improve -soon). Under Win* see L<"SYNOPSIS">. +soon). Under Win* see L. If you want to build the docs yourself, and have I, run @@ -948,7 +948,7 @@ wrong you find there. I do not expect it is needed anywhere. C means: where to install the resulting perl library. Giving correct prefix you may avoid the need to specify C, -see L<"PERLLIB_PREFIX">. +see L">. I, and about C<-c> option to tr>. The latter is most probably already fixed, if you see it and can trace @@ -982,7 +982,7 @@ Some tests may generate extra messages similar to =item A lot of C in database tests related to Berkeley DB. I -If it persists, you may disable this warnings, see L<"PERL_BADFREE">. +If it persists, you may disable this warnings, see L">. =item Process terminated by SIGTERM/SIGINT @@ -1073,7 +1073,7 @@ making steps.) =head2 C-style build -Proceed as above, but make F (see L<"perl_.exe">) by +Proceed as above, but make F (see L">) by make perl_ @@ -1195,7 +1195,7 @@ via C is going to be painfully slow, since it statically links a new executable per XS extension. Here is a possible workaround: create a toplevel F in -F<$CPANHOME/.cpan/build/> with contents being (compare with L with contents being (compare with L) use ExtUtils::MakeMaker; @@ -1367,7 +1367,7 @@ to find Perl DLL relatively to the location of the EXE file; or one may want to ignore the environment when setting the Perl-library search patch, etc. If you fill comfortable with I interface (see L), such -things are easy to do repeating the steps outlined in L, and doing more comprehensive edits to main() of F. The people with little desire to understand Perl can just rename main(), and do necessary @@ -1619,7 +1619,7 @@ translated to system qw(C:/emx.add/bin/bash.exe -x -c C:/emx/bin/foo.cmd bar baz) One additional translation is performed: instead of F Perl uses -the hardwired-or-customized shell (see C>). +the hardwired-or-customized shell (see L">). The above search for "interpreter" is recursive: if F executable is not found, but F is found, Perl will investigate its first line etc. @@ -1764,7 +1764,7 @@ Transforms the current application into a PM application and back. The argument true means that a real message loop is going to be served. OS2::MorphPM() returns the PM message queue handle as an integer. -See L<"Centralized management of resources"> for additional details. +See L for additional details. =item C @@ -1801,7 +1801,7 @@ The variant of OS2::_control87() with default values good for handling exception mask: if no C, uses exception mask part of C only. If no C, disables all the floating point exceptions. -See L<"Misfeatures"> for details. +See L for details. =item C @@ -1899,7 +1899,7 @@ Note that C does not work with the current version of EMX. =item * -See L<"Text-mode filehandles">. +See L. =item * @@ -1958,7 +1958,7 @@ Perl modifies some standard C library calls in the following ways: =item C -C uses F if shell is required, cf. L<"PERL_SH_DIR">. +C uses F if shell is required, cf. L">. =item C @@ -2194,7 +2194,7 @@ application. I The friends locked into C world would appreciate the fact that this executable runs under DOS, Win0.3*, Win0.95 and WinNT with an -appropriate extender. See L<"Other OSes">. +appropriate extender. See L. =head2 F @@ -2620,7 +2620,7 @@ with C<-Zmt -Zcrtdll>. Due to a popular demand the perl external program calling has been changed wrt Andreas Kaiser's port. I perl needs to call an external program I, the F will be called, or -whatever is the override, see L<"PERL_SH_DIR">. +whatever is the override, see L">. Thus means that you need to get some copy of a F as well (I use one from pdksh). The path F above is set up automatically during @@ -2743,7 +2743,7 @@ files - and maybe some other extensions at the time you read it. Note that OS2 perl defines 2 pseudo-extension functions OS2::Copy::copy and DynaLoader::mod2fname (many more now, see -L). +L). The -R switch of older perl is deprecated. If you need to call a REXX code which needs access to variables, include the call into a REXX compartment diff --git a/README.solaris b/README.solaris index 8f76305..f6c288d 100644 --- a/README.solaris +++ b/README.solaris @@ -484,20 +484,20 @@ malloc. [XXX further investigation is needed here.] If you have problems with dynamic loading using gcc on SunOS or Solaris, and you are using GNU as and GNU ld, see the section -L<"GNU as and GNU ld"> above. +L above. =item ld.so.1: ./perl: fatal: relocation error: If you get this message on SunOS or Solaris, and you're using gcc, it's probably the GNU as or GNU ld problem in the previous item -L<"GNU as and GNU ld">. +L. =item dlopen: stub interception failed The primary cause of the 'dlopen: stub interception failed' message is that the LD_LIBRARY_PATH environment variable includes a directory which is a symlink to /usr/lib (such as /lib). See -L<"LD_LIBRARY_PATH"> above. +L above. =item #error "No DATAMODEL_NATIVE specified" @@ -564,7 +564,7 @@ through 255 can be used in a stream. Since perl calls open() and then fdopen(3C) with the resulting file descriptor, perl is limited to 255 simultaneous open files, even if sysopen() is used. If this proves to be an insurmountable problem, you can compile perl as a -LP64 application, see L for details. Note +LP64 application, see L for details. Note also that the default resource limit for open file descriptors on Solaris is 255, so you will have to modify your ulimit or rctl (Solaris 9 onwards) appropriately. diff --git a/README.synology b/README.synology index b1ef60b..6a02027 100644 --- a/README.synology +++ b/README.synology @@ -23,7 +23,7 @@ L When you perform a system software upgrade, these links will disappear and need to be re-established. +=head3 DSM 6 + +Using iPkg has been deprecated on DSM 6, but an alternative is available +for DSM 6: entware/opkg. For instructions on how to use that, please read +L + +That sadly does not (yet) work on QorIQ. At the moment of writing, the +supported architectures are armv5, armv7, mipsel, x86_32 and x86_64. + +Entware-ng comes with a precompiled 5.22.1 (June 2016) that allowes +building shared XS code. Note that this installation does B use +a site_perl folder. + =head2 Compiling Perl 5 When the build environment has been set up, building and testing Perl @@ -250,7 +265,7 @@ the programs are run. =head1 REVISION -March 2015, for Synology DSM 5.1.5022. +June 2016, for Synology DSM 5.1.5022 and DSM 6.0.1-7393. =head1 AUTHOR diff --git a/README.tw b/README.tw index 5944bd8..f5588a8 100644 --- a/README.tw +++ b/README.tw @@ -101,10 +101,6 @@ Perl 郵遞論壇一覽 正體中文版的歐萊禮 Perl 書藉 -=item L - -臺灣 Perl 連線討論區 (也就是各大 BBS 的 Perl 連線版) - =back =head2 Perl 使用者集會 diff --git a/README.vms b/README.vms index 2cce887..dbd6a8b 100644 --- a/README.vms +++ b/README.vms @@ -142,11 +142,11 @@ You may need to set up a foreign symbol for the unpacking utility of choice. Once you have done so, use a command like the following to unpack the archive: - vmstar -xvf perl-5^.25^.1.tar + vmstar -xvf perl-5^.25^.2.tar Then set default to the top-level source directory like so: - set default [.perl-5^.25^.1] + set default [.perl-5^.25^.2] and proceed with configuration as described in the next section. @@ -246,7 +246,7 @@ the build. Once you issue your MMS or MMK command, sit back and wait. Perl should compile and link without a problem. If a problem does occur check the "CAVEATS" section of this document. If that does not help send some -mail to the VMSPERL mailing list. Instructions are in the L<"Mailing Lists"> +mail to the VMSPERL mailing list. Instructions are in the L section of this document. =head1 Testing Perl diff --git a/README.win32 b/README.win32 index bc574aa..1b68250 100644 --- a/README.win32 +++ b/README.win32 @@ -17,7 +17,7 @@ found in the top-level directory to which the Perl distribution was extracted. Make sure you read and understand the terms under which this software is being distributed. -Also make sure you read L below for the +Also make sure you read L below for the known limitations of this port. The INSTALL file in the perl top-level has much information that is @@ -87,7 +87,7 @@ Also, the trimmed down compiler only passes tests when USE_ITHREADS *= define This port fully supports MakeMaker (the set of modules that is used to build extensions to perl). Therefore, you should be able to build and install most extensions found in the CPAN sites. -See L below for general hints about this. +See L below for general hints about this. =head2 Setting Up Perl on Windows @@ -444,7 +444,7 @@ include some tools (C for instance) which override the Windows ones and makes tests fail. Remove them from your path while testing to avoid these errors. -Please report any other failures as described under L. +Please report any other failures as described under L. =head2 Installation of Perl on Windows diff --git a/charclass_invlists.h b/charclass_invlists.h index 629c066..17e0c6f 100644 --- a/charclass_invlists.h +++ b/charclass_invlists.h @@ -87844,7 +87844,7 @@ static const U8 WB_table[19][19] = { #endif /* defined(PERL_IN_REGEXEC_C) */ /* Generated from: - * cb3170dd603ad12ba0299440e99e8f50a8afde60ade2ffcbf1ff4a8a53854b90 lib/Unicode/UCD.pm + * 66726fe32be96a422e8c9b45bc9daf61e068d988c99ff41112972ef721365521 lib/Unicode/UCD.pm * ae98bec7e4f0564758eed81eca5015481ba32581f8a735a825b71b3bba714450 lib/unicore/ArabicShaping.txt * 1687fe5994eb7e5c0dab8503fc2a1b3b479d91af9d3b8055941c9bd791f7d0b5 lib/unicore/BidiBrackets.txt * 350d1302116194b0b21def287434b55c5088098fbc726e879f7420a391965643 lib/unicore/BidiMirroring.txt diff --git a/config_h.SH b/config_h.SH index 40b3475..6e8cd3b 100755 --- a/config_h.SH +++ b/config_h.SH @@ -217,7 +217,7 @@ sed <$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un #$d_getlogin HAS_GETLOGIN /**/ /* HAS_GETPGID: - * This symbol, if defined, indicates to the C program that + * This symbol, if defined, indicates to the C program that * the getpgid(pid) function is available to get the * process group id. */ @@ -676,8 +676,8 @@ sed <$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un * This symbol holds the type used for the second argument to * getgroups() and setgroups(). Usually, this is the same as * gidtype (gid_t) , but sometimes it isn't. - * It can be int, ushort, gid_t, etc... - * It may be necessary to include to get any + * It can be int, ushort, gid_t, etc... + * It may be necessary to include to get any * typedef'ed information. This is only required if you have * getgroups() or setgroups().. */ @@ -3246,9 +3246,14 @@ sed <$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un * This symbol, if defined, indicates that the uselocale routine is * available to set the current locale for the calling thread. */ +/* HAS_QUERYLOCALE: + * This symbol, if defined, indicates that the querylocale routine is + * available to return the name of the locale for a category mask. + */ #$d_newlocale HAS_NEWLOCALE /**/ #$d_freelocale HAS_FREELOCALE /**/ #$d_uselocale HAS_USELOCALE /**/ +#$d_querylocale HAS_QUERYLOCALE /**/ /* HAS_NEXTAFTER: * This symbol, if defined, indicates that the nextafter routine is @@ -3502,6 +3507,13 @@ sed <$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un */ #$d_fstatvfs HAS_FSTATVFS /**/ +/* HAS_STRERROR_L: + * This symbol, if defined, indicates that the strerror_l routine is + * available to return the error message for a given errno value in + * a particular locale (identified by a locale_t object). + */ +#$d_strerror_l HAS_STRERROR_L /**/ + /* HAS_STRFTIME: * This symbol, if defined, indicates that the strftime routine is * available to do time formatting. diff --git a/configpm b/configpm index 21bd3ef..c62f0fc 100755 --- a/configpm +++ b/configpm @@ -478,20 +478,17 @@ sub _V { my ($bincompat, $non_bincompat, $date, @patches) = Internals::V(); - my $opts = join ' ', sort split ' ', "$bincompat $non_bincompat"; - - # wrap at 76 columns. - - $opts =~ s/(?=.{53})(.{1,53}) /$1\n /mg; + my @opts = sort split ' ', "$bincompat $non_bincompat"; print Config::myconfig(); print "\nCharacteristics of this %s: \n"; - print " Compile-time options: $opts\n"; + print " Compile-time options:\n"; + print " $_\n" for @opts; if (@patches) { print " Locally applied patches:\n"; - print "\t$_\n" foreach @patches; + print " $_\n" foreach @patches; } print " Built under %s\n"; diff --git a/configure.com b/configure.com index ffcbc22..f7d002e 100644 --- a/configure.com +++ b/configure.com @@ -6893,6 +6893,7 @@ $ WC "d_lgamma_r='undef'" $ WC "d_localtime_r='undef'" ! leave undef'd; we use my_localtime $ WC "d_localtime_r_needs_tzset='undef'" $ WC "d_newlocale='undef'" +$ WC "d_querylocale='undef'" $ WC "d_random_r='undef'" $ WC "d_readdir_r='define'" ! always defined; we roll our own $ WC "d_readdir64_r='undef'" @@ -6906,6 +6907,7 @@ $ WC "d_setservent_r='undef'" $ WC "d_snprintf='" + d_snprintf + "'" $ WC "d_srand48_r='undef'" $ WC "d_srandom_r='undef'" +$ WC "d_strerror_l='undef'" $ WC "d_strerror_r='undef'" $ WC "d_tmpnam_r='undef'" $ WC "d_ttyname_r='" + d_ttyname_r + "'" diff --git a/cop.h b/cop.h index da29572..b371379 100644 --- a/cop.h +++ b/cop.h @@ -609,10 +609,10 @@ struct block_format { /* Restore old @_ */ #define CX_POP_SAVEARRAY(cx) \ STMT_START { \ - AV *av = GvAV(PL_defgv); \ + AV *cx_pop_savearray_av = GvAV(PL_defgv); \ GvAV(PL_defgv) = cx->blk_sub.savearray; \ cx->blk_sub.savearray = NULL; \ - SvREFCNT_dec(av); \ + SvREFCNT_dec(cx_pop_savearray_av); \ } STMT_END /* junk in @_ spells trouble when cloning CVs and in pp_caller(), so don't diff --git a/cpan/CPAN/lib/App/Cpan.pm b/cpan/CPAN/lib/App/Cpan.pm index e8c9bb7..59642ed 100644 --- a/cpan/CPAN/lib/App/Cpan.pm +++ b/cpan/CPAN/lib/App/Cpan.pm @@ -6,7 +6,7 @@ use vars qw($VERSION); use if $] < 5.008 => 'IO::Scalar'; -$VERSION = '1.63'; +$VERSION = '1.64'; =head1 NAME @@ -34,7 +34,7 @@ App::Cpan - easily interact with CPAN from the command line cpan # without arguments, but some switches - cpan [-ahpruvACDLOP] + cpan [-ahpruvACDLOPX] =head1 DESCRIPTION @@ -104,7 +104,7 @@ distribution. Print a help message and exit. When you specify C<-h>, it ignores all of the other options and arguments. -=item -i +=item -i module [ module ... ] Install the specified modules. With no other switches, this switch is implied. @@ -164,7 +164,12 @@ session. Recompiles dynamically loaded modules with CPAN::Shell->recompile. -=item -t +=item -s + +Drop in the CPAN.pm shell. This command does this automatically if you don't +specify any arguments. + +=item -t module [ module ... ] Run a `make test` on the specified modules. @@ -192,6 +197,16 @@ UNIMPLEMENTED Turn on cpan warnings. This checks various things, like directory permissions, and tells you about problems you might have. +=item -x module [ module ... ] + +Find close matches to the named modules that you think you might have +mistyped. This requires the optional installation of Text::Levenshtein or +Text::Levenshtein::Damerau. + +=item -X + +Dump all the namespaces to standard output. + =back =head2 Examples @@ -299,7 +314,7 @@ BEGIN { # most of this should be in methods use vars qw( @META_OPTIONS $Default %CPAN_METHODS @CPAN_OPTIONS @option_order %Method_table %Method_table_index ); -@META_OPTIONS = qw( h v V I g G M: C A D O l L a r p P j: J w T); +@META_OPTIONS = qw( h v V I g G M: C A D O l L a r p P j: J w x X ); $Default = 'default'; @@ -312,6 +327,7 @@ $Default = 'default'; 't' => 'test', 'u' => 'upgrade', 'T' => 'notest', + 's' => 'shell', ); @CPAN_OPTIONS = grep { $_ ne $Default } sort keys %CPAN_METHODS; @@ -332,6 +348,7 @@ sub GOOD_EXIT () { 0 } h => [ \&_print_help, NO_ARGS, GOOD_EXIT, 'Printing help' ], v => [ \&_print_version, NO_ARGS, GOOD_EXIT, 'Printing version' ], V => [ \&_print_details, NO_ARGS, GOOD_EXIT, 'Printing detailed version' ], + X => [ \&_list_all_namespaces, NO_ARGS, GOOD_EXIT, 'Listing all namespaces' ], # options that affect other options j => [ \&_load_config, ARGS, GOOD_EXIT, 'Use specified config file' ], @@ -343,8 +360,8 @@ sub GOOD_EXIT () { 0 } w => [ \&_turn_on_warnings, NO_ARGS, GOOD_EXIT, 'Turning on warnings' ], # options that do their one thing - g => [ \&_download, NO_ARGS, GOOD_EXIT, 'Download the latest distro' ], - G => [ \&_gitify, NO_ARGS, GOOD_EXIT, 'Down and gitify the latest distro' ], + g => [ \&_download, ARGS, GOOD_EXIT, 'Download the latest distro' ], + G => [ \&_gitify, ARGS, GOOD_EXIT, 'Down and gitify the latest distro' ], C => [ \&_show_Changes, ARGS, GOOD_EXIT, 'Showing Changes file' ], A => [ \&_show_Author, ARGS, GOOD_EXIT, 'Showing Author' ], @@ -358,7 +375,9 @@ sub GOOD_EXIT () { 0 } r => [ \&_recompile, NO_ARGS, GOOD_EXIT, 'Recompiling' ], u => [ \&_upgrade, NO_ARGS, GOOD_EXIT, 'Running `make test`' ], + 's' => [ \&_shell, NO_ARGS, GOOD_EXIT, 'Running `make test`' ], + 'x' => [ \&_guess_namespace, ARGS, GOOD_EXIT, 'Guessing namespaces' ], c => [ \&_default, ARGS, GOOD_EXIT, 'Running `make clean`' ], f => [ \&_default, ARGS, GOOD_EXIT, 'Installing with force' ], i => [ \&_default, ARGS, GOOD_EXIT, 'Running `make install`' ], @@ -510,7 +529,7 @@ sub run last OPTION; } - $logger->info( "$description -- ignoring other arguments" ) + $logger->info( "[$option] $description -- ignoring other arguments" ) if( @ARGV && ! $takes_args ); $return_value = $sub->( \ @ARGV, $options ); @@ -536,7 +555,7 @@ sub _init_logger unless( $log4perl_loaded ) { - print "Loading internal null logger. Install Log::Log4perl for logging messages\n"; + print STDERR "Loading internal null logger. Install Log::Log4perl for logging messages\n"; $logger = Local::Null::Logger->new; return $logger; } @@ -597,6 +616,12 @@ sub _default foreach my $arg ( @$args ) { + # check the argument and perhaps capture typos + my $module = _expand_module( $arg ) or do { + $logger->error( "Skipping $arg because I couldn't find a matching namespace." ); + next; + }; + _clear_cpanpm_output(); $action->( $arg ); @@ -785,8 +810,7 @@ HERE $CPAN::Frontend->myprint("\n"); } - my $mirrors = CPAN::Mirrors->new( ); - $mirrors->parse_mirrored_by( File::Spec->catfile($CPAN::Config->{keep_source_where},'MIRRORED.BY') ); + my $mirrors = CPAN::Mirrors->new( _mirror_file() ); my @continents = $mirrors->find_best_continents; my @mirrors = $mirrors->get_mirrors_by_continents( $continents[0] ); @@ -907,9 +931,7 @@ sub _is_pingable_scheme { $uri->scheme eq 'file' } -sub _find_good_mirrors { - require CPAN::Mirrors; - +sub _mirror_file { my $file = do { my $file = 'MIRRORED.BY'; my $local_path = File::Spec->catfile( @@ -922,7 +944,12 @@ sub _find_good_mirrors { $local_path; } }; - my $mirrors = CPAN::Mirrors->new( $file ); + } + +sub _find_good_mirrors { + require CPAN::Mirrors; + + my $mirrors = CPAN::Mirrors->new( _mirror_file() ); my @mirrors = $mirrors->best_mirrors( how_many => 5, @@ -1044,6 +1071,15 @@ sub _upgrade return HEY_IT_WORKED; } +sub _shell + { + $logger->info( "Dropping into shell" ); + + CPAN::shell(); + + return HEY_IT_WORKED; + } + sub _load_config # -j { my $file = shift || ''; @@ -1102,14 +1138,17 @@ sub _download my %paths; - foreach my $module ( @$args ) - { - $logger->info( "Checking $module" ); - my $path = CPAN::Shell->expand( "Module", $module )->cpan_file; + foreach my $arg ( @$args ) { + $logger->info( "Checking $arg" ); + + my $module = _expand_module( $arg ) or next; + my $path = $module->cpan_file; $logger->debug( "Inst file would be $path\n" ); - $paths{$module} = _get_file( _make_path( $path ) ); + $paths{$arg} = _get_file( _make_path( $path ) ); + + $logger->info( "Downloaded [$arg] to [$paths{$module}]" ); } return \%paths; @@ -1149,16 +1188,14 @@ sub _gitify my $starting_dir = cwd(); - foreach my $module ( @$args ) + foreach my $arg ( @$args ) { - $logger->info( "Checking $module" ); - my $path = CPAN::Shell->expand( "Module", $module )->cpan_file; - - my $store_paths = _download( [ $module ] ); - $logger->debug( "gitify Store path is $store_paths->{$module}" ); - my $dirname = dirname( $store_paths->{$module} ); + $logger->info( "Checking $arg" ); + my $store_paths = _download( [ $arg ] ); + $logger->debug( "gitify Store path is $store_paths->{$arg}" ); + my $dirname = dirname( $store_paths->{$arg} ); - my $ae = Archive::Extract->new( archive => $store_paths->{$module} ); + my $ae = Archive::Extract->new( archive => $store_paths->{$arg} ); $ae->extract( to => $dirname ); chdir $ae->extract_path; @@ -1186,7 +1223,8 @@ sub _show_Changes { $logger->info( "Checking $arg\n" ); - my $module = eval { CPAN::Shell->expand( "Module", $arg ) }; + my $module = _expand_module( $arg ) or next; + my $out = _get_cpanpm_output(); next unless eval { $module->inst_file }; @@ -1233,7 +1271,8 @@ sub _show_Author foreach my $arg ( @$args ) { - my $module = CPAN::Shell->expand( "Module", $arg ); + my $module = _expand_module( $arg ) or next; + unless( $module ) { $logger->info( "Didn't find a $arg module, so no author!" ); @@ -1257,7 +1296,7 @@ sub _show_Details foreach my $arg ( @$args ) { - my $module = CPAN::Shell->expand( "Module", $arg ); + my $module = _expand_module( $arg ) or next; my $author = CPAN::Shell->expand( "Author", $module->userid ); next unless $module->userid; @@ -1279,14 +1318,23 @@ sub _show_Details return HEY_IT_WORKED; } +BEGIN { +my $modules; +sub _get_all_namespaces + { + return $modules if $modules; + $modules = [ map { $_->id } CPAN::Shell->expand( "Module", "/./" ) ]; + } +} + sub _show_out_of_date { - my @modules = CPAN::Shell->expand( "Module", "/./" ); + my $modules = _get_all_namespaces(); printf "%-40s %6s %6s\n", "Module Name", "Local", "CPAN"; print "-" x 73, "\n"; - foreach my $module ( @modules ) + foreach my $module ( @$modules ) { next unless $module->inst_file; next if $module->uptodate; @@ -1305,10 +1353,9 @@ sub _show_author_mods my %hash = map { lc $_, 1 } @$args; - my @modules = CPAN::Shell->expand( "Module", "/./" ); + my $modules = _get_all_namespaces(); - foreach my $module ( @modules ) - { + foreach my $module ( @$modules ) { next unless exists $hash{ lc $module->userid }; print $module->id, "\n"; } @@ -1428,6 +1475,107 @@ sub _path_to_module return $module_name; } + +sub _expand_module + { + my( $module ) = @_; + + my $expanded = CPAN::Shell->expand( "Module", $module ); + unless( defined $expanded ) { + $logger->error( "Could not expand [$module]. Check the module name." ); + my $threshold = ( + grep { int } + sort { length $a <=> length $b } + length($module)/4, 4 + )[0]; + + my $guesses = _guess_at_module_name( $module, $threshold ); + if( defined $guesses and @$guesses ) { + $logger->info( "Perhaps you meant one of these:" ); + foreach my $guess ( @$guesses ) { + $logger->info( "\t$guess" ); + } + } + return; + } + + return $expanded; + } + +my $guessers = [ + [ qw( Text::Levenshtein::XS distance 7 ) ], + [ qw( Text::Levenshtein::Damerau::XS xs_edistance 7 ) ], + + [ qw( Text::Levenshtein distance 7 ) ], + [ qw( Text::Levenshtein::Damerau::PP pp_edistance 7 ) ], + + ]; + +# for -x +sub _guess_namespace + { + my $args = shift; + + foreach my $arg ( @$args ) + { + $logger->debug( "Checking $arg" ); + my $guesses = _guess_at_module_name( $arg ); + + foreach my $guess ( @$guesses ) { + print $guess, "\n"; + } + } + + return HEY_IT_WORKED; + } + +sub _list_all_namespaces { + my $modules = _get_all_namespaces(); + + foreach my $module ( @$modules ) { + print $module, "\n"; + } + } + +BEGIN { +my $distance; +sub _guess_at_module_name + { + my( $target, $threshold ) = @_; + + unless( defined $distance ) { + foreach my $try ( @$guessers ) { + my $can_guess = eval "require $try->[0]; 1" or next; + + no strict 'refs'; + $distance = \&{ join "::", @$try[0,1] }; + $threshold ||= $try->[2]; + } + } + + unless( $distance ) { + my $modules = join ", ", map { $_->[0] } @$guessers; + substr $modules, rindex( $modules, ',' ), 1, ', and'; + + $logger->info( "I can suggest names if you install one of $modules" ); + return; + } + + my $modules = _get_all_namespaces(); + $logger->info( "Checking " . @$modules . " namespaces for close match suggestions" ); + + my %guesses; + foreach my $guess ( @$modules ) { + my $distance = $distance->( $target, $guess ); + next if $distance > $threshold; + $guesses{$guess} = $distance; + } + + my @guesses = sort { $guesses{$a} <=> $guesses{$b} } keys %guesses; + return [ grep { defined } @guesses[0..9] ]; + } +} + 1; =back @@ -1460,8 +1608,6 @@ report them to the user. * Check then exit -* no test option - =head1 BUGS * none noted @@ -1497,7 +1643,7 @@ brian d foy, C<< >> =head1 COPYRIGHT -Copyright (c) 2001-2014, brian d foy, All Rights Reserved. +Copyright (c) 2001-2015, brian d foy, All Rights Reserved. You may redistribute this under the same terms as Perl itself. diff --git a/cpan/CPAN/lib/CPAN.pm b/cpan/CPAN/lib/CPAN.pm index 6096916..ab2d00f 100644 --- a/cpan/CPAN/lib/CPAN.pm +++ b/cpan/CPAN/lib/CPAN.pm @@ -2,7 +2,7 @@ # vim: ts=4 sts=4 sw=4: use strict; package CPAN; -$CPAN::VERSION = '2.11'; +$CPAN::VERSION = '2.14'; $CPAN::VERSION =~ s/_//; # we need to run chdir all over and we would get at wrong libraries @@ -14,6 +14,7 @@ BEGIN { $inc = File::Spec->rel2abs($inc) unless ref $inc; } } + $SIG{WINCH} = 'IGNORE' if exists $SIG{WINCH}; } use CPAN::Author; use CPAN::HandleConfig; @@ -460,7 +461,7 @@ Enter 'h' for help. } for my $class (qw(Module Distribution)) { # again unsafe meta access? - for my $dm (keys %{$CPAN::META->{readwrite}{"CPAN::$class"}}) { + for my $dm (sort keys %{$CPAN::META->{readwrite}{"CPAN::$class"}}) { next unless $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor}; CPAN->debug("BUG: $class '$dm' was in command state, resetting"); delete $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor}; @@ -708,13 +709,14 @@ sub checklock { my $otherpid = <$fh>; my $otherhost = <$fh>; $fh->close; - if (defined $otherpid && $otherpid) { + if (defined $otherpid && length $otherpid) { chomp $otherpid; } - if (defined $otherhost && $otherhost) { + if (defined $otherhost && length $otherhost) { chomp $otherhost; } my $thishost = hostname(); + my $ask_if_degraded_wanted = 0; if (defined $otherhost && defined $thishost && $otherhost ne '' && $thishost ne '' && $otherhost ne $thishost) { @@ -732,31 +734,7 @@ There seems to be running another CPAN process (pid $otherpid). Contacting... }); if (kill 0, $otherpid or $!{EPERM}) { $CPAN::Frontend->mywarn(qq{Other job is running.\n}); - my($ans) = - CPAN::Shell::colorable_makemaker_prompt - (qq{Shall I try to run in downgraded }. - qq{mode? (Y/n)},"y"); - if ($ans =~ /^y/i) { - $CPAN::Frontend->mywarn("Running in downgraded mode (experimental). -Please report if something unexpected happens\n"); - $RUN_DEGRADED = 1; - for ($CPAN::Config) { - # XXX - # $_->{build_dir_reuse} = 0; # 2006-11-17 akoenig Why was that? - $_->{commandnumber_in_prompt} = 0; # visibility - $_->{histfile} = ""; # who should win otherwise? - $_->{cache_metadata} = 0; # better would be a lock? - $_->{use_sqlite} = 0; # better would be a write lock! - $_->{auto_commit} = 0; # we are violent, do not persist - $_->{test_report} = 0; # Oliver Paukstadt had sent wrong reports in degraded mode - } - } else { - $CPAN::Frontend->mydie(" -You may want to kill the other job and delete the lockfile. On UNIX try: - kill $otherpid - rm $lockfile -"); - } + $ask_if_degraded_wanted = 1; } elsif (-w $lockfile) { my($ans) = CPAN::Shell::colorable_makemaker_prompt @@ -773,10 +751,46 @@ You may want to kill the other job and delete the lockfile. On UNIX try: qq{ and then rerun us.\n} ); } + } elsif ($^O eq "MSWin32") { + $CPAN::Frontend->mywarn( + qq{ +There seems to be running another CPAN process according to '$lockfile'. +}); + $ask_if_degraded_wanted = 1; } else { $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Found invalid lockfile ". "'$lockfile', please remove. Cannot proceed.\n")); } + if ($ask_if_degraded_wanted) { + my($ans) = + CPAN::Shell::colorable_makemaker_prompt + (qq{Shall I try to run in downgraded }. + qq{mode? (Y/n)},"y"); + if ($ans =~ /^y/i) { + $CPAN::Frontend->mywarn("Running in downgraded mode (experimental). +Please report if something unexpected happens\n"); + $RUN_DEGRADED = 1; + for ($CPAN::Config) { + # XXX + # $_->{build_dir_reuse} = 0; # 2006-11-17 akoenig Why was that? + $_->{commandnumber_in_prompt} = 0; # visibility + $_->{histfile} = ""; # who should win otherwise? + $_->{cache_metadata} = 0; # better would be a lock? + $_->{use_sqlite} = 0; # better would be a write lock! + $_->{auto_commit} = 0; # we are violent, do not persist + $_->{test_report} = 0; # Oliver Paukstadt had sent wrong reports in degraded mode + } + } else { + my $msg = "You may want to kill the other job and delete the lockfile."; + if (defined $otherpid) { + $msg .= " Something like: + kill $otherpid + rm $lockfile +"; + } + $CPAN::Frontend->mydie("\n$msg"); + } + } } my $dotcpan = $CPAN::Config->{cpan_home}; eval { File::Path::mkpath($dotcpan);}; @@ -1352,8 +1366,8 @@ sub _list_sorted_descending_is_tested { keys %{$self->{is_tested}}; if ($foul) { $CPAN::Frontend->mywarn("Lost build_dir detected ($foul), giving up all cached test results of currently running session.\n"); - for my $dbd (keys %{$self->{is_tested}}) { # distro-build-dir - SEARCH: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) { + for my $dbd (sort keys %{$self->{is_tested}}) { # distro-build-dir + SEARCH: for my $d (sort { $a->id cmp $b->id } $CPAN::META->all_objects("CPAN::Distribution")) { if ($d->{build_dir} && $d->{build_dir} eq $dbd) { $CPAN::Frontend->mywarn(sprintf "Flushing cache for %s\n", $d->pretty_id); $d->fforce(""); @@ -1969,6 +1983,10 @@ the form Modulename=arg0,arg1,arg2,arg3,... +eg: + + CPAN::Plugin::Flurb=dir,/opt/pkgs/flurb/raw,verbose,1 + At run time, each listed plugin is instantiated as a singleton object by running the equivalent of this pseudo code: diff --git a/cpan/CPAN/lib/CPAN/Distribution.pm b/cpan/CPAN/lib/CPAN/Distribution.pm index 092b781..1ec84a7 100644 --- a/cpan/CPAN/lib/CPAN/Distribution.pm +++ b/cpan/CPAN/lib/CPAN/Distribution.pm @@ -8,7 +8,7 @@ use CPAN::InfoObj; use File::Path (); @CPAN::Distribution::ISA = qw(CPAN::InfoObj); use vars qw($VERSION); -$VERSION = "2.04"; +$VERSION = "2.12"; # no prepare, because prepare is not a command on the shell command line # TODO: clear instance cache on reload @@ -214,10 +214,10 @@ sub color_cmd_tmps { if (defined $prereq_pm) { # XXX also optional_req & optional_breq? -- xdg, 2012-04-01 # A: no, optional deps may recurse -- ak, 2014-05-07 - PREREQ: for my $pre ( + PREREQ: for my $pre (sort( keys %{$prereq_pm->{requires}||{}}, keys %{$prereq_pm->{build_requires}||{}}, - ) { + )) { next PREREQ if $pre eq "perl"; my $premo; unless ($premo = CPAN::Shell->expand("Module",$pre)) { @@ -251,7 +251,7 @@ sub as_string { #-> sub CPAN::Distribution::containsmods ; sub containsmods { my $self = shift; - return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS}; + return sort keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS}; my $dist_id = $self->{ID}; for my $mod ($CPAN::META->all_objects("CPAN::Module")) { my $mod_file = $mod->cpan_file or next; @@ -264,7 +264,7 @@ sub containsmods { } $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id; } - keys %{$self->{CONTAINSMODS}||={}}; + sort keys %{$self->{CONTAINSMODS}||={}}; } #-> sub CPAN::Distribution::upload_date ; @@ -517,105 +517,59 @@ See also http://rt.cpan.org/Ticket/Display.html?id=38932\n"); @readdir = grep { $_ ne "pax_global_header" } @readdir; } $dh->close; - my ($packagedir); - # XXX here we want in each branch File::Temp to protect all build_dir directories - if (CPAN->has_usable("File::Temp")) { - my $tdir_base; - my $from_dir; - my @dirents; - if (@readdir == 1 && -d $readdir[0]) { - $tdir_base = $readdir[0]; - $from_dir = File::Spec->catdir(File::Spec->curdir,$readdir[0]); - my $dh2; - unless ($dh2 = DirHandle->new($from_dir)) { - my($mode) = (stat $from_dir)[2]; - my $why = sprintf - ( - "Couldn't opendir '%s', mode '%o': %s", - $from_dir, - $mode, - $!, - ); - $CPAN::Frontend->mywarn("$why\n"); - $self->{writemakefile} = CPAN::Distrostatus->new("NO -- $why"); - return; - } - @dirents = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh2->read; ### MAC?? - } else { - my $userid = $self->cpan_userid; - CPAN->debug("userid[$userid]"); - if (!$userid or $userid eq "N/A") { - $userid = "anon"; - } - $tdir_base = $userid; - $from_dir = File::Spec->curdir; - @dirents = @readdir; + my $tdir_base; + my $from_dir; + my @dirents; + if (@readdir == 1 && -d $readdir[0]) { + $tdir_base = $readdir[0]; + $from_dir = File::Spec->catdir(File::Spec->curdir,$readdir[0]); + my $dh2; + unless ($dh2 = DirHandle->new($from_dir)) { + my($mode) = (stat $from_dir)[2]; + my $why = sprintf + ( + "Couldn't opendir '%s', mode '%o': %s", + $from_dir, + $mode, + $!, + ); + $CPAN::Frontend->mywarn("$why\n"); + $self->{writemakefile} = CPAN::Distrostatus->new("NO -- $why"); + return; } - eval { File::Path::mkpath $builddir; }; - if ($@) { - $CPAN::Frontend->mydie("Cannot create directory $builddir: $@"); + @dirents = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh2->read; ### MAC?? + } else { + my $userid = $self->cpan_userid; + CPAN->debug("userid[$userid]"); + if (!$userid or $userid eq "N/A") { + $userid = "anon"; } - $packagedir = File::Temp::tempdir( - "$tdir_base-XXXXXX", - DIR => $builddir, - CLEANUP => 0, - ); - chmod 0777 &~ umask, $packagedir; # may fail - my $f; - for $f (@dirents) { # is already without "." and ".." - my $from = File::Spec->catfile($from_dir,$f); - my $to = File::Spec->catfile($packagedir,$f); - unless (File::Copy::move($from,$to)) { - my $err = $!; - $from = File::Spec->rel2abs($from); - Carp::confess("Couldn't move $from to $to: $err"); - } + $tdir_base = $userid; + $from_dir = File::Spec->curdir; + @dirents = @readdir; + } + eval { File::Path::mkpath $builddir; }; + if ($@) { + $CPAN::Frontend->mydie("Cannot create directory $builddir: $@"); + } + my $packagedir; + my $eexist = $CPAN::META->has_usable("Errno") ? &Errno::EEXIST : undef; + for(my $suffix = 0; ; $suffix++) { + $packagedir = File::Spec->catdir($builddir, "$tdir_base-$suffix"); + my $parent = $builddir; + mkdir($packagedir, 0777) and last; + if((defined($eexist) && $! != $eexist) || $suffix == 999) { + $CPAN::Frontend->mydie("Cannot create directory $packagedir: $!\n"); } - } else { # older code below, still better than nothing when there is no File::Temp - my($distdir); - if (@readdir == 1 && -d $readdir[0]) { - $distdir = $readdir[0]; - $packagedir = File::Spec->catdir($builddir,$distdir); - $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]") - if $CPAN::DEBUG; - -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ". - "$packagedir\n"); - File::Path::rmtree($packagedir); - unless (File::Copy::move($distdir,$packagedir)) { - $CPAN::Frontend->unrecoverable_error(<debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]", - $distdir, - $packagedir, - -e $packagedir, - -d $packagedir, - )) if $CPAN::DEBUG; - } else { - my $userid = $self->cpan_userid; - CPAN->debug("userid[$userid]") if $CPAN::DEBUG; - if (!$userid or $userid eq "N/A") { - $userid = "anon"; - } - my $pragmatic_dir = $userid . '000'; - $pragmatic_dir =~ s/\W_//g; - $pragmatic_dir++ while -d "../$pragmatic_dir"; - $packagedir = File::Spec->catdir($builddir,$pragmatic_dir); - $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG; - File::Path::mkpath($packagedir); - my($f); - for $f (@readdir) { # is already without "." and ".." - my $to = File::Spec->catdir($packagedir,$f); - File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!"); - } + } + my $f; + for $f (@dirents) { # is already without "." and ".." + my $from = File::Spec->catfile($from_dir,$f); + my $to = File::Spec->catfile($packagedir,$f); + unless (File::Copy::move($from,$to)) { + my $err = $!; + $from = File::Spec->rel2abs($from); + $CPAN::Frontend->mydie("Couldn't move $from to $to: $err"); } } $self->{build_dir} = $packagedir; @@ -734,7 +688,7 @@ sub satisfy_configure_requires { return 1 unless @prereq; $self->debug(\@prereq) if $CPAN::DEBUG; if ($self->{configure_requires_later}) { - for my $k (keys %{$self->{configure_requires_later_for}||{}}) { + for my $k (sort keys %{$self->{configure_requires_later_for}||{}}) { if ($self->{configure_requires_later_for}{$k}>1) { my $type = ""; for my $p (@prereq) { @@ -2228,7 +2182,7 @@ is part of the perl-%s distribution. To install that, you need to run "system()\n"); } } - my $system_ok; + my ($system_ok, $system_err); if ($want_expect) { # XXX probably want to check _should_report here and # warn about not being able to use CPAN::Reporter with expect @@ -2240,7 +2194,9 @@ is part of the perl-%s distribution. To install that, you need to run $system_ok = ! $ret; } else { - $system_ok = system($system) == 0; + my $rc = system($system); + $system_ok = $rc == 0; + $system_err = $! if $rc == -1; } $self->introduce_myself; if ( $system_ok ) { @@ -2250,6 +2206,7 @@ is part of the perl-%s distribution. To install that, you need to run $self->{writemakefile} ||= CPAN::Distrostatus->new("YES"); $self->{make} = CPAN::Distrostatus->new("NO"); $CPAN::Frontend->mywarn(" $system -- NOT OK\n"); + $CPAN::Frontend->mywarn(" $system_err\n") if defined $system_err; } $self->store_persistent_state; @@ -2855,7 +2812,7 @@ sub unsat_prereq { $CPAN::META->has_usable("CPAN::Meta::Requirements") or die "CPAN::Meta::Requirements not available"; my $merged = CPAN::Meta::Requirements->from_string_hash($merged_hash); - my @merged = $merged->required_modules; + my @merged = sort $merged->required_modules; CPAN->debug("all merged_prereqs[@merged]") if $CPAN::DEBUG; NEED: for my $need_module ( @merged ) { my $need_version = $merged->requirements_for_module($need_module); @@ -3263,7 +3220,8 @@ sub prereq_pm { } my $areq; my $do_replace; - while (my($k,$v) = each %{$req||{}}) { + foreach my $k (sort keys %{$req||{}}) { + my $v = $req->{$k}; next unless defined $v; if ($v =~ /\d/) { $areq->{$k} = $v; @@ -3664,7 +3622,7 @@ sub _make_test_illuminate_prereqs { my @prereq; # local $CPAN::DEBUG = 16; # Distribution - for my $m (keys %{$self->{sponsored_mods}}) { + for my $m (sort keys %{$self->{sponsored_mods}}) { next unless $self->{sponsored_mods}{$m} > 0; my $m_obj = CPAN::Shell->expand("Module",$m) or next; # XXX we need available_version which reflects diff --git a/cpan/CPAN/lib/CPAN/FTP.pm b/cpan/CPAN/lib/CPAN/FTP.pm index 831f234..0c338c5 100644 --- a/cpan/CPAN/lib/CPAN/FTP.pm +++ b/cpan/CPAN/lib/CPAN/FTP.pm @@ -14,7 +14,7 @@ use vars qw($connect_to_internet_ok $Ua $Thesite $ThesiteURL $Themethod); use vars qw( $VERSION ); -$VERSION = "5.5006"; +$VERSION = "5.5007"; #-> sub CPAN::FTP::ftp_statistics # if they want to rewrite, they need to pass in a filehandle @@ -35,13 +35,19 @@ sub _ftp_statistics { while (!CPAN::_flock($fh, $locktype|LOCK_NB)) { $waitstart ||= localtime(); if ($sleep>3) { - $CPAN::Frontend->mywarn("Waiting for a read lock on '$file' (since $waitstart)\n"); + my $now = localtime(); + $CPAN::Frontend->mywarn("$now: waiting for read lock on '$file' (since $waitstart)\n"); } - $CPAN::Frontend->mysleep($sleep); + sleep($sleep); # this sleep must not be overridden; + # Frontend->mysleep with AUTOMATED_TESTING has + # provoked complete lock contention on my NFS if ($sleep <= 3) { $sleep+=0.33; - } elsif ($sleep <=6) { + } elsif ($sleep <= 6) { $sleep+=0.11; + } else { + # retry to get a fresh handle. If it is NFS and the handle is stale, we will never get an flock + open $fh, "+>>$file" or $CPAN::Frontend->mydie("Could not open '$file': $!"); } } my $stats = eval { CPAN->_yaml_loadfile($file); }; diff --git a/cpan/CPAN/lib/CPAN/FirstTime.pm b/cpan/CPAN/lib/CPAN/FirstTime.pm index 918e009..fb6b7eb 100644 --- a/cpan/CPAN/lib/CPAN/FirstTime.pm +++ b/cpan/CPAN/lib/CPAN/FirstTime.pm @@ -10,7 +10,7 @@ use File::Path (); use File::Spec (); use CPAN::Mirrors (); use vars qw($VERSION $auto_config); -$VERSION = "5.5307"; +$VERSION = "5.5309"; =head1 NAME @@ -775,7 +775,7 @@ sub init { } } elsif (0 == length $matcher) { } elsif (0 && $matcher eq "~") { # extremely buggy, but a nice idea - my @unconfigured = grep { not exists $CPAN::Config->{$_} + my @unconfigured = sort grep { not exists $CPAN::Config->{$_} or not defined $CPAN::Config->{$_} or not length $CPAN::Config->{$_} } keys %$CPAN::Config; @@ -1300,8 +1300,9 @@ sub init { $CPAN::Frontend->myprint("\nWriting $configpm for bootstrap...\n"); delete $CPAN::Config->{install_help}; # temporary only CPAN::HandleConfig->commit; - my $dist; - if ( $dist = CPAN::Shell->expand('Module', 'local::lib')->distribution ) { + my($dist, $locallib); + $locallib = CPAN::Shell->expand('Module', 'local::lib'); + if ( $locallib and $dist = $locallib->distribution ) { # this is a hack to force bootstrapping $dist->{prefs}{pl}{commandline} = "$^X Makefile.PL --bootstrap"; # Set @INC for this process so we find things as they bootstrap diff --git a/cpan/CPAN/lib/CPAN/HandleConfig.pm b/cpan/CPAN/lib/CPAN/HandleConfig.pm index e596cbc..bd28948 100644 --- a/cpan/CPAN/lib/CPAN/HandleConfig.pm +++ b/cpan/CPAN/lib/CPAN/HandleConfig.pm @@ -12,7 +12,7 @@ CPAN::HandleConfig - internal configuration handling for CPAN.pm =cut -$VERSION = "5.5006"; # see also CPAN::Config::VERSION at end of file +$VERSION = "5.5007"; # see also CPAN::Config::VERSION at end of file %can = ( commit => "Commit changes to disk", @@ -250,7 +250,7 @@ sub prettyprint { sprintf "\t%-18s => %s\n", "[$_]", defined $v->{$_} ? "[$v->{$_}]" : "undef" - } keys %$v; + } sort keys %$v; } $CPAN::Frontend->myprint( join( @@ -384,9 +384,9 @@ sub neatvalue { return join "", @m; } return "$v" unless $t eq 'HASH'; - my(@m, $key, $val); - while (($key,$val) = each %$v) { - last unless defined $key; # cautious programming in case (undef,undef) is true + my @m; + foreach my $key (sort keys %$v) { + my $val = $v->{$key}; push(@m,"q[$key]=>".$self->neatvalue($val)) ; } return "{ ".join(', ',@m)." }"; @@ -769,7 +769,7 @@ sub prefs_lookup { use strict; use vars qw($AUTOLOAD $VERSION); - $VERSION = "5.5006"; + $VERSION = "5.5007"; # formerly CPAN::HandleConfig was known as CPAN::Config sub AUTOLOAD { ## no critic diff --git a/cpan/CPAN/lib/CPAN/Index.pm b/cpan/CPAN/lib/CPAN/Index.pm index 8205d78..59e75dc 100644 --- a/cpan/CPAN/lib/CPAN/Index.pm +++ b/cpan/CPAN/lib/CPAN/Index.pm @@ -1,7 +1,7 @@ package CPAN::Index; use strict; use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03 $HAVE_REANIMATED $VERSION); -$VERSION = "1.9601"; +$VERSION = "2.12"; @CPAN::Index::ISA = qw(CPAN::Debug); $LAST_TIME ||= 0; $DATE_OF_03 ||= 0; @@ -528,7 +528,7 @@ sub rd_modlist { my $until = keys(%$ret); my $painted = 0; CPAN->debug(sprintf "until[%d]", $until) if $CPAN::DEBUG; - for (keys %$ret) { + for (sort keys %$ret) { my $obj = $CPAN::META->instance("CPAN::Module",$_); delete $ret->{$_}{modid}; # not needed here, maybe elsewhere $obj->set(%{$ret->{$_}}); diff --git a/cpan/CPAN/lib/CPAN/Mirrors.pm b/cpan/CPAN/lib/CPAN/Mirrors.pm index 37e7ce0..4ceca04 100644 --- a/cpan/CPAN/lib/CPAN/Mirrors.pm +++ b/cpan/CPAN/lib/CPAN/Mirrors.pm @@ -34,7 +34,7 @@ CPAN::Mirrors - Get CPAN mirror information and select a fast one package CPAN::Mirrors; use strict; use vars qw($VERSION $urllist $silent); -$VERSION = "1.9601"; +$VERSION = "2.12"; use Carp; use FileHandle; @@ -82,7 +82,7 @@ Return a list of continents based on those defined in F. sub continents { my ($self) = @_; - return keys %{$self->{geography}}; + return sort keys %{$self->{geography}}; } =item countries( [CONTINENTS] ) @@ -99,7 +99,7 @@ sub countries { @continents = $self->continents unless @continents; my @countries; for my $c (@continents) { - push @countries, keys %{ $self->{geography}{$c} }; + push @countries, sort keys %{ $self->{geography}{$c} }; } return @countries; } diff --git a/cpan/CPAN/lib/CPAN/Plugin.pm b/cpan/CPAN/lib/CPAN/Plugin.pm index 646d86b..77ad19b 100644 --- a/cpan/CPAN/lib/CPAN/Plugin.pm +++ b/cpan/CPAN/lib/CPAN/Plugin.pm @@ -3,7 +3,7 @@ package CPAN::Plugin; use strict; use warnings; -our $VERSION = '0.95'; +our $VERSION = '0.96'; require CPAN; @@ -94,8 +94,8 @@ CPAN::Plugin - Base class for CPAN shell extensions =head1 SYNOPSIS - package My::Plugin; - use base 'CPAN::Plugin'; + package CPAN::Plugin::Flurb; + use parent 'CPAN::Plugin'; sub post_test { my ($self, $distribution_object) = @_; diff --git a/cpan/CPAN/lib/CPAN/Shell.pm b/cpan/CPAN/lib/CPAN/Shell.pm index 43e2fb9..ab2f07e 100644 --- a/cpan/CPAN/lib/CPAN/Shell.pm +++ b/cpan/CPAN/lib/CPAN/Shell.pm @@ -47,7 +47,7 @@ use vars qw( "CPAN/Tarzip.pm", "CPAN/Version.pm", ); -$VERSION = "5.5005"; +$VERSION = "5.5006"; # record the initial timestamp for reload. $reload = { map {$INC{$_} ? ($_,(stat $INC{$_})[9]) : ()} @relo }; @CPAN::Shell::ISA = qw(CPAN::Debug); @@ -174,8 +174,8 @@ Download, Test, Make, Install... test make test (implies make) readme display these README files install make install (implies test) perldoc display POD documentation -Upgrade - r WORDs or /REGEXP/ or NONE report updates for some/matching/all modules +Upgrade installed modules + r WORDs or /REGEXP/ or NONE report updates for some/matching/all upgrade WORDs or /REGEXP/ or NONE upgrade some/matching/all modules Pragmas @@ -517,14 +517,14 @@ sub hosts { $s->{dltime} += $dltime; } my $res; - for my $url (keys %{$S{ok}}) { + for my $url (sort keys %{$S{ok}}) { next if $S{ok}{$url}{dltime} == 0; # div by zero push @{$res->{ok}}, [@{$S{ok}{$url}}{qw(n dlsize dltime)}, $S{ok}{$url}{dlsize}/$S{ok}{$url}{dltime}, $url, ]; } - for my $url (keys %{$S{no}}) { + for my $url (sort keys %{$S{no}}) { push @{$res->{no}}, [$S{no}{$url}, $url, ]; @@ -637,6 +637,10 @@ sub _reload_this { } CPAN->debug(sprintf("reload file[%s] content[%s...]",$file,substr($content,0,128))) if $CPAN::DEBUG; + my $includefile; + if ($includefile = $INC{$f} and -e $includefile) { + $f = $includefile; + } delete $INC{$f}; local @INC = @inc; eval "require '$f'"; @@ -1107,7 +1111,7 @@ sub failed { sub find_failed { my($self,$only_id) = @_; my @failed; - DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) { + DIST: for my $d (sort { $a->id cmp $b->id } $CPAN::META->all_objects("CPAN::Distribution")) { my $failed = ""; NAY: for my $nosayer ( # order matters! "unwrapped", diff --git a/cpan/CPAN/scripts/cpan b/cpan/CPAN/scripts/cpan index 5f4320e..5555090 100644 --- a/cpan/CPAN/scripts/cpan +++ b/cpan/CPAN/scripts/cpan @@ -3,8 +3,8 @@ use strict; use vars qw($VERSION); -use App::Cpan '1.60_02'; -$VERSION = '1.61'; +use App::Cpan '1.64'; +$VERSION = '1.64'; my $rc = App::Cpan->run( @ARGV ); @@ -21,7 +21,13 @@ cpan - easily interact with CPAN from the command line cpan module_name [ module_name ... ] # with switches, installs modules with extra behavior - cpan [-cfgimtTw] module_name [ module_name ... ] + cpan [-cfFimtTw] module_name [ module_name ... ] + + # use local::lib + cpan -I module_name [ module_name ... ] + + # one time mirror override for faster mirrors + cpan -p ... # with just the dot, install from the distribution in the # current directory @@ -30,20 +36,8 @@ cpan - easily interact with CPAN from the command line # without arguments, starts CPAN.pm shell cpan - # force install modules (usually those that fail tests) - cpan -f module_name [ module_name ... ] - - # install modules but without testing them - cpan -T module_name [ module_name ... ] - - # dump the configuration - cpan -J - - # load a different configuration to install Module::Foo - cpan -j some/other/file Module::Foo - # without arguments, but some switches - cpan [-ahrvACDlLO] + cpan [-ahpruvACDLOPX] =head1 DESCRIPTION @@ -73,7 +67,10 @@ Show the F files for the specified modules =item -D module [ module ... ] -Show the module details. +Show the module details. This prints one line for each out-of-date module +(meaning, modules locally installed but have newer versions on CPAN). +Each line has three columns: module name, local version, and CPAN +version. =item -f @@ -110,13 +107,15 @@ distribution. Print a help message and exit. When you specify C<-h>, it ignores all of the other options and arguments. -=item -i +=item -i module [ module ... ] -Install the specified modules. +Install the specified modules. With no other switches, this switch +is implied. =item -I -Load C (think like C<-I> for loading lib paths). +Load C (think like C<-I> for loading lib paths). Too bad +C<-l> was already taken. =item -j Config.pm @@ -142,23 +141,38 @@ List the modules by the specified authors. Make the specified modules. +=item -M mirror1,mirror2,... + +A comma-separated list of mirrors to use for just this run. The C<-P> +option can find them for you automatically. + +=item -n + +Do a dry run, but don't actually install anything. (unimplemented) + =item -O Show the out-of-date modules. =item -p -Ping the configured mirrors +Ping the configured mirrors and print a report =item -P -Find the best mirrors you could be using (but doesn't configure them just yet) +Find the best mirrors you could be using and use them for the current +session. =item -r Recompiles dynamically loaded modules with CPAN::Shell->recompile. -=item -t +=item -s + +Drop in the CPAN.pm shell. This command does this automatically if you don't +specify any arguments. + +=item -t module [ module ... ] Run a `make test` on the specified modules. @@ -186,6 +200,16 @@ UNIMPLEMENTED Turn on cpan warnings. This checks various things, like directory permissions, and tells you about problems you might have. +=item -x module [ module ... ] + +Find close matches to the named modules that you think you might have +mistyped. This requires the optional installation of Text::Levenshtein or +Text::Levenshtein::Damerau. + +=item -X + +Dump all the namespaces to standard output. + =back =head2 Examples @@ -211,9 +235,10 @@ and tells you about problems you might have. # force install modules ( must use -i ) cpan -fi CGI::Minimal URI -=head1 ENVIRONMENT VARIABLES + # install modules but without testing them + cpan -Ti CGI::Minimal URI -=over 4 +=head2 Environment variables There are several components in CPAN.pm that use environment variables. The build tools, L and L use some, @@ -226,11 +251,21 @@ Oslo Concensus: L sets this to C<1> unless it already +has a value (even if that value is false). + +=item PERL_MM_USE_DEFAULT + +Use the default answer for a prompted questions. C sets this +to C<1> unless it already has a value (even if that value is false). + =item CPAN_OPTS -C splits this variable on whitespace and prepends that list to C<@ARGV> -before it processes the command-line arguments. For instance, if you always -want to use C, you can set C to C<-I>. +As with C, a string of additional C options to +add to those you specify on the command line. =item CPANSCRIPT_LOGLEVEL @@ -244,19 +279,6 @@ C, and C. The default is C. The path to the C binary to use for the Git features. The default is C. -=item NONINTERACTIVE_TESTING - -Assume no one is paying attention and skips prompts for distributions -that do that correctly. C sets this to C<1> unless it already -has a value (even if that value is false). - -=item PERL_MM_USE_DEFAULT - -Use the default answer for a prompted questions. C sets this -to C<1> unless it already has a value (even if that value is false). - -=back - =back =head1 EXIT VALUES @@ -312,7 +334,7 @@ brian d foy, C<< >> =head1 COPYRIGHT -Copyright (c) 2001-2014, brian d foy, All Rights Reserved. +Copyright (c) 2001-2015, brian d foy, All Rights Reserved. You may redistribute this under the same terms as Perl itself. diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command.pm index ba79592..98395d2 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command.pm @@ -7,7 +7,7 @@ use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); @ISA = qw(Exporter); @EXPORT = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f test_d chmod dos2unix); -$VERSION = '7.10'; +$VERSION = '7.18'; $VERSION = eval $VERSION; my $Is_VMS = $^O eq 'VMS'; @@ -347,6 +347,7 @@ sub dos2unix { open ORIG, $_ or do { warn "dos2unix can't open $_: $!"; return }; open TEMP, ">$temp" or do { warn "dos2unix can't create .dos2unix_tmp: $!"; return }; + binmode ORIG; binmode TEMP; while (my $line = ) { $line =~ s/\015\012/\012/g; print TEMP $line; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm index 9184471..d9fbb5d 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm @@ -10,14 +10,20 @@ our @ISA = qw(Exporter); our @EXPORT = qw(test_harness pod2man perllocal_install uninstall warn_if_old_packlist test_s cp_nonempty); -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; my $Is_VMS = $^O eq 'VMS'; -eval { require Time::HiRes; die unless Time::HiRes->can("stat"); }; -*mtime = $@ ? - sub { [ stat($_[0])]->[9] } : - sub { [Time::HiRes::stat($_[0])]->[9] } ; +sub mtime { + no warnings 'redefine'; + local $@; + *mtime = (eval { require Time::HiRes } && defined &Time::HiRes::stat) + ? sub { (Time::HiRes::stat($_[0]))[9] } + : sub { ( stat($_[0]))[9] } + ; + goto &mtime; +} =head1 NAME @@ -213,8 +219,8 @@ sub perllocal_install { : @ARGV; my $pod; - $pod = sprintf < L<$name|$name> + $pod = sprintf <<'POD', scalar(localtime), $type, $name, $name; + =head2 %s: C<%s> L<%s|%s> =over 4 diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm index 3bb49d2..56fc355 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm @@ -2,7 +2,8 @@ package ExtUtils::Liblist; use strict; -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; use File::Spec; require ExtUtils::Liblist::Kid; @@ -16,9 +17,9 @@ sub ext { sub lsdir { shift; my $rex = qr/$_[1]/; - opendir DIR, $_[0]; - my @out = grep /$rex/, readdir DIR; - closedir DIR; + opendir my $dir_fh, $_[0]; + my @out = grep /$rex/, readdir $dir_fh; + closedir $dir_fh; return @out; } diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm index 43d554e..23708e2 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm @@ -11,7 +11,8 @@ use 5.006; use strict; use warnings; -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; use ExtUtils::MakeMaker::Config; use Cwd 'cwd'; @@ -337,7 +338,7 @@ sub _win32_ext { $libs_seen{$fullname} = 1 if $path; # why is this a special case? } - my @libs = keys %libs_seen; + my @libs = sort keys %libs_seen; return ( '', '', '', '', ( $give_libs ? \@libs : () ) ) unless @extralibs; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm index fa5f72c..0b2835c 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm @@ -3,7 +3,8 @@ package ExtUtils::MM; use strict; use ExtUtils::MakeMaker::Config; -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; require ExtUtils::Liblist; require ExtUtils::MakeMaker; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm index ec3a2fc..0db269b 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm @@ -1,14 +1,12 @@ package ExtUtils::MM_AIX; use strict; -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; require ExtUtils::MM_Unix; our @ISA = qw(ExtUtils::MM_Unix); -use ExtUtils::MakeMaker qw(neatvalue); - - =head1 NAME ExtUtils::MM_AIX - AIX specific subclass of ExtUtils::MM_Unix @@ -35,36 +33,26 @@ Define DL_FUNCS and DL_VARS and write the *.exp files. sub dlsyms { my($self,%attribs) = @_; + return '' unless $self->needs_linking; + my @m; + # these will need XSMULTI-fying but maybe that already happens + push @m,"\ndynamic :: $self->{BASEEXT}.exp\n\n" + unless $self->{SKIPHASH}{'dynamic'}; # dynamic and static are subs, so... + push @m,"\nstatic :: $self->{BASEEXT}.exp\n\n" + unless $self->{SKIPHASH}{'static'}; # we avoid a warning if we tick them + join "\n", @m, $self->xs_dlsyms_iterator(\%attribs); +} - return '' unless $self->needs_linking(); - - my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; - my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; - my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || []; - my(@m); - - push(@m," -dynamic :: $self->{BASEEXT}.exp - -") unless $self->{SKIPHASH}{'dynamic'}; # dynamic and static are subs, so... - - push(@m," -static :: $self->{BASEEXT}.exp +=head3 xs_dlsyms_ext -") unless $self->{SKIPHASH}{'static'}; # we avoid a warning if we tick them +On AIX, is C<.exp>. - push(@m," -$self->{BASEEXT}.exp: Makefile.PL -",' $(PERLRUN) -e \'use ExtUtils::Mksymlists; \\ - Mksymlists("NAME" => "',$self->{NAME},'", "DL_FUNCS" => ', - neatvalue($funcs), ', "FUNCLIST" => ', neatvalue($funclist), - ', "DL_VARS" => ', neatvalue($vars), ');\' -'); +=cut - join('',@m); +sub xs_dlsyms_ext { + '.exp'; } - =head1 AUTHOR Michael G Schwern with code from ExtUtils::MM_Unix diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm index 129ad9e..7320aee 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm @@ -1,7 +1,8 @@ package ExtUtils::MM_Any; use strict; -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; use Carp; use File::Spec; @@ -9,7 +10,7 @@ use File::Basename; BEGIN { our @ISA = qw(File::Spec); } # We need $Verbose -use ExtUtils::MakeMaker qw($Verbose); +use ExtUtils::MakeMaker qw($Verbose neatvalue _sprintf562); use ExtUtils::MakeMaker::Config; @@ -17,9 +18,10 @@ use ExtUtils::MakeMaker::Config; # So we don't have to keep calling the methods over and over again, # we have these globals to cache the values. Faster and shrtr. my $Curdir = __PACKAGE__->curdir; -my $Rootdir = __PACKAGE__->rootdir; -my $Updir = __PACKAGE__->updir; +#my $Updir = __PACKAGE__->updir; +my $METASPEC_URL = 'https://metacpan.org/pod/CPAN::Meta::Spec'; +my $METASPEC_V = 2; =head1 NAME @@ -348,6 +350,34 @@ sub _expand_macros { } +=head3 make_type + +Returns a suitable string describing the type of makefile being written. + +=cut + +# override if this isn't suitable! +sub make_type { return 'Unix-style'; } + + +=head3 stashmeta + + my @recipelines = $MM->stashmeta($text, $file); + +Generates a set of C<@recipelines> which will result in the literal +C<$text> ending up in literal C<$file> when the recipe is executed. Call +it once, with all the text you want in C<$file>. Make macros will not +be expanded, so the locations will be fixed at configure-time, not +at build-time. + +=cut + +sub stashmeta { + my($self, $text, $file) = @_; + $self->echo($text, $file, { allow_variables => 0, append => 0 }); +} + + =head3 echo my @commands = $MM->echo($text); @@ -367,7 +397,7 @@ all C<$>. Example of use: - my $make = map "\t$_\n", $MM->echo($text, $file); + my $make = join '', map "\t$_\n", $MM->echo($text, $file); =cut @@ -480,13 +510,14 @@ Usage might be something like: $oneliner = $MM->oneliner('print "Foo\n"'); $make = '$oneliner > somefile'; -All dollar signs must be doubled in the $perl_code if you expect them -to be interpreted normally, otherwise it will be considered a make -macro. Also remember to quote make macros else it might be used as a -bareword. For example: +Dollar signs in the $perl_code will be protected from make using the +C method, unless they are recognised as being a make +variable, C<$(varname)>, in which case they will be left for make +to expand. Remember to quote make macros else it might be used as a +bareword. For example: # Assign the value of the $(VERSION_FROM) make macro to $vf. - $oneliner = $MM->oneliner('$$vf = "$(VERSION_FROM)"'); + $oneliner = $MM->oneliner('$vf = "$(VERSION_FROM)"'); Its currently very simple and may be expanded sometime in the figure to include more flexible code and switches. @@ -620,6 +651,11 @@ The blibdirs.ts target is deprecated. Depend on blibdirs instead. =cut +sub _xs_list_basenames { + my ($self) = @_; + map { (my $b = $_) =~ s/\.xs$//; $b } sort keys %{ $self->{XS} }; +} + sub blibdirs_target { my $self = shift; @@ -628,6 +664,14 @@ sub blibdirs_target { bin script man1dir man3dir ); + if ($self->{XSMULTI}) { + for my $ext ($self->_xs_list_basenames) { + my ($v, $d, $f) = File::Spec->splitpath($ext); + my @d = File::Spec->splitdir($d); + shift @d if $d[0] eq 'lib'; + push @dirs, $self->catdir('$(INST_ARCHLIB)', 'auto', @d, $f); + } + } my @exists = map { $_.'$(DFSEP).exists' } @dirs; @@ -666,6 +710,10 @@ clean :: clean_subdirs '); my @files = sort values %{$self->{XS}}; # .c files from *.xs files + push @files, map { + my $file = $_; + map { $file.$_ } $self->{OBJ_EXT}, qw(.def _def.old .bs .bso .exp .base); + } $self->_xs_list_basenames; my @dirs = qw(blib); # Normally these are all under blib but they might have been @@ -862,6 +910,110 @@ MAKE_FRAG } +=head3 xs_dlsyms_ext + +Returns file-extension for C method's output file, +including any "." character. + +=cut + +sub xs_dlsyms_ext { + die "Pure virtual method"; +} + +=head3 xs_dlsyms_extra + +Returns any extra text to be prepended to the C<$extra> argument of +C. + +=cut + +sub xs_dlsyms_extra { + ''; +} + +=head3 xs_dlsyms_iterator + +Iterates over necessary shared objects, calling C method +for each with appropriate arguments. + +=cut + +sub xs_dlsyms_iterator { + my ($self, $attribs) = @_; + if ($self->{XSMULTI}) { + my @m; + for my $ext ($self->_xs_list_basenames) { + my @parts = File::Spec->splitdir($ext); + shift @parts if $parts[0] eq 'lib'; + my $name = join '::', @parts; + push @m, $self->xs_make_dlsyms( + $attribs, + $ext . $self->xs_dlsyms_ext, + "$ext.xs", + $name, + $parts[-1], + {}, [], {}, [], + $self->xs_dlsyms_extra . q!, 'FILE' => ! . neatvalue($ext), + ); + } + return join "\n", @m; + } else { + return $self->xs_make_dlsyms( + $attribs, + $self->{BASEEXT} . $self->xs_dlsyms_ext, + 'Makefile.PL', + $self->{NAME}, + $self->{DLBASE}, + $attribs->{DL_FUNCS} || $self->{DL_FUNCS} || {}, + $attribs->{FUNCLIST} || $self->{FUNCLIST} || [], + $attribs->{IMPORTS} || $self->{IMPORTS} || {}, + $attribs->{DL_VARS} || $self->{DL_VARS} || [], + $self->xs_dlsyms_extra, + ); + } +} + +=head3 xs_make_dlsyms + + $self->xs_make_dlsyms( + \%attribs, # hashref from %attribs in caller + "$self->{BASEEXT}.def", # output file for Makefile target + 'Makefile.PL', # dependency + $self->{NAME}, # shared object's "name" + $self->{DLBASE}, # last ::-separated part of name + $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}, # various params + $attribs{FUNCLIST} || $self->{FUNCLIST} || [], + $attribs{IMPORTS} || $self->{IMPORTS} || {}, + $attribs{DL_VARS} || $self->{DL_VARS} || [], + # optional extra param that will be added as param to Mksymlists + ); + +Utility method that returns Makefile snippet to call C. + +=cut + +sub xs_make_dlsyms { + my ($self, $attribs, $target, $dep, $name, $dlbase, $funcs, $funclist, $imports, $vars, $extra) = @_; + my @m = ( + "\n$target: $dep\n", + q! $(PERLRUN) -MExtUtils::Mksymlists \\ + -e "Mksymlists('NAME'=>\"!, $name, + q!\", 'DLBASE' => '!,$dlbase, + # The above two lines quoted differently to work around + # a bug in the 4DOS/4NT command line interpreter. The visible + # result of the bug was files named q('extension_name',) *with the + # single quotes and the comma* in the extension build directories. + q!', 'DL_FUNCS' => !,neatvalue($funcs), + q!, 'FUNCLIST' => !,neatvalue($funclist), + q!, 'IMPORTS' => !,neatvalue($imports), + q!, 'DL_VARS' => !, neatvalue($vars) + ); + push @m, $extra if defined $extra; + push @m, qq!);"\n!; + join '', @m; +} + =head3 dynamic (o) Defines the dynamic target. @@ -873,7 +1025,7 @@ sub dynamic { my($self) = shift; ' -dynamic :: $(FIRST_MAKEFILE) $(BOOTSTRAP) $(INST_DYNAMIC) +dynamic :: $(FIRST_MAKEFILE) config $(INST_BOOT) $(INST_DYNAMIC) $(NOECHO) $(NOOP) '; } @@ -921,14 +1073,14 @@ sub manifypods_target { } my $manify = <{"MAN${section}PODS"}; - my $p2m = sprintf < 5.008 ? " -u" : ""; - \$(NOECHO) \$(POD2MAN) --section=$section --perm_rw=\$(PERM_RW)%s + my $p2m = sprintf <<'CMD', $section, $] > 5.008 ? " -u" : ""; + $(NOECHO) $(POD2MAN) --section=%s --perm_rw=$(PERM_RW)%s CMD push @man_cmds, $self->split_command($p2m, map {($_,$pods->{$_})} sort keys %$pods); } @@ -939,12 +1091,16 @@ CMD return $manify; } -sub _has_cpan_meta { - return eval { - require CPAN::Meta; - CPAN::Meta->VERSION(2.112150); - 1; - }; +{ + my $has_cpan_meta; + sub _has_cpan_meta { + return $has_cpan_meta if defined $has_cpan_meta; + return $has_cpan_meta = !!eval { + require CPAN::Meta; + CPAN::Meta->VERSION(2.112150); + 1; + }; + } } =head3 metafile_target @@ -966,34 +1122,18 @@ metafile : $(NOECHO) $(NOOP) MAKE_FRAG - my %metadata = $self->metafile_data( + my $metadata = $self->metafile_data( $self->{META_ADD} || {}, $self->{META_MERGE} || {}, ); - _fix_metadata_before_conversion( \%metadata ); - - # paper over validation issues, but still complain, necessary because - # there's no guarantee that the above will fix ALL errors - my $meta = eval { CPAN::Meta->create( \%metadata, { lazy_validation => 1 } ) }; - warn $@ if $@ and - $@ !~ /encountered CODE.*, but JSON can only represent references to arrays or hashes/; + my $meta = $self->_fix_metadata_before_conversion( $metadata ); - # use the original metadata straight if the conversion failed - # or if it can't be stringified. - if( !$meta || - !eval { $meta->as_string( { version => "1.4" } ) } || - !eval { $meta->as_string } - ) - { - $meta = bless \%metadata, 'CPAN::Meta'; - } - - my @write_metayml = $self->echo( + my @write_metayml = $self->stashmeta( $meta->as_string({version => "1.4"}), 'META_new.yml' ); - my @write_metajson = $self->echo( - $meta->as_string(), 'META_new.json' + my @write_metajson = $self->stashmeta( + $meta->as_string({version => "2.0"}), 'META_new.json' ); my $metayml = join("\n\t", @write_metayml); @@ -1014,7 +1154,7 @@ MAKE_FRAG =head3 _fix_metadata_before_conversion - _fix_metadata_before_conversion( \%metadata ); + $mm->_fix_metadata_before_conversion( \%metadata ); Fixes errors in the metadata before it's handed off to CPAN::Meta for conversion. This hopefully results in something that can be used further @@ -1025,7 +1165,7 @@ on, no guarantee is made though. =cut sub _fix_metadata_before_conversion { - my ( $metadata ) = @_; + my ( $self, $metadata ) = @_; # we should never be called unless this already passed but # prefer to be defensive in case somebody else calls this @@ -1034,18 +1174,24 @@ sub _fix_metadata_before_conversion { my $bad_version = $metadata->{version} && !CPAN::Meta::Validator->new->version( 'version', $metadata->{version} ); - # just delete all invalid versions if( $bad_version ) { warn "Can't parse version '$metadata->{version}'\n"; $metadata->{version} = ''; } - my $validator = CPAN::Meta::Validator->new( $metadata ); - return if $validator->is_valid; - + my $validator2 = CPAN::Meta::Validator->new( $metadata ); + my @errors; + push @errors, $validator2->errors if !$validator2->is_valid; + my $validator14 = CPAN::Meta::Validator->new( + { + %$metadata, + 'meta-spec' => { version => 1.4 }, + } + ); + push @errors, $validator14->errors if !$validator14->is_valid; # fix non-camelcase custom resource keys (only other trick we know) - for my $error ( $validator->errors ) { + for my $error ( @errors ) { my ( $key ) = ( $error =~ /Custom resource '(.*)' must be in CamelCase./ ); next if !$key; @@ -1053,17 +1199,39 @@ sub _fix_metadata_before_conversion { ( my $new_key = $key ) =~ s/[^_a-zA-Z]//g; # if that doesn't work, uppercase first one - $new_key = ucfirst $new_key if !$validator->custom_1( $new_key ); + $new_key = ucfirst $new_key if !$validator14->custom_1( $new_key ); # copy to new key if that worked $metadata->{resources}{$new_key} = $metadata->{resources}{$key} - if $validator->custom_1( $new_key ); + if $validator14->custom_1( $new_key ); # and delete old one in any case delete $metadata->{resources}{$key}; } - return; + # paper over validation issues, but still complain, necessary because + # there's no guarantee that the above will fix ALL errors + my $meta = eval { CPAN::Meta->create( $metadata, { lazy_validation => 1 } ) }; + warn $@ if $@ and + $@ !~ /encountered CODE.*, but JSON can only represent references to arrays or hashes/; + + # use the original metadata straight if the conversion failed + # or if it can't be stringified. + if( !$meta || + !eval { $meta->as_string( { version => $METASPEC_V } ) } || + !eval { $meta->as_string } + ) { + $meta = bless $metadata, 'CPAN::Meta'; + } + + my $now_license = $meta->as_struct({ version => 2 })->{license}; + if ($self->{LICENSE} and $self->{LICENSE} ne 'unknown' and + @{$now_license} == 1 and $now_license->[0] eq 'unknown' + ) { + warn "Invalid LICENSE value '$self->{LICENSE}' ignored\n"; + } + + $meta; } @@ -1104,10 +1272,10 @@ sub _hash_merge { =head3 metafile_data - my @metadata_pairs = $mm->metafile_data(\%meta_add, \%meta_merge); + my $metadata_hashref = $mm->metafile_data(\%meta_add, \%meta_merge); Returns the data which MakeMaker turns into the META.yml file -and the META.json file. +and the META.json file. It is always in version 2.0 of the format. Values of %meta_add will overwrite any existing metadata in those keys. %meta_merge will be merged with them. @@ -1118,48 +1286,59 @@ sub metafile_data { my $self = shift; my($meta_add, $meta_merge) = @_; + $meta_add ||= {}; + $meta_merge ||= {}; + + my $version = _normalize_version($self->{VERSION}); + my $release_status = ($version =~ /_/) ? 'unstable' : 'stable'; my %meta = ( # required - name => $self->{DISTNAME}, - version => _normalize_version($self->{VERSION}), abstract => $self->{ABSTRACT} || 'unknown', - license => $self->{LICENSE} || 'unknown', + author => defined($self->{AUTHOR}) ? $self->{AUTHOR} : ['unknown'], dynamic_config => 1, - - # optional - distribution_type => $self->{PM} ? 'module' : 'script', - - no_index => { - directory => [qw(t inc)] - }, - generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION", + license => [ $self->{LICENSE} || 'unknown' ], 'meta-spec' => { - url => 'http://module-build.sourceforge.net/META-spec-v1.4.html', - version => 1.4 + url => $METASPEC_URL, + version => $METASPEC_V, }, + name => $self->{DISTNAME}, + release_status => $release_status, + version => $version, + + # optional + no_index => { directory => [qw(t inc)] }, ); + $self->_add_requirements_to_meta(\%meta); - # The author key is required and it takes a list. - $meta{author} = defined $self->{AUTHOR} ? $self->{AUTHOR} : []; + if (!eval { require JSON::PP; require CPAN::Meta::Converter; CPAN::Meta::Converter->VERSION(2.141170) }) { + return \%meta; + } - { - my $vers = _metaspec_version( $meta_add, $meta_merge ); - my $method = $vers =~ m!^2! - ? '_add_requirements_to_meta_v2' - : '_add_requirements_to_meta_v1_4'; - %meta = $self->$method( %meta ); + # needs to be based on the original version + my $v1_add = _metaspec_version($meta_add) !~ /^2/; + + for my $frag ($meta_add, $meta_merge) { + $frag = CPAN::Meta::Converter->new($frag, default_version => "1.4")->upgrade_fragment; } + # if we upgraded a 1.x _ADD fragment, we gave it a prereqs key that + # will override all prereqs, which is more than the user asked for; + # instead, we'll go inside the prereqs and override all those while( my($key, $val) = each %$meta_add ) { - $meta{$key} = $val; + if ($v1_add and $key eq 'prereqs') { + $meta{$key}{$_} = $val->{$_} for keys %$val; + } elsif ($key ne 'meta-spec') { + $meta{$key} = $val; + } } while( my($key, $val) = each %$meta_merge ) { + next if $key eq 'meta-spec'; $self->_hash_merge(\%meta, $key, $val); } - return %meta; + return \%meta; } @@ -1167,84 +1346,61 @@ sub metafile_data { =cut +sub _add_requirements_to_meta { + my ( $self, $meta ) = @_; + # Check the original args so we can tell between the user setting it + # to an empty hash and it just being initialized. + $meta->{prereqs}{configure}{requires} = $self->{ARGS}{CONFIGURE_REQUIRES} + ? $self->{CONFIGURE_REQUIRES} + : { 'ExtUtils::MakeMaker' => 0, }; + $meta->{prereqs}{build}{requires} = $self->{ARGS}{BUILD_REQUIRES} + ? $self->{BUILD_REQUIRES} + : { 'ExtUtils::MakeMaker' => 0, }; + $meta->{prereqs}{test}{requires} = $self->{TEST_REQUIRES} + if $self->{ARGS}{TEST_REQUIRES}; + $meta->{prereqs}{runtime}{requires} = $self->{PREREQ_PM} + if $self->{ARGS}{PREREQ_PM}; + $meta->{prereqs}{runtime}{requires}{perl} = _normalize_version($self->{MIN_PERL_VERSION}) + if $self->{MIN_PERL_VERSION}; +} + +# spec version of given fragment - if not given, assume 1.4 sub _metaspec_version { - my ( $meta_add, $meta_merge ) = @_; - return $meta_add->{'meta-spec'}->{version} - if defined $meta_add->{'meta-spec'} - and defined $meta_add->{'meta-spec'}->{version}; - return $meta_merge->{'meta-spec'}->{version} - if defined $meta_merge->{'meta-spec'} - and defined $meta_merge->{'meta-spec'}->{version}; + my ( $meta ) = @_; + return $meta->{'meta-spec'}->{version} + if defined $meta->{'meta-spec'} + and defined $meta->{'meta-spec'}->{version}; return '1.4'; } sub _add_requirements_to_meta_v1_4 { - my ( $self, %meta ) = @_; - + my ( $self, $meta ) = @_; # Check the original args so we can tell between the user setting it # to an empty hash and it just being initialized. if( $self->{ARGS}{CONFIGURE_REQUIRES} ) { - $meta{configure_requires} = $self->{CONFIGURE_REQUIRES}; + $meta->{configure_requires} = $self->{CONFIGURE_REQUIRES}; } else { - $meta{configure_requires} = { + $meta->{configure_requires} = { 'ExtUtils::MakeMaker' => 0, }; } - if( $self->{ARGS}{BUILD_REQUIRES} ) { - $meta{build_requires} = $self->{BUILD_REQUIRES}; + $meta->{build_requires} = $self->{BUILD_REQUIRES}; } else { - $meta{build_requires} = { + $meta->{build_requires} = { 'ExtUtils::MakeMaker' => 0, }; } - if( $self->{ARGS}{TEST_REQUIRES} ) { - $meta{build_requires} = { - %{ $meta{build_requires} }, + $meta->{build_requires} = { + %{ $meta->{build_requires} }, %{ $self->{TEST_REQUIRES} }, }; } - - $meta{requires} = $self->{PREREQ_PM} + $meta->{requires} = $self->{PREREQ_PM} if defined $self->{PREREQ_PM}; - $meta{requires}{perl} = _normalize_version($self->{MIN_PERL_VERSION}) + $meta->{requires}{perl} = _normalize_version($self->{MIN_PERL_VERSION}) if $self->{MIN_PERL_VERSION}; - - return %meta; -} - -sub _add_requirements_to_meta_v2 { - my ( $self, %meta ) = @_; - - # Check the original args so we can tell between the user setting it - # to an empty hash and it just being initialized. - if( $self->{ARGS}{CONFIGURE_REQUIRES} ) { - $meta{prereqs}{configure}{requires} = $self->{CONFIGURE_REQUIRES}; - } else { - $meta{prereqs}{configure}{requires} = { - 'ExtUtils::MakeMaker' => 0, - }; - } - - if( $self->{ARGS}{BUILD_REQUIRES} ) { - $meta{prereqs}{build}{requires} = $self->{BUILD_REQUIRES}; - } else { - $meta{prereqs}{build}{requires} = { - 'ExtUtils::MakeMaker' => 0, - }; - } - - if( $self->{ARGS}{TEST_REQUIRES} ) { - $meta{prereqs}{test}{requires} = $self->{TEST_REQUIRES}; - } - - $meta{prereqs}{runtime}{requires} = $self->{PREREQ_PM} - if $self->{ARGS}{PREREQ_PM}; - $meta{prereqs}{runtime}{requires}{perl} = _normalize_version($self->{MIN_PERL_VERSION}) - if $self->{MIN_PERL_VERSION}; - - return %meta; } # Adapted from Module::Build::Base @@ -1253,7 +1409,7 @@ sub _normalize_version { $version = 0 unless defined $version; if ( ref $version eq 'version' ) { # version objects - $version = $version->is_qv ? $version->normal : $version->stringify; + $version = $version->stringify; } elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots # normalize string tuples without "v": "1.2.3" -> "v1.2.3" @@ -1426,12 +1582,12 @@ sub distmeta_target { $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd']), exit unless -e q{META.yml}; eval { maniadd({q{META.yml} => q{Module YAML meta-data (added by MakeMaker)}}) } - or print "Could not add META.yml to MANIFEST: $${'@'}\n" + or die "Could not add META.yml to MANIFEST: ${'@'}" CODE $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd']) exit unless -f q{META.json}; eval { maniadd({q{META.json} => q{Module JSON meta-data (added by MakeMaker)}}) } - or print "Could not add META.json to MANIFEST: $${'@'}\n" + or die "Could not add META.json to MANIFEST: ${'@'}" CODE ); @@ -1464,21 +1620,15 @@ sub mymeta { my $v2 = 1; unless ( $mymeta ) { - my @metadata = $self->metafile_data( + $mymeta = $self->metafile_data( $self->{META_ADD} || {}, $self->{META_MERGE} || {}, ); - $mymeta = {@metadata}; $v2 = 0; } # Overwrite the non-configure dependency hashes - - my $method = $v2 - ? '_add_requirements_to_meta_v2' - : '_add_requirements_to_meta_v1_4'; - - $mymeta = { $self->$method( %$mymeta ) }; + $self->_add_requirements_to_meta($mymeta); $mymeta->{dynamic_config} = 0; @@ -1530,13 +1680,9 @@ sub write_mymeta { return unless _has_cpan_meta(); - _fix_metadata_before_conversion( $mymeta ); + my $meta_obj = $self->_fix_metadata_before_conversion( $mymeta ); - # this can still blow up - # not sure if i should just eval this and skip file creation if it - # blows up - my $meta_obj = CPAN::Meta->new( $mymeta, { lazy_validation => 1 } ); - $meta_obj->save( 'MYMETA.json' ); + $meta_obj->save( 'MYMETA.json', { version => "2.0" } ); $meta_obj->save( 'MYMETA.yml', { version => "1.4" } ); return 1; } @@ -1574,8 +1720,8 @@ sub realclean { } # Occasionally files are repeated several times from different sources - { my(%f) = map { ($_ => 1) } @files; @files = keys %f; } - { my(%d) = map { ($_ => 1) } @dirs; @dirs = keys %d; } + { my(%f) = map { ($_ => 1) } @files; @files = sort keys %f; } + { my(%d) = map { ($_ => 1) } @dirs; @dirs = sort keys %d; } my $rm_cmd = join "\n\t", map { "$_" } $self->split_command('- $(RM_F)', @files); @@ -1584,7 +1730,7 @@ sub realclean { my $m = sprintf <<'MAKE', $rm_cmd, $rmf_cmd; # Delete temporary files (via clean) and also delete dist files -realclean purge :: clean realclean_subdirs +realclean purge :: realclean_subdirs %s %s MAKE @@ -1606,28 +1752,20 @@ target to call realclean on any subdirectories which contain Makefiles. sub realclean_subdirs_target { my $self = shift; - - return <<'NOOP_FRAG' unless @{$self->{DIR}}; -realclean_subdirs : - $(NOECHO) $(NOOP) -NOOP_FRAG - - my $rclean = "realclean_subdirs :\n"; - + my @m = <<'EOF'; +# so clean is forced to complete before realclean_subdirs runs +realclean_subdirs : clean +EOF + return join '', @m, "\t\$(NOECHO) \$(NOOP)\n" unless @{$self->{DIR}}; foreach my $dir (@{$self->{DIR}}) { foreach my $makefile ('$(MAKEFILE_OLD)', '$(FIRST_MAKEFILE)' ) { - my $subrclean .= $self->oneliner(sprintf <<'CODE', $dir, ($makefile) x 2); -chdir '%s'; system '$(MAKE) $(USEMAKEFILE) %s realclean' if -f '%s'; + my $subrclean .= $self->oneliner(_sprintf562 <<'CODE', $dir, $makefile); +chdir '%1$s'; system '$(MAKE) $(USEMAKEFILE) %2$s realclean' if -f '%2$s'; CODE - - $rclean .= sprintf <<'RCLEAN', $subrclean; - - %s -RCLEAN - + push @m, "\t- $subrclean\n"; } } - - return $rclean; + return join '', @m; } @@ -1666,7 +1804,7 @@ sub distsignature_target { my $add_sign = $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd']); eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } - or print "Could not add SIGNATURE to MANIFEST: $${'@'}\n" + or die "Could not add SIGNATURE to MANIFEST: ${'@'}" CODE my $sign_dist = $self->cd('$(DISTVNAME)' => 'cpansign -s'); @@ -1700,7 +1838,7 @@ sub special_targets { my $make_frag = <<'MAKE_FRAG'; .SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT) -.PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir +.PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir pure_all subdirs clean_subdirs makemakerdflt manifypods realclean_subdirs subdirs_dynamic subdirs_pure_nolink subdirs_static subdirs-test_dynamic subdirs-test_static test_dynamic test_static MAKE_FRAG @@ -2291,7 +2429,7 @@ sub init_others { if ( $self->{OBJECT} ) { $self->{OBJECT} = join(" ", @{$self->{OBJECT}}) if ref $self->{OBJECT}; $self->{OBJECT} =~ s!\.o(bj)?\b!\$(OBJ_EXT)!g; - } elsif ( $self->{MAGICXS} && @{$self->{O_FILES}||[]} ) { + } elsif ( ($self->{MAGICXS} || $self->{XSMULTI}) && @{$self->{O_FILES}||[]} ) { $self->{OBJECT} = join(" ", @{$self->{O_FILES}}); $self->{OBJECT} =~ s!\.o(bj)?\b!\$(OBJ_EXT)!g; } else { @@ -2659,38 +2797,50 @@ sub find_tests { my $tests = $mm->find_tests_recursive; Returns a string suitable for feeding to the shell to return all -tests in t/ but recursively. +tests in t/ but recursively. Equivalent to + + my $tests = $mm->find_tests_recursive_in('t'); =cut sub find_tests_recursive { - my($self) = shift; - return '' unless -d 't'; + my $self = shift; + return $self->find_tests_recursive_in('t'); +} + +=head3 find_tests_recursive_in + + my $tests = $mm->find_tests_recursive_in($dir); + +Returns a string suitable for feeding to the shell to return all +tests in $dir recursively. + +=cut + +sub find_tests_recursive_in { + my($self, $dir) = @_; + return '' unless -d $dir; require File::Find; - my %testfiles; + my $base_depth = grep { $_ ne '' } File::Spec->splitdir( (File::Spec->splitpath($dir))[1] ); + my %depths; my $wanted = sub { return unless m!\.t$!; my ($volume,$directories,$file) = File::Spec->splitpath( $File::Find::name ); - my @dirs = File::Spec->splitdir( $directories ); - for ( @dirs ) { - next if $_ eq 't'; - unless ( $_ ) { - $_ = '*.t'; - next; - } - $_ = '*'; - } - my $testfile = join '/', @dirs; - $testfiles{ $testfile } = 1; + my $depth = grep { $_ ne '' } File::Spec->splitdir( $directories ); + $depth -= $base_depth; + $depths{ $depth } = 1; }; - File::Find::find( $wanted, 't' ); + File::Find::find( $wanted, $dir ); - return join ' ', sort keys %testfiles; + return join ' ', + map { $dir . '/*' x $_ . '.t' } + sort { $a <=> $b } + keys %depths; } =head3 extra_clean_files @@ -2764,6 +2914,39 @@ sub platform_constants { return ''; } +=head3 post_constants (o) + +Returns an empty string per default. Dedicated to overrides from +within Makefile.PL after all constants have been defined. + +=cut + +sub post_constants { + ""; +} + +=head3 post_initialize (o) + +Returns an empty string per default. Used in Makefile.PLs to add some +chunk of text to the Makefile after the object is initialized. + +=cut + +sub post_initialize { + ""; +} + +=head3 postamble (o) + +Returns an empty string. Can be used in Makefile.PLs to write some +text to the Makefile at the end. + +=cut + +sub postamble { + ""; +} + =begin private =head3 _PREREQ_PRINT @@ -2799,7 +2982,7 @@ sub _PREREQ_PRINT { Implements PRINT_PREREQ, a slightly different version of PREREQ_PRINT added by Redhat to, I think, support generating RPMs from Perl modules. -Should not include BUILD_REQUIRES as RPMs do not incluide them. +Should not include BUILD_REQUIRES as RPMs do not include them. Refactored out of MakeMaker->new(). @@ -2825,24 +3008,6 @@ sub _PRINT_PREREQ { =begin private -=head3 _all_prereqs - - my $prereqs = $self->_all_prereqs; - -Returns a hash ref of both PREREQ_PM and BUILD_REQUIRES. - -=end private - -=cut - -sub _all_prereqs { - my $self = shift; - - return { %{$self->{PREREQ_PM}}, %{$self->{BUILD_REQUIRES}} }; -} - -=begin private - =head3 _perl_header_files my $perl_header_files= $self->_perl_header_files; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm index 801b035..1a910d9 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm @@ -26,7 +26,8 @@ require ExtUtils::MM_Any; require ExtUtils::MM_Unix; our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; =item os_flavor diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm index a9331ff..e8e9d3d 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm @@ -9,7 +9,8 @@ require ExtUtils::MM_Unix; require ExtUtils::MM_Win32; our @ISA = qw( ExtUtils::MM_Unix ); -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; =head1 NAME @@ -129,16 +130,31 @@ But for new archdir dll's use the same rebase address if the old exists. sub dynamic_lib { my($self, %attribs) = @_; my $s = ExtUtils::MM_Unix::dynamic_lib($self, %attribs); - my $ori = "$self->{INSTALLARCHLIB}/auto/$self->{FULLEXT}/$self->{BASEEXT}.$self->{DLEXT}"; - if (-e $ori) { - my $imagebase = `/bin/objdump -p $ori | /bin/grep ImageBase | /bin/cut -c12-`; - chomp $imagebase; - if ($imagebase gt "40000000") { - my $LDDLFLAGS = $self->{LDDLFLAGS}; - $LDDLFLAGS =~ s/-Wl,--enable-auto-image-base/-Wl,--image-base=0x$imagebase/; - $s =~ s/ \$\(LDDLFLAGS\) / $LDDLFLAGS /m; - } - } + return '' unless $s; + return $s unless %{$self->{XS}}; + + # do an ephemeral rebase so the new DLL fits to the current rebase map + $s .= "\t/bin/find \$\(INST_ARCHLIB\)/auto -xdev -name \\*.$self->{DLEXT} | /bin/rebase -sOT -" if (( $Config{myarchname} eq 'i686-cygwin' ) and not ( exists $ENV{CYGPORT_PACKAGE_VERSION} )); + $s; +} + +=item install + +Rebase dll's with the global rebase database after installation. + +=cut + +sub install { + my($self, %attribs) = @_; + my $s = ExtUtils::MM_Unix::install($self, %attribs); + return '' unless $s; + return $s unless %{$self->{XS}}; + + my $INSTALLDIRS = $self->{INSTALLDIRS}; + my $INSTALLLIB = $self->{"INSTALL". ($INSTALLDIRS eq 'perl' ? 'ARCHLIB' : uc($INSTALLDIRS)."ARCH")}; + my $dop = "\$\(DESTDIR\)$INSTALLLIB/auto/"; + my $dll = "$dop/$self->{FULLEXT}/$self->{BASEEXT}.$self->{DLEXT}"; + $s =~ s|^(pure_install :: pure_\$\(INSTALLDIRS\)_install\n\t)\$\(NOECHO\) \$\(NOOP\)\n|$1\$(CHMOD) \$(PERM_RWX) $dll\n\t/bin/find $dop -xdev -name \\*.$self->{DLEXT} \| /bin/rebase -sOT -\n|m if (( $Config{myarchname} eq 'i686-cygwin') and not ( exists $ENV{CYGPORT_PACKAGE_VERSION} )); $s; } diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm index c6ffc59..6bbd02e 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm @@ -2,7 +2,8 @@ package ExtUtils::MM_DOS; use strict; -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; require ExtUtils::MM_Any; require ExtUtils::MM_Unix; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm index cc52f1d..a6490db 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm @@ -7,7 +7,8 @@ BEGIN { our @ISA = qw( ExtUtils::MM_Unix ); } -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; =head1 NAME diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm index 820ffd1..5cee011 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm @@ -2,7 +2,8 @@ package ExtUtils::MM_MacOS; use strict; -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; sub new { die 'MacOS Classic (MacPerl) is no longer supported by MakeMaker'; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm index 0b89a15..48b0b46 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm @@ -22,17 +22,18 @@ use strict; use ExtUtils::MakeMaker::Config; use File::Basename; -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; require ExtUtils::MM_Win32; our @ISA = qw(ExtUtils::MM_Win32); -use ExtUtils::MakeMaker qw( &neatvalue ); +use ExtUtils::MakeMaker qw(&neatvalue &_sprintf562); $ENV{EMXSHELL} = 'sh'; # to run `commands` -my $BORLAND = $Config{'cc'} =~ /^bcc/i; -my $GCC = $Config{'cc'} =~ /^gcc/i; +my $BORLAND = $Config{'cc'} =~ /\bbcc/i; +my $GCC = $Config{'cc'} =~ /\bgcc/i; =item os_flavor @@ -122,148 +123,78 @@ sub platform_constants { return $make_frag; } +=item static_lib_pure_cmd -=item const_cccmd +Defines how to run the archive utility =cut -sub const_cccmd { - my($self,$libperl)=@_; - return $self->{CONST_CCCMD} if $self->{CONST_CCCMD}; - return '' unless $self->needs_linking(); - return $self->{CONST_CCCMD} = <<'MAKE_FRAG'; -CCCMD = $(CC) $(CCFLAGS) $(INC) $(OPTIMIZE) \ - $(PERLTYPE) $(MPOLLUTE) -o $@ \ - -DVERSION=\"$(VERSION)\" -DXS_VERSION=\"$(XS_VERSION)\" -MAKE_FRAG - -} - - -=item static_lib - -=cut - -sub static_lib { - my($self) = @_; - - return '' unless $self->has_link_code; - - my $m = <<'END'; -$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).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. - $m .= <<'END' if $self->{MYEXTLIB}; - $self->{CP} $(MYEXTLIB) $@ -END - - my $ar_arg; - if( $BORLAND ) { - $ar_arg = '$@ $(OBJECT:^"+")'; - } - elsif( $GCC ) { - $ar_arg = '-ru $@ $(OBJECT)'; - } - else { - $ar_arg = '-type library -o $@ $(OBJECT)'; - } - - $m .= sprintf <<'END', $ar_arg; - $(AR) %s - $(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld - $(CHMOD) 755 $@ -END - - $m .= <<'END' if $self->{PERL_SRC}; - $(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs - - -END - return $m; +sub static_lib_pure_cmd { + my ($self, $src) = @_; + $src =~ s/(\$\(\w+)(\))/$1:^"+"$2/g if $BORLAND; + sprintf qq{\t\$(AR) %s\n}, ($BORLAND ? '$@ ' . $src + : ($GCC ? '-ru $@ ' . $src + : '-type library -o $@ ' . $src)); } =item dynamic_lib -Defines how to produce the *.so (or equivalent) files. +Override of utility methods for OS-specific work. =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} || ($BORLAND ? 'c0d32.obj': ''); - my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || ""; - my($ldfrom) = '$(LDFROM)'; - - (my $boot = $self->{NAME}) =~ s/:/_/g; - - my $m = <<'MAKE_FRAG'; -# This section creates the dynamically loadable $(INST_DYNAMIC) -# from $(OBJECT) and possibly $(MYEXTLIB). -OTHERLDFLAGS = '.$otherldflags.' -INST_DYNAMIC_DEP = '.$inst_dynamic_dep.' - +sub xs_make_dynamic_lib { + my ($self, $attribs, $from, $to, $todir, $ldfrom, $exportlist) = @_; + my @m; + # Taking care of long names like FileHandle, ByteLoader, SDBM_File etc + if ($to =~ /^\$/) { + if ($self->{NLM_SHORT_NAME}) { + # deal with shortnames + my $newto = q{$(INST_AUTODIR)\\$(NLM_SHORT_NAME).$(DLEXT)}; + push @m, "$to: $newto\n\n"; + $to = $newto; + } + } else { + my ($v, $d, $f) = File::Spec->splitpath($to); + # relies on $f having a literal "." in it, unlike for $(OBJ_EXT) + if ($f =~ /[^\.]{9}\./) { + # 9+ chars before '.', need to shorten + $f = substr $f, 0, 8; + } + my $newto = File::Spec->catpath($v, $d, $f); + push @m, "$to: $newto\n\n"; + $to = $newto; + } + # bits below should be in dlsyms, not here + # 1 2 3 4 + push @m, _sprintf562 <<'MAKE_FRAG', $to, $from, $todir, $exportlist; # Create xdc data for an MT safe NLM in case of mpk build -$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists - $(NOECHO) $(ECHO) Export boot_$(BOOT_SYMBOL) > $(BASEEXT).def - $(NOECHO) $(ECHO) $(BASE_IMPORT) >> $(BASEEXT).def - $(NOECHO) $(ECHO) Import @$(PERL_INC)\perl.imp >> $(BASEEXT).def +%1$s: %2$s $(MYEXTLIB) $(BOOTSTRAP) %3$s$(DFSEP).exists + $(NOECHO) $(ECHO) Export boot_$(BOOT_SYMBOL) > %4$s + $(NOECHO) $(ECHO) $(BASE_IMPORT) >> %4$s + $(NOECHO) $(ECHO) Import @$(PERL_INC)\perl.imp >> %4$s MAKE_FRAG - - if ( $self->{CCFLAGS} =~ m/ -DMPK_ON /) { - $m .= <<'MAKE_FRAG'; - $(MPKTOOL) $(XDCFLAGS) $(BASEEXT).xdc - $(NOECHO) $(ECHO) xdcdata $(BASEEXT).xdc >> $(BASEEXT).def + (my $xdc = $exportlist) =~ s#def\z#xdc#; + $xdc = '$(BASEEXT).xdc'; + push @m, sprintf <<'MAKE_FRAG', $xdc, $exportlist; + $(MPKTOOL) $(XDCFLAGS) %s + $(NOECHO) $(ECHO) xdcdata $(BASEEXT).xdc >> %s MAKE_FRAG } - # Reconstruct the X.Y.Z version. my $version = join '.', map { sprintf "%d", $_ } $] =~ /(\d)\.(\d{3})(\d{2})/; - $m .= sprintf ' $(LD) $(LDFLAGS) $(OBJECT:.obj=.obj) -desc "Perl %s Extension ($(BASEEXT)) XS_VERSION: $(XS_VERSION)" -nlmversion $(NLM_VERSION)', $version; - - # Taking care of long names like FileHandle, ByteLoader, SDBM_File etc - if($self->{NLM_SHORT_NAME}) { - # In case of nlms with names exceeding 8 chars, build nlm in the - # current dir, rename and move to auto\lib. - $m .= q{ -o $(NLM_SHORT_NAME).$(DLEXT)} - } else { - $m .= q{ -o $(INST_AUTODIR)\\$(BASEEXT).$(DLEXT)} - } - - # Add additional lib files if any (SDBM_File) - $m .= q{ $(MYEXTLIB) } if $self->{MYEXTLIB}; - - $m .= q{ $(PERL_INC)\Main.lib -commandfile $(BASEEXT).def}."\n"; - - if($self->{NLM_SHORT_NAME}) { - $m .= <<'MAKE_FRAG'; - if exist $(INST_AUTODIR)\$(NLM_SHORT_NAME).$(DLEXT) del $(INST_AUTODIR)\$(NLM_SHORT_NAME).$(DLEXT) - move $(NLM_SHORT_NAME).$(DLEXT) $(INST_AUTODIR) -MAKE_FRAG - } - - $m .= <<'MAKE_FRAG'; - + push @m, sprintf <<'EOF', $from, $version, $to, $exportlist; + $(LD) $(LDFLAGS) %s -desc "Perl %s Extension ($(BASEEXT)) XS_VERSION: $(XS_VERSION)" -nlmversion $(NLM_VERSION) -o %s $(MYEXTLIB) $(PERL_INC)\Main.lib -commandfile %s $(CHMOD) 755 $@ -MAKE_FRAG - - return $m; +EOF + join '', @m; } - 1; __END__ =back =cut - - diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm index 2c64ac4..4dc8bcc 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm @@ -5,7 +5,8 @@ use strict; use ExtUtils::MakeMaker qw(neatvalue); use File::Spec; -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; require ExtUtils::MM_Any; require ExtUtils::MM_Unix; @@ -49,33 +50,12 @@ MAKE_TEXT sub dlsyms { my($self,%attribs) = @_; - - my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; - my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; - my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || []; - 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 -", - ' $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e \'use ExtUtils::Mksymlists; \\ - Mksymlists("NAME" => "$(NAME)", "DLBASE" => "$(DLBASE)", ', - '"VERSION" => "$(VERSION)", "DISTNAME" => "$(DISTNAME)", ', - '"INSTALLDIRS" => "$(INSTALLDIRS)", ', - '"DL_FUNCS" => ',neatvalue($funcs), - ', "FUNCLIST" => ',neatvalue($funclist), - ', "IMPORTS" => ',neatvalue($imports), - ', "DL_VARS" => ', neatvalue($vars), ');\' -'); - } if ($self->{IMPORTS} && %{$self->{IMPORTS}}) { # Make import files (needed for static build) -d 'tmp_imp' or mkdir 'tmp_imp', 0777 or die "Can't mkdir tmp_imp"; open my $imp, '>', 'tmpimp.imp' or die "Can't open tmpimp.imp"; - while (my($name, $exp) = each %{$self->{IMPORTS}}) { + foreach my $name (sort keys %{$self->{IMPORTS}}) { + my $exp = $self->{IMPORTS}->{$name}; my ($lib, $id) = ($exp =~ /(.*)\.(.*)/) or die "Malformed IMPORT `$exp'"; print $imp "$name $lib $id ?\n"; } @@ -88,21 +68,26 @@ $self->{BASEEXT}.def: Makefile.PL system "cd tmp_imp; $Config::Config{ar} x ../tmpimp$Config::Config{lib_ext}" and die "Cannot extract import objects: $!, \$?=$?"; } - join('',@m); + return '' if $self->{SKIPHASH}{'dynamic'}; + $self->xs_dlsyms_iterator(\%attribs); } -sub static_lib { - my($self) = @_; - my $old = $self->ExtUtils::MM_Unix::static_lib(); - return $old unless $self->{IMPORTS} && %{$self->{IMPORTS}}; +sub xs_dlsyms_ext { + '.def'; +} - my @chunks = split /\n{2,}/, $old; - shift @chunks unless length $chunks[0]; # Empty lines at the start - $chunks[0] .= <<'EOC'; +sub xs_dlsyms_extra { + join '', map { qq{, "$_" => "\$($_)"} } qw(VERSION DISTNAME INSTALLDIRS); +} - $(AR) $(AR_STATIC_ARGS) $@ tmp_imp/* && $(RANLIB) $@ +sub static_lib_pure_cmd { + my($self) = @_; + my $old = $self->SUPER::static_lib_pure_cmd; + return $old unless $self->{IMPORTS} && %{$self->{IMPORTS}}; + $old . <<'EOC'; + $(AR) $(AR_STATIC_ARGS) "$@" tmp_imp/* + $(RANLIB) "$@" EOC - return join "\n\n". '', @chunks; } sub replace_manpage_separator { diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm index 71c4bd5..9a604a1 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm @@ -1,7 +1,8 @@ package ExtUtils::MM_QNX; use strict; -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; require ExtUtils::MM_Unix; our @ISA = qw(ExtUtils::MM_Unix); diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm index 2350482..38c1042 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm @@ -1,7 +1,8 @@ package ExtUtils::MM_UWIN; use strict; -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; require ExtUtils::MM_Unix; our @ISA = qw(ExtUtils::MM_Unix); diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm index e24a61b..fe0ff54 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm @@ -7,15 +7,14 @@ use strict; use Carp; use ExtUtils::MakeMaker::Config; use File::Basename qw(basename dirname); -use DirHandle; our %Config_Override; -use ExtUtils::MakeMaker qw($Verbose neatvalue); +use ExtUtils::MakeMaker qw($Verbose neatvalue _sprintf562); # If we make $VERSION an our variable parse_version() breaks use vars qw($VERSION); -$VERSION = '7.10_01'; +$VERSION = '7.18'; $VERSION = eval $VERSION; ## no critic [BuiltinFunctions::ProhibitStringyEval] require ExtUtils::MM_Any; @@ -98,7 +97,6 @@ something that used to be in here, look in MM_Any. # So we don't have to keep calling the methods over and over again, # we have these globals to cache the values. Faster and shrtr. my $Curdir = __PACKAGE__->curdir; -my $Rootdir = __PACKAGE__->rootdir; my $Updir = __PACKAGE__->updir; @@ -143,31 +141,36 @@ sub c_o { }; } - push @m, qq{ -.c.s: - $command -S $flags \$*.c + my $m_o = $self->{XSMULTI} ? $self->xs_obj_opt('$*.s') : ''; + push @m, sprintf <<'EOF', $command, $flags, $m_o; -.c\$(OBJ_EXT): - $command $flags \$*.c +.c.s : + %s -S %s $*.c %s +EOF -.cpp\$(OBJ_EXT): - $command $flags \$*.cpp + my @exts = qw(c cpp cxx cc); + push @exts, 'C' if !$Is{OS2} and !$Is{Win32} and !$Is{Dos}; #Case-specific + $m_o = $self->{XSMULTI} ? $self->xs_obj_opt('$*$(OBJ_EXT)') : ''; + for my $ext (@exts) { + push @m, "\n.$ext\$(OBJ_EXT) :\n\t$command $flags \$*.$ext" . ( $m_o ? " $m_o" : '' ) . "\n"; + } + return join "", @m; +} -.cxx\$(OBJ_EXT): - $command $flags \$*.cxx -.cc\$(OBJ_EXT): - $command $flags \$*.cc -}; +=item xs_obj_opt - push @m, qq{ -.C\$(OBJ_EXT): - $command $flags \$*.C -} if !$Is{OS2} and !$Is{Win32} and !$Is{Dos}; #Case-specific +Takes the object file as an argument, and returns the portion of compile +command-line that will output to the specified object file. - return join "", @m; +=cut + +sub xs_obj_opt { + my ($self, $output_file) = @_; + "-o $output_file"; } + =item cflags (o) Does very much the same as the cflags script in the perl @@ -284,9 +287,6 @@ sub cflags { $pollute = '$(PERL_MALLOC_DEF)'; } - $self->{CCFLAGS} = quote_paren($self->{CCFLAGS}); - $self->{OPTIMIZE} = quote_paren($self->{OPTIMIZE}); - return $self->{CFLAGS} = qq{ CCFLAGS = $self->{CCFLAGS} OPTIMIZE = $self->{OPTIMIZE} @@ -337,7 +337,6 @@ END foreach my $key (@{$self->{CONFIG}}){ # SITE*EXP macros are defined in &constants; avoid duplicates here next if $once_only{$key}; - $self->{uc $key} = quote_paren($self->{uc $key}); push @m, uc($key) , ' = ' , $self->{uc $key}, "\n"; $once_only{$key} = 1; } @@ -455,9 +454,9 @@ MM_REVISION = $self->{MM_REVISION} push @m, " # Handy lists of source code files: XS_FILES = ".$self->wraplist(sort keys %{$self->{XS}})." -C_FILES = ".$self->wraplist(@{$self->{C}})." -O_FILES = ".$self->wraplist(@{$self->{O_FILES}})." -H_FILES = ".$self->wraplist(@{$self->{H}})." +C_FILES = ".$self->wraplist(sort @{$self->{C}})." +O_FILES = ".$self->wraplist(sort @{$self->{O_FILES}})." +H_FILES = ".$self->wraplist(sort @{$self->{H}})." MAN1PODS = ".$self->wraplist(sort keys %{$self->{MAN1PODS}})." MAN3PODS = ".$self->wraplist(sort keys %{$self->{MAN3PODS}})." "; @@ -466,7 +465,7 @@ MAN3PODS = ".$self->wraplist(sort keys %{$self->{MAN3PODS}})." push @m, q{ # Where is the Config information that we are using/depend on CONFIGDEP = $(PERL_ARCHLIBDEP)$(DFSEP)Config.pm $(PERL_INCDEP)$(DFSEP)config.h -} if -e File::Spec->catfile( $self->{PERL_INC}, 'config.h' ); +} if -e $self->catfile( $self->{PERL_INC}, 'config.h' ); push @m, qq{ @@ -492,10 +491,7 @@ PERL_ARCHIVE_AFTER = $self->{PERL_ARCHIVE_AFTER} push @m, " -TO_INST_PM = ".$self->wraplist(sort keys %{$self->{PM}})." - -PM_TO_BLIB = ".$self->wraplist(map { ($_ => $self->{PM}->{$_}) } sort keys %{$self->{PM}})." -"; +TO_INST_PM = ".$self->wraplist(map $self->quote_dep($_), sort keys %{$self->{PM}})."\n"; join('',@m); } @@ -510,8 +506,9 @@ Same as macro for the depend attribute. sub depend { my($self,%attribs) = @_; my(@m,$key,$val); - while (($key,$val) = each %attribs){ - last unless defined $key; + for my $key (sort keys %attribs){ + my $val = $attribs{$key}; + next unless defined $key and defined $val; push @m, "$key : $val\n"; } join "", @m; @@ -883,25 +880,43 @@ Defines targets for bootstrap files. sub dynamic_bs { my($self, %attribs) = @_; - return ' -BOOTSTRAP = -' unless $self->has_link_code(); - - my $target = $Is{VMS} ? '$(MMS$TARGET)' : '$@'; - - return sprintf <<'MAKE_FRAG', ($target) x 2; -BOOTSTRAP = $(BASEEXT).bs - + return "\nBOOTSTRAP =\n" unless $self->has_link_code(); + my @exts; + if ($self->{XSMULTI}) { + @exts = $self->_xs_list_basenames; + } else { + @exts = '$(BASEEXT)'; + } + return join "\n", + "BOOTSTRAP = @{[map { qq{$_.bs} } @exts]}\n", + map { $self->_xs_make_bs($_) } @exts; +} + +sub _xs_make_bs { + my ($self, $basename) = @_; + my ($v, $d, $f) = File::Spec->splitpath($basename); + my @d = File::Spec->splitdir($d); + shift @d if $self->{XSMULTI} and $d[0] eq 'lib'; + my $instdir = $self->catdir('$(INST_ARCHLIB)', 'auto', @d, $f); + $instdir = '$(INST_ARCHAUTODIR)' if $basename eq '$(BASEEXT)'; + my $instfile = $self->catfile($instdir, "$f.bs"); + my $exists = "$instdir\$(DFSEP).exists"; # match blibdirs_target + # 1 2 3 + return _sprintf562 <<'MAKE_FRAG', $basename, $instfile, $exists; # As Mkbootstrap might not write a file (if none is required) # we use touch to prevent make continually trying to remake it. # The DynaLoader only reads a non-empty file. -$(BOOTSTRAP) : $(FIRST_MAKEFILE) $(BOOTDEP) $(INST_ARCHAUTODIR)$(DFSEP).exists - $(NOECHO) $(ECHO) "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))" +%1$s.bs : $(FIRST_MAKEFILE) $(BOOTDEP) + $(NOECHO) $(ECHO) "Running Mkbootstrap for %1$s ($(BSLOADLIBS))" $(NOECHO) $(PERLRUN) \ "-MExtUtils::Mkbootstrap" \ - -e "Mkbootstrap('$(BASEEXT)','$(BSLOADLIBS)');" - $(NOECHO) $(TOUCH) "%s" - $(CHMOD) $(PERM_RW) "%s" + -e "Mkbootstrap('%1$s','$(BSLOADLIBS)');" + $(NOECHO) $(TOUCH) "%1$s.bs" + $(CHMOD) $(PERM_RW) "%1$s.bs" + +%2$s : %1$s.bs %3$s + $(NOECHO) $(RM_RF) %2$s + - $(CP_NONEMPTY) %1$s.bs %2$s $(PERM_RW) MAKE_FRAG } @@ -914,31 +929,84 @@ Defines how to produce the *.so (or equivalent) files. sub dynamic_lib { my($self, %attribs) = @_; return '' unless $self->needs_linking(); #might be because of a subdir - return '' unless $self->has_link_code; + my @m = $self->xs_dynamic_lib_macros(\%attribs); + my @libs; + if ($self->{XSMULTI}) { + my @exts = $self->_xs_list_basenames; + for my $ext (@exts) { + my ($v, $d, $f) = File::Spec->splitpath($ext); + my @d = File::Spec->splitdir($d); + shift @d if $d[0] eq 'lib'; + my $instdir = $self->catdir('$(INST_ARCHLIB)', 'auto', @d, $f); + + # Dynamic library names may need special handling. + eval { require DynaLoader }; + if (defined &DynaLoader::mod2fname) { + $f = &DynaLoader::mod2fname([@d, $f]); + } - my($otherldflags) = $attribs{OTHERLDFLAGS} || ""; - my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || ""; - my($armaybe) = $attribs{ARMAYBE} || $self->{ARMAYBE} || ":"; - my($ldfrom) = '$(LDFROM)'; - $armaybe = 'ar' if ($Is{OSF} and $armaybe eq ':'); - my(@m); - my $ld_opt = $Is{OS2} ? '$(OPTIMIZE) ' : ''; # Useful on other systems too? + my $instfile = $self->catfile($instdir, "$f.\$(DLEXT)"); + my $objfile = $self->_xsbuild_value('xs', $ext, 'OBJECT'); + $objfile = "$ext\$(OBJ_EXT)" unless defined $objfile; + my $ldfrom = $self->_xsbuild_value('xs', $ext, 'LDFROM'); + $ldfrom = $objfile unless defined $ldfrom; + my $exportlist = "$ext.def"; + push @libs, [ $objfile, $instfile, $instdir, $ldfrom, $exportlist ]; + } + } else { + @libs = ([ qw($(OBJECT) $(INST_DYNAMIC) $(INST_ARCHAUTODIR) $(LDFROM) $(EXPORT_LIST)) ]); + } + push @m, map { $self->xs_make_dynamic_lib(\%attribs, @$_); } @libs; + + return join("\n",@m); +} + +=item xs_dynamic_lib_macros + +Defines the macros for the C section. + +=cut + +sub xs_dynamic_lib_macros { + my ($self, $attribs) = @_; + my $otherldflags = $attribs->{OTHERLDFLAGS} || ""; + my $inst_dynamic_dep = $attribs->{INST_DYNAMIC_DEP} || ""; + my $armaybe = $self->_xs_armaybe($attribs); + my $ld_opt = $Is{OS2} ? '$(OPTIMIZE) ' : ''; # Useful on other systems too? my $ld_fix = $Is{OS2} ? '|| ( $(RM_F) $@ && sh -c false )' : ''; - push(@m,' -# This section creates the dynamically loadable $(INST_DYNAMIC) -# from $(OBJECT) and possibly $(MYEXTLIB). -ARMAYBE = '.$armaybe.' -OTHERLDFLAGS = '.$ld_opt.$otherldflags.' -INST_DYNAMIC_DEP = '.$inst_dynamic_dep.' -INST_DYNAMIC_FIX = '.$ld_fix.' - -$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVEDEP) $(PERL_ARCHIVE_AFTER) $(INST_DYNAMIC_DEP) -'); + sprintf <<'EOF', $armaybe, $ld_opt.$otherldflags, $inst_dynamic_dep, $ld_fix; +# This section creates the dynamically loadable objects from relevant +# objects and possibly $(MYEXTLIB). +ARMAYBE = %s +OTHERLDFLAGS = %s +INST_DYNAMIC_DEP = %s +INST_DYNAMIC_FIX = %s +EOF +} + +sub _xs_armaybe { + my ($self, $attribs) = @_; + my $armaybe = $attribs->{ARMAYBE} || $self->{ARMAYBE} || ":"; + $armaybe = 'ar' if ($Is{OSF} and $armaybe eq ':'); + $armaybe; +} + +=item xs_make_dynamic_lib + +Defines the recipes for the C section. + +=cut + +sub xs_make_dynamic_lib { + my ($self, $attribs, $object, $to, $todir, $ldfrom, $exportlist) = @_; + $exportlist = '' if $exportlist ne '$(EXPORT_LIST)'; + my $armaybe = $self->_xs_armaybe($attribs); + my @m = sprintf '%s : %s $(MYEXTLIB) %s$(DFSEP).exists %s $(PERL_ARCHIVEDEP) $(PERL_ARCHIVE_AFTER) $(INST_DYNAMIC_DEP)'."\n", $to, $object, $todir, $exportlist; if ($armaybe ne ':'){ - $ldfrom = 'tmp$(LIB_EXT)'; - push(@m,' $(ARMAYBE) cr '.$ldfrom.' $(OBJECT)'."\n"); - push(@m,' $(RANLIB) '."$ldfrom\n"); + $ldfrom = 'tmp$(LIB_EXT)'; + push(@m," \$(ARMAYBE) cr $ldfrom $object\n"); + push(@m," \$(RANLIB) $ldfrom\n"); } $ldfrom = "-all $ldfrom -none" if $Is{OSF}; @@ -951,16 +1019,14 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPO # is using them. This is painful if one for instance tries to restart # a failed build because the link command will fail unnecessarily 'cos # the shared object/library is 'busy'. - push(@m,' $(RM_F) $@ -'); + push(@m," \$(RM_F) \$\@\n"); my $libs = '$(LDLOADLIBS)'; - if (($Is{NetBSD} || $Is{Interix} || $Is{Android}) && $Config{'useshrplib'} eq 'true') { - # Use nothing on static perl platforms, and to the flags needed - # to link against the shared libperl library on shared perl - # platforms. We peek at lddlflags to see if we need -Wl,-R - # or -R to add paths to the run-time library search path. + # Use nothing on static perl platforms, and to the flags needed + # to link against the shared libperl library on shared perl + # platforms. We peek at lddlflags to see if we need -Wl,-R + # or -R to add paths to the run-time library search path. if ($Config{'lddlflags'} =~ /-Wl,-R/) { $libs .= ' "-L$(PERL_INC)" "-Wl,-R$(INSTALLARCHLIB)/CORE" "-Wl,-R$(PERL_ARCHLIB)/CORE" -lperl'; } elsif ($Config{'lddlflags'} =~ /-R/) { @@ -974,22 +1040,16 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPO my $ld_run_path_shell = ""; if ($self->{LD_RUN_PATH} ne "") { - $ld_run_path_shell = 'LD_RUN_PATH="$(LD_RUN_PATH)" '; + $ld_run_path_shell = 'LD_RUN_PATH="$(LD_RUN_PATH)" '; } - push @m, sprintf <<'MAKE', $ld_run_path_shell, $ldrun, $ldfrom, $libs; - %s$(LD) %s $(LDDLFLAGS) %s $(OTHERLDFLAGS) -o $@ $(MYEXTLIB) \ - $(PERL_ARCHIVE) %s $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST) \ + push @m, sprintf <<'MAKE', $ld_run_path_shell, $ldrun, $self->xs_obj_opt('$@'), $ldfrom, $libs, $exportlist; + %s$(LD) %s $(LDDLFLAGS) %s $(OTHERLDFLAGS) %s $(MYEXTLIB) \ + $(PERL_ARCHIVE) %s $(PERL_ARCHIVE_AFTER) %s \ $(INST_DYNAMIC_FIX) -MAKE - - push @m, <<'MAKE'; $(CHMOD) $(PERM_RWX) $@ - $(NOECHO) $(RM_RF) $(BOOTSTRAP) - - $(CP_NONEMPTY) $(BOOTSTRAP) $(INST_BOOT) $(PERM_RW) MAKE - - return join('',@m); + join '', @m; } =item exescan @@ -1050,21 +1110,26 @@ WARNING } foreach my $name (@$names){ - foreach my $dir (@$dirs){ + my ($abs, $use_dir); + if ($self->file_name_is_absolute($name)) { # /foo/bar + $abs = $name; + } elsif ($self->canonpath($name) eq + $self->canonpath(basename($name))) { # foo + $use_dir = 1; + } else { # foo/bar + $abs = $self->catfile($Curdir, $name); + } + foreach my $dir ($use_dir ? @$dirs : 1){ next unless defined $dir; # $self->{PERL_SRC} may be undefined - 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->catfile($Curdir, $name); - } + + $abs = $self->catfile($dir, $name) + if $use_dir; + print "Checking $abs\n" if ($trace >= 2); next unless $self->maybe_command($abs); print "Executing $abs\n" if ($trace >= 2); + my $val; my $version_check = qq{"$abs" -le "require $ver; print qq{VER_OK}"}; # To avoid using the unportable 2>&1 to suppress STDERR, @@ -1191,11 +1256,12 @@ sub _fixin_replace_shebang { = reverse grep { $self->file_name_is_absolute($_) } $self->path; $interpreter = ''; - foreach my $dir (@absdirs) { - if ( $self->maybe_command($cmd) ) { + foreach my $dir (@absdirs) { + my $maybefile = $self->catfile($dir,$cmd); + if ( $self->maybe_command($maybefile) ) { warn "Ignoring $interpreter in $file\n" if $Verbose && $interpreter; - $interpreter = $self->catfile( $dir, $cmd ); + $interpreter = $maybefile; } } } @@ -1451,7 +1517,10 @@ sub init_MAN3PODS { # To force inclusion, just name it "Configure.pod", or override # MAN3PODS foreach my $name (keys %manifypods) { - if ($self->{PERL_CORE} and $name =~ /(config|setup).*\.pm/is) { + if ( + ($self->{PERL_CORE} and $name =~ /(config|setup).*\.pm/is) or + ( $name =~ m/^README\.pod$/i ) # don't manify top-level README.pod + ) { delete $manifypods{$name}; next; } @@ -1562,7 +1631,14 @@ sub init_PM { $inst = $self->libscan($inst); print "libscan($path) => '$inst'\n" if ($Verbose >= 2); return unless $inst; - $self->{PM}{$path} = $inst; + if ($self->{XSMULTI} and $inst =~ /\.xs\z/) { + my($base); ($base = $path) =~ s/\.xs\z//; + $self->{XS}{$path} = "$base.c"; + push @{$self->{C}}, "$base.c"; + push @{$self->{O_FILES}}, "$base$self->{OBJ_EXT}"; + } else { + $self->{PM}{$path} = $inst; + } }, @{$self->{PMLIBDIRS}}); } } @@ -1987,19 +2063,22 @@ sub init_PERL { $self->{PERL_CORE} = $ENV{PERL_CORE} unless exists $self->{PERL_CORE}; $self->{PERL_CORE} = 0 unless defined $self->{PERL_CORE}; + # Make sure perl can find itself before it's installed. + my $lib_paths = $self->{UNINSTALLED_PERL} || $self->{PERL_CORE} + ? $self->{PERL_ARCHLIB} ne $self->{PERL_LIB} ? + q{ "-I$(PERL_LIB)" "-I$(PERL_ARCHLIB)"} : q{ "-I$(PERL_LIB)"} + : undef; + my $inst_lib_paths = $self->{INST_ARCHLIB} ne $self->{INST_LIB} + ? 'RUN)'.$perlflags.' "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"' + : 'RUN)'.$perlflags.' "-I$(INST_LIB)"'; # How do we run perl? foreach my $perl (qw(PERL FULLPERL ABSPERL)) { my $run = $perl.'RUN'; $self->{$run} = qq{\$($perl)}; + $self->{$run} .= $lib_paths if $lib_paths; - # Make sure perl can find itself before it's installed. - $self->{$run} .= q{ "-I$(PERL_LIB)" "-I$(PERL_ARCHLIB)"} - if $self->{UNINSTALLED_PERL} || $self->{PERL_CORE}; - - $self->{$perl.'RUNINST'} = - sprintf q{$(%sRUN)%s "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"}, - $perl, $perlflags; + $self->{$perl.'RUNINST'} = '$('.$perl.$inst_lib_paths; } return 1; @@ -2076,6 +2155,31 @@ sub init_xs { $self->catfile('$(INST_ARCHAUTODIR)', '$(DLBASE).$(DLEXT)'); $self->{INST_BOOT} = $self->catfile('$(INST_ARCHAUTODIR)', '$(BASEEXT).bs'); + if ($self->{XSMULTI}) { + my @exts = $self->_xs_list_basenames; + my (@statics, @dynamics, @boots); + for my $ext (@exts) { + my ($v, $d, $f) = File::Spec->splitpath($ext); + my @d = File::Spec->splitdir($d); + shift @d if defined $d[0] and $d[0] eq 'lib'; + my $instdir = $self->catdir('$(INST_ARCHLIB)', 'auto', @d, $f); + my $instfile = $self->catfile($instdir, $f); + push @statics, "$instfile\$(LIB_EXT)"; + + # Dynamic library names may need special handling. + my $dynfile = $instfile; + eval { require DynaLoader }; + if (defined &DynaLoader::mod2fname) { + $dynfile = $self->catfile($instdir, &DynaLoader::mod2fname([@d, $f])); + } + + push @dynamics, "$dynfile.\$(DLEXT)"; + push @boots, "$instfile.bs"; + } + $self->{INST_STATIC} = join ' ', @statics; + $self->{INST_DYNAMIC} = join ' ', @dynamics; + $self->{INST_BOOT} = join ' ', @boots; + } } else { $self->{INST_STATIC} = ''; $self->{INST_DYNAMIC} = ''; @@ -2192,7 +2296,7 @@ doc_perl_install :: all -$(NOECHO) $(MKPATH) "$(DESTINSTALLARCHLIB)" -$(NOECHO) $(DOC_INSTALL) \ "Module" "$(NAME)" \ - "installed into" $(INSTALLPRIVLIB) \ + "installed into" "$(INSTALLPRIVLIB)" \ LINKTYPE "$(LINKTYPE)" \ VERSION "$(VERSION)" \ EXE_FILES "$(EXE_FILES)" \ @@ -2203,7 +2307,7 @@ doc_site_install :: all -$(NOECHO) $(MKPATH) "$(DESTINSTALLARCHLIB)" -$(NOECHO) $(DOC_INSTALL) \ "Module" "$(NAME)" \ - "installed into" $(INSTALLSITELIB) \ + "installed into" "$(INSTALLSITELIB)" \ LINKTYPE "$(LINKTYPE)" \ VERSION "$(VERSION)" \ EXE_FILES "$(EXE_FILES)" \ @@ -2214,7 +2318,7 @@ doc_vendor_install :: all -$(NOECHO) $(MKPATH) "$(DESTINSTALLARCHLIB)" -$(NOECHO) $(DOC_INSTALL) \ "Module" "$(NAME)" \ - "installed into" $(INSTALLVENDORLIB) \ + "installed into" "$(INSTALLVENDORLIB)" \ LINKTYPE "$(LINKTYPE)" \ VERSION "$(VERSION)" \ EXE_FILES "$(EXE_FILES)" \ @@ -2249,7 +2353,7 @@ sub installbin { my($self) = shift; return "" unless $self->{EXE_FILES} && ref $self->{EXE_FILES} eq "ARRAY"; - my @exefiles = @{$self->{EXE_FILES}}; + my @exefiles = sort @{$self->{EXE_FILES}}; return "" unless @exefiles; @exefiles = map vmsify($_), @exefiles if $Is{VMS}; @@ -2265,7 +2369,7 @@ sub installbin { $to = vmsify($to) if $Is{VMS}; $fromto{$from} = $to; } - my @to = values %fromto; + my @to = sort values %fromto; my @m; push(@m, qq{ @@ -2281,17 +2385,16 @@ realclean :: push @m, map "\t$_\n", $self->split_command('$(RM_F)', @to); push @m, "\n"; - # A target for each exe file. - while (my($from,$to) = each %fromto) { - last unless defined $from; - - push @m, sprintf <<'MAKE', $to, $from, $to, $from, $to, $to, $to; -%s : %s $(FIRST_MAKEFILE) $(INST_SCRIPT)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists - $(NOECHO) $(RM_F) %s - $(CP) %s %s - $(FIXIN) %s - -$(NOECHO) $(CHMOD) $(PERM_RWX) %s + my @froms = sort keys %fromto; + for my $from (@froms) { + # 1 2 + push @m, _sprintf562 <<'MAKE', $from, $fromto{$from}; +%2$s : %1$s $(FIRST_MAKEFILE) $(INST_SCRIPT)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists + $(NOECHO) $(RM_F) %2$s + $(CP) %1$s %2$s + $(FIXIN) %2$s + -$(NOECHO) $(CHMOD) $(PERM_RWX) %2$s MAKE @@ -2300,18 +2403,21 @@ MAKE join "", @m; } - =item linkext (o) Defines the linkext target which in turn defines the LINKTYPE. =cut +# LINKTYPE => static or dynamic or '' sub linkext { my($self, %attribs) = @_; - # LINKTYPE => static or dynamic or '' - my($linktype) = defined $attribs{LINKTYPE} ? - $attribs{LINKTYPE} : '$(LINKTYPE)'; + my $linktype = $attribs{LINKTYPE}; + $linktype = $self->{LINKTYPE} unless defined $linktype; + if (defined $linktype and $linktype eq '') { + warn "Warning: LINKTYPE set to '', no longer necessary\n"; + } + $linktype = '$(LINKTYPE)' unless defined $linktype; " linkext :: $linktype \$(NOECHO) \$(NOOP) @@ -2326,14 +2432,13 @@ all entries in the directory that match the regular expression. =cut sub lsdir { - my($self) = shift; - my($dir, $regex) = @_; - my(@ls); - my $dh = new DirHandle; - $dh->open($dir || ".") or return (); - @ls = $dh->read; - $dh->close; - @ls = grep(/$regex/, @ls) if $regex; + # $self + my(undef, $dir, $regex) = @_; + opendir(my $dh, defined($dir) ? $dir : ".") + or return; + my @ls = readdir $dh; + closedir $dh; + @ls = grep(/$regex/, @ls) if defined $regex; @ls; } @@ -2346,9 +2451,9 @@ into the Makefile. sub macro { my($self,%attribs) = @_; - my(@m,$key,$val); - while (($key,$val) = each %attribs){ - last unless defined $key; + my @m; + foreach my $key (sort keys %attribs) { + my $val = $attribs{$key}; push @m, "$key = $val\n"; } join "", @m; @@ -2369,11 +2474,13 @@ sub makeaperl { my($self, %attribs) = @_; my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmp, $libperl) = @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)}; + s/^(.*)/"-I$1"/ for @{$perlinc || []}; my(@m); push @m, " # --- MakeMaker makeaperl section --- MAP_TARGET = $target FULLPERL = $self->{FULLPERL} +MAP_PERLINC = @{$perlinc || []} "; return join '', @m if $self->{PARENT}; @@ -2381,10 +2488,10 @@ FULLPERL = $self->{FULLPERL} unless ($self->{MAKEAPERL}) { push @m, q{ -$(MAP_TARGET) :: static $(MAKE_APERL_FILE) +$(MAP_TARGET) :: $(MAKE_APERL_FILE) $(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@ -$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib +$(MAKE_APERL_FILE) : static $(FIRST_MAKEFILE) pm_to_blib $(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET) $(NOECHO) $(PERLRUNINST) \ Makefile.PL DIR="}, $dir, q{" \ @@ -2392,23 +2499,18 @@ $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=}; foreach (@ARGV){ - if( /\s/ ){ - s/=(.*)/='$1'/; + my $arg = $_; # avoid lvalue aliasing + if ( $arg =~ /(^.*?=)(.*['\s].*)/ ) { + $arg = $1 . $self->quote_literal($2); } - push @m, " \\\n\t\t$_"; + push @m, " \\\n\t\t$arg"; } -# push @m, map( " \\\n\t\t$_", @ARGV ); push @m, "\n"; return join '', @m; } - - - my($cccmd, $linkcmd, $lperl); - - - $cccmd = $self->const_cccmd($libperl); + my $cccmd = $self->const_cccmd($libperl); $cccmd =~ s/^CCCMD\s*=\s*//; $cccmd =~ s/\$\(INC\)/ "-I$self->{PERL_INC}" /; $cccmd .= " $Config{cccdlflags}" @@ -2416,7 +2518,7 @@ $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib $cccmd =~ s/\(CC\)/\(PERLMAINCC\)/; # The front matter of the linkcommand... - $linkcmd = join ' ', "\$(CC)", + my $linkcmd = join ' ', "\$(CC)", grep($_, @Config{qw(ldflags ccdlflags)}); $linkcmd =~ s/\s+/ /g; $linkcmd =~ s,(perl\.exp),\$(PERL_INC)/$1,; @@ -2424,6 +2526,10 @@ $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib # Which *.a files could we make use of... my %static; require File::Find; + # don't use File::Spec here because on Win32 F::F still uses "/" + my $installed_version = join('/', + 'auto', $self->{FULLEXT}, "$self->{BASEEXT}$self->{LIB_EXT}" + ); File::Find::find(sub { return unless m/\Q$self->{LIB_EXT}\E$/; @@ -2469,7 +2575,7 @@ $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib # Once the patch to minimod.PL is in the distribution, I can # drop it - return if $File::Find::name =~ m:auto/$self->{FULLEXT}/$self->{BASEEXT}$self->{LIB_EXT}\z:; + return if $File::Find::name =~ m:\Q$installed_version\E\z:; use Cwd 'cwd'; $static{cwd() . "/" . $_}++; }, grep( -d $_, @{$searchdirs || []}) ); @@ -2493,15 +2599,16 @@ $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib # MAP_STATIC doesn't look into subdirs yet. Once "all" is made and we # regenerate the Makefiles, MAP_STATIC and the dependencies for # extralibs.all are computed correctly + my @map_static = reverse sort keys %static; push @m, " MAP_LINKCMD = $linkcmd -MAP_PERLINC = @{$perlinc || []} -MAP_STATIC = ", -join(" \\\n\t", reverse sort keys %static), " +MAP_STATIC = ", join(" \\\n\t", map { qq{"$_"} } @map_static), " +MAP_STATICDEP = ", join(' ', map { $self->quote_dep($_) } @map_static), " MAP_PRELIBS = $Config{perllibs} $Config{cryptlib} "; + my $lperl; if (defined $libperl) { ($lperl = $libperl) =~ s/\$\(A\)/$self->{LIB_EXT}/; } @@ -2522,17 +2629,20 @@ MAP_PRELIBS = $Config{perllibs} $Config{cryptlib} } } - print "Warning: $libperl not found - If you're going to build a static perl binary, make sure perl is installed - otherwise ignore this warning\n" - unless (-f $lperl || defined($self->{PERL_SRC})); + print <{PERL_SRC}); +Warning: $libperl not found +If you're going to build a static perl binary, make sure perl is installed +otherwise ignore this warning +EOF } # SUNOS ld does not take the full path to a shared library my $llibperl = $libperl ? '$(MAP_LIBPERL)' : '-lperl'; + my $libperl_dep = $self->quote_dep($libperl); push @m, " MAP_LIBPERL = $libperl +MAP_LIBPERLDEP = $libperl_dep LLIBPERL = $llibperl "; @@ -2546,25 +2656,29 @@ $(INST_ARCHAUTODIR)/extralibs.all : $(INST_ARCHAUTODIR)$(DFSEP).exists '.join(" push @m, "\tcat $catfile >> \$\@\n"; } -push @m, " -\$(MAP_TARGET) :: $tmp/perlmain\$(OBJ_EXT) \$(MAP_LIBPERL) \$(MAP_STATIC) \$(INST_ARCHAUTODIR)/extralibs.all - \$(MAP_LINKCMD) -o \$\@ \$(OPTIMIZE) $tmp/perlmain\$(OBJ_EXT) \$(LDFROM) \$(MAP_STATIC) \$(LLIBPERL) `cat \$(INST_ARCHAUTODIR)/extralibs.all` \$(MAP_PRELIBS) - \$(NOECHO) \$(ECHO) 'To install the new \"\$(MAP_TARGET)\" binary, call' - \$(NOECHO) \$(ECHO) ' \$(MAKE) \$(USEMAKEFILE) $makefilename inst_perl MAP_TARGET=\$(MAP_TARGET)' - \$(NOECHO) \$(ECHO) 'To remove the intermediate files say' - \$(NOECHO) \$(ECHO) ' \$(MAKE) \$(USEMAKEFILE) $makefilename map_clean' + my $ldfrom = $self->{XSMULTI} ? '' : '$(LDFROM)'; + # 1 2 3 4 + push @m, _sprintf562 <<'EOF', $tmp, $self->xs_obj_opt('$@'), $ldfrom, $makefilename; +$(MAP_TARGET) :: %1$s/perlmain$(OBJ_EXT) $(MAP_LIBPERLDEP) $(MAP_STATICDEP) $(INST_ARCHAUTODIR)/extralibs.all + $(MAP_LINKCMD) %2$s $(OPTIMIZE) %1$s/perlmain$(OBJ_EXT) %3$s $(MAP_STATIC) "$(LLIBPERL)" `cat $(INST_ARCHAUTODIR)/extralibs.all` $(MAP_PRELIBS) + $(NOECHO) $(ECHO) "To install the new '$(MAP_TARGET)' binary, call" + $(NOECHO) $(ECHO) " $(MAKE) $(USEMAKEFILE) %4$s inst_perl MAP_TARGET=$(MAP_TARGET)" + $(NOECHO) $(ECHO) " $(MAKE) $(USEMAKEFILE) %4$s map_clean" -$tmp/perlmain\$(OBJ_EXT): $tmp/perlmain.c -"; +%1$s/perlmain\$(OBJ_EXT): %1$s/perlmain.c +EOF push @m, "\t".$self->cd($tmp, qq[$cccmd "-I\$(PERL_INC)" perlmain.c])."\n"; - push @m, qq{ -$tmp/perlmain.c: $makefilename}, q{ + my $maybe_DynaLoader = $Config{usedl} ? 'q(DynaLoader)' : ''; + push @m, _sprintf562 <<'EOF', $tmp, $makefilename, $maybe_DynaLoader; + +%1$s/perlmain.c: %2$s $(NOECHO) $(ECHO) Writing $@ - $(NOECHO) $(PERL) $(MAP_PERLINC) "-MExtUtils::Miniperl" \\ - -e "writemain(grep s#.*/auto/##s, split(q| |, q|$(MAP_STATIC)|))" > $@t && $(MV) $@t $@ + $(NOECHO) $(PERL) $(MAP_PERLINC) "-MExtUtils::Miniperl" \ + -e "writemain(grep(s#.*/auto/##s, @ARGV), %3$s)" $(MAP_STATIC) > $@t + $(MV) $@t $@ -}; +EOF push @m, "\t", q{$(NOECHO) $(PERL) "$(INSTALLSCRIPT)/fixpmain" } if (defined (&Dos::UseLFN) && Dos::UseLFN()==0); @@ -2694,6 +2808,7 @@ sub parse_abstract { local $/ = "\n"; open(my $fh, '<', $parsefile) or die "Could not open '$parsefile': $!"; + binmode $fh; my $inpod = 0; my $pod_encoding; my $package = $self->{DISTNAME}; @@ -2701,7 +2816,7 @@ sub parse_abstract { while (<$fh>) { $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod; next if !$inpod; - chop; + s#\r*\n\z##; # handle CRLF input if ( /^=encoding\s*(.*)$/i ) { $pod_encoding = $1; @@ -2766,7 +2881,7 @@ sub parse_version { next if $inpod || /^\s*#/; chop; next if /^\s*(if|unless|elsif)/; - if ( m{^ \s* package \s+ \w[\w\:\']* \s+ (v?[0-9._]+) \s* ; }x ) { + if ( m{^ \s* package \s+ \w[\w\:\']* \s+ (v?[0-9._]+) \s* (;|\{) }x ) { local $^W = 0; $result = $1; } @@ -2811,7 +2926,16 @@ sub get_version { =item pasthru (o) Defines the string that is passed to recursive make calls in -subdirectories. +subdirectories. The variables like C are used in each +level, and passed downwards on the command-line with e.g. the value of +that level's DEFINE. Example: + + # Level 0 has DEFINE = -Dfunky + # This code will define level 0's PASTHRU=PASTHRU_DEFINE="$(DEFINE) + # $(PASTHRU_DEFINE)" + # Level 0's $(CCCMD) will include macros $(DEFINE) and $(PASTHRU_DEFINE) + # So will level 1's, so when level 1 compiles, it will get right values + # And so ad infinitum =cut @@ -2832,8 +2956,14 @@ sub pasthru { } foreach my $key (qw(DEFINE INC)) { - next unless defined $self->{$key}; - push @pasthru, "PASTHRU_$key=\"\$(PASTHRU_$key)\""; + # default to the make var + my $val = qq{\$($key)}; + # expand within perl if given since need to use quote_literal + # since INC might include space-protecting ""! + chomp($val = $self->{$key}) if defined $self->{$key}; + $val .= " \$(PASTHRU_$key)"; + my $quoted = $self->quote_literal($val); + push @pasthru, qq{PASTHRU_$key=$quoted}; } push @m, "\nPASTHRU = ", join ($sep, @pasthru), "\n"; @@ -2913,7 +3043,7 @@ pm_to_blib({\@ARGV}, '$autodir', q[\$(PM_FILTER)], '\$(PERM_DIR)') CODE my @cmds = $self->split_command($pm_to_blib, - map { ($_, $self->{PM}->{$_}) } sort keys %{$self->{PM}}); + map { ($self->quote_literal($_) => $self->quote_literal($self->{PM}->{$_})) } sort keys %{$self->{PM}}); $r .= join '', map { "\t\$(NOECHO) $_\n" } @cmds; $r .= qq{\t\$(NOECHO) \$(TOUCH) pm_to_blib\n}; @@ -2921,39 +3051,6 @@ CODE return $r; } -=item post_constants (o) - -Returns an empty string per default. Dedicated to overrides from -within Makefile.PL after all constants have been defined. - -=cut - -sub post_constants{ - ""; -} - -=item post_initialize (o) - -Returns an empty string per default. Used in Makefile.PLs to add some -chunk of text to the Makefile after the object is initialized. - -=cut - -sub post_initialize { - ""; -} - -=item postamble (o) - -Returns an empty string. Can be used in Makefile.PLs to write some -text to the Makefile at the end. - -=cut - -sub postamble { - ""; -} - # transform dot-separated version string into comma-separated quadruple # examples: '1.2.3.4.5' => '1,2,3,4' # '1.2.3' => '1,2,3,0' @@ -2977,25 +3074,23 @@ sub ppd { $abstract =~ s//>/g; - my $author = join(', ',@{$self->{AUTHOR} || []}); + my $author = join(', ',@{ ref $self->{AUTHOR} eq 'ARRAY' ? $self->{AUTHOR} : [ $self->{AUTHOR} || '']}); $author =~ s//>/g; - my $ppd_file = '$(DISTNAME).ppd'; + my $ppd_file = "$self->{DISTNAME}.ppd"; - my @ppd_cmds = $self->echo(<<'PPD_HTML', $ppd_file, { append => 0, allow_variables => 1 }); - -PPD_HTML + my @ppd_chunks = qq(\n); - my $ppd_xml = sprintf <<'PPD_HTML', $abstract, $author; + push @ppd_chunks, sprintf <<'PPD_HTML', $abstract, $author; %s %s PPD_HTML - $ppd_xml .= " \n"; + push @ppd_chunks, " \n"; if ( $self->{MIN_PERL_VERSION} ) { my $min_perl_version = $self->_ppd_version($self->{MIN_PERL_VERSION}); - $ppd_xml .= sprintf <<'PPD_PERLVERS', $min_perl_version; + push @ppd_chunks, sprintf <<'PPD_PERLVERS', $min_perl_version; PPD_PERLVERS @@ -3015,7 +3110,7 @@ PPD_PERLVERS my %attrs = ( NAME => $name ); $attrs{VERSION} = $version if $version; my $attrs = join " ", map { qq[$_="$attrs{$_}"] } sort keys %attrs; - $ppd_xml .= qq( \n); + push @ppd_chunks, qq( \n); } my $archname = $Config{archname}; @@ -3025,28 +3120,28 @@ PPD_PERLVERS # version that changes when binary compatibility may change $archname .= "-$Config{PERL_REVISION}.$Config{PERL_VERSION}"; } - $ppd_xml .= sprintf <<'PPD_OUT', $archname; + push @ppd_chunks, sprintf <<'PPD_OUT', $archname; PPD_OUT if ($self->{PPM_INSTALL_SCRIPT}) { if ($self->{PPM_INSTALL_EXEC}) { - $ppd_xml .= sprintf qq{ %s\n}, + push @ppd_chunks, sprintf qq{ %s\n}, $self->{PPM_INSTALL_EXEC}, $self->{PPM_INSTALL_SCRIPT}; } else { - $ppd_xml .= sprintf qq{ %s\n}, + push @ppd_chunks, sprintf qq{ %s\n}, $self->{PPM_INSTALL_SCRIPT}; } } if ($self->{PPM_UNINSTALL_SCRIPT}) { if ($self->{PPM_UNINSTALL_EXEC}) { - $ppd_xml .= sprintf qq{ %s\n}, + push @ppd_chunks, sprintf qq{ %s\n}, $self->{PPM_UNINSTALL_EXEC}, $self->{PPM_UNINSTALL_SCRIPT}; } else { - $ppd_xml .= sprintf qq{ %s\n}, + push @ppd_chunks, sprintf qq{ %s\n}, $self->{PPM_UNINSTALL_SCRIPT}; } } @@ -3054,13 +3149,13 @@ PPD_OUT my ($bin_location) = $self->{BINARY_LOCATION} || ''; $bin_location =~ s/\\/\\\\/g; - $ppd_xml .= sprintf <<'PPD_XML', $bin_location; + push @ppd_chunks, sprintf <<'PPD_XML', $bin_location; PPD_XML - push @ppd_cmds, $self->echo($ppd_xml, $ppd_file, { append => 1 }); + my @ppd_cmds = $self->stashmeta(join('', @ppd_chunks), $ppd_file); return sprintf <<'PPD_OUT', join "\n\t", @ppd_cmds; # Creates a PPD (Perl Package Description) for a binary distribution. @@ -3138,29 +3233,29 @@ sub processPL { foreach my $plfile (sort keys %$pl_files) { my $list = ref($pl_files->{$plfile}) ? $pl_files->{$plfile} - : [$pl_files->{$plfile}]; + : [$pl_files->{$plfile}]; - foreach my $target (@$list) { + foreach my $target (@$list) { if( $Is{VMS} ) { $plfile = vmsify($self->eliminate_macros($plfile)); $target = vmsify($self->eliminate_macros($target)); } - # Normally a .PL file runs AFTER pm_to_blib so it can have - # blib in its @INC and load the just built modules. BUT if - # the generated module is something in $(TO_INST_PM) which - # pm_to_blib depends on then it can't depend on pm_to_blib - # else we have a dependency loop. - my $pm_dep; - my $perlrun; - if( defined $self->{PM}{$target} ) { - $pm_dep = ''; - $perlrun = 'PERLRUN'; - } - else { - $pm_dep = 'pm_to_blib'; - $perlrun = 'PERLRUNINST'; - } + # Normally a .PL file runs AFTER pm_to_blib so it can have + # blib in its @INC and load the just built modules. BUT if + # the generated module is something in $(TO_INST_PM) which + # pm_to_blib depends on then it can't depend on pm_to_blib + # else we have a dependency loop. + my $pm_dep; + my $perlrun; + if( defined $self->{PM}{$target} ) { + $pm_dep = ''; + $perlrun = 'PERLRUN'; + } + else { + $pm_dep = 'pm_to_blib'; + $perlrun = 'PERLRUNINST'; + } $m .= <has_link_code; + my(@m); + my @libs; + if ($self->{XSMULTI}) { + for my $ext ($self->_xs_list_basenames) { + my ($v, $d, $f) = File::Spec->splitpath($ext); + my @d = File::Spec->splitdir($d); + shift @d if $d[0] eq 'lib'; + my $instdir = $self->catdir('$(INST_ARCHLIB)', 'auto', @d, $f); + my $instfile = $self->catfile($instdir, "$f\$(LIB_EXT)"); + my $objfile = "$ext\$(OBJ_EXT)"; + push @libs, [ $objfile, $instfile, $instdir ]; + } + } else { + @libs = ([ qw($(OBJECT) $(INST_STATIC) $(INST_ARCHAUTODIR)) ]); + } + push @m, map { $self->xs_make_static_lib(@$_); } @libs; + join "\n", @m; +} + +=item xs_make_static_lib -Defines how to produce the *.a (or equivalent) files. +Defines the recipes for the C section. =cut -sub static_lib { - my($self) = @_; - return '' unless $self->has_link_code; +sub xs_make_static_lib { + my ($self, $from, $to, $todir) = @_; + my @m = sprintf '%s: %s $(MYEXTLIB) %s$(DFSEP).exists'."\n", $to, $from, $todir; + push @m, "\t\$(RM_F) \"\$\@\"\n"; + push @m, $self->static_lib_fixtures; + push @m, $self->static_lib_pure_cmd($from); + push @m, "\t\$(CHMOD) \$(PERM_RWX) \$\@\n"; + push @m, $self->static_lib_closures($todir); + join '', @m; +} - my(@m); - push(@m, <<'END'); +=item static_lib_closures -$(INST_STATIC) : $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists - $(RM_RF) $@ -END +Records C<$(EXTRALIBS)> in F and F<$(PERL_SRC)/ext.libs>. + +=cut +sub static_lib_closures { + my ($self, $todir) = @_; + my @m = sprintf <<'MAKE_FRAG', $todir; + $(NOECHO) $(ECHO) "$(EXTRALIBS)" > %s$(DFSEP)extralibs.ld +MAKE_FRAG + # Old mechanism - still available: + push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS}; + $(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)$(DFSEP)ext.libs +MAKE_FRAG + @m; +} + +=item static_lib_fixtures + +Handles copying C<$(MYEXTLIB)> as starter for final static library that +then gets added to. + +=cut + +sub static_lib_fixtures { + my ($self) = @_; # If this extension has its own library (eg SDBM_File) # then copy that to $(INST_STATIC) and add $(OBJECT) into it. - push(@m, <<'MAKE_FRAG') if $self->{MYEXTLIB}; - $(CP) $(MYEXTLIB) "$@" -MAKE_FRAG + return unless $self->{MYEXTLIB}; + "\t\$(CP) \$(MYEXTLIB) \"\$\@\"\n"; +} + +=item static_lib_pure_cmd + +Defines how to run the archive utility. +=cut + +sub static_lib_pure_cmd { + my ($self, $from) = @_; my $ar; if (exists $self->{FULL_AR} && -x $self->{FULL_AR}) { # Prefer the absolute pathed ar if available so that PATH @@ -3369,18 +3521,10 @@ MAKE_FRAG } else { $ar = 'AR'; } - push @m, sprintf <<'MAKE_FRAG', $ar; - $(%s) $(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@ - $(CHMOD) $(PERM_RWX) $@ - $(NOECHO) $(ECHO) "$(EXTRALIBS)" > "$(INST_ARCHAUTODIR)/extralibs.ld" + sprintf <<'MAKE_FRAG', $ar, $from; + $(%s) $(AR_STATIC_ARGS) "$@" %s + $(RANLIB) "$@" MAKE_FRAG - - # Old mechanism - still available: - push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS}; - $(NOECHO) $(ECHO) "$(EXTRALIBS)" >> "$(PERL_SRC)/ext.libs" -MAKE_FRAG - - join('', @m); } =item staticmake (o) @@ -3459,15 +3603,16 @@ sub subdirs { # subdirectories containing further Makefile.PL scripts. # It calls the subdir_x() method for each subdirectory. foreach my $dir (@{$self->{DIR}}){ - push(@m, $self->subdir_x($dir)); + push @m, $self->subdir_x($dir); #### print "Including $dir subdirectory\n"; } if (@m){ - unshift(@m, " + unshift @m, <<'EOF'; + # The default clean, realclean and test targets in this Makefile # have automatically been given entries for each subdir. -"); +EOF } else { push(@m, "\n# none") } @@ -3481,8 +3626,6 @@ Defines the test targets. =cut sub test { -# --- Test and Installation Sections --- - my($self, %attribs) = @_; my $tests = $attribs{TESTS} || ''; if (!$tests && -d 't' && defined $attribs{RECURSIVE_TEST_FILES}) { @@ -3494,8 +3637,9 @@ sub test { # have to do this because nmake is broken $tests =~ s!/!\\!g if $self->is_make_type('nmake'); # note: 'test.pl' name is also hardcoded in init_dirscan() - my(@m); - push(@m," + my @m; + my $default_testtype = $Config{usedl} ? 'dynamic' : 'static'; + push @m, <{DIR} }) { - my $test = $self->cd($dir, '$(MAKE) test $(PASTHRU)'); +EOF - push @m, <{DIR} }) { + my $test = $self->cd($dir, "\$(MAKE) test_$linktype \$(PASTHRU)"); + push @m, "\t\$(NOECHO) $test\n"; + } + push @m, "\n"; + if ($tests or -f "test.pl") { + for my $testspec ([ '', '' ], [ 'db', ' $(TESTDB_SW)' ]) { + my ($db, $switch) = @$testspec; + my ($command, $deps); + # if testdb, build all but don't test all + $deps = $db eq 'db' ? $directdeps : "subdirs-test_$linktype"; + if ($linktype eq 'static' and $self->needs_linking) { + my $target = File::Spec->rel2abs('$(MAP_TARGET)'); + $command = qq{"$target" \$(MAP_PERLINC)}; + $deps .= ' $(MAP_TARGET)'; + } else { + $command = '$(FULLPERLRUN)' . $switch; + } + push @m, "test${db}_$linktype :: $deps\n"; + if ($db eq 'db') { + push @m, $self->test_via_script($command, '$(TEST_FILE)') + } else { + push @m, $self->test_via_script($command, '$(TEST_FILE)') + if -f "test.pl"; + push @m, $self->test_via_harness($command, '$(TEST_FILES)') + if $tests; + } + push @m, "\n"; + } + } else { + push @m, _sprintf562 <<'EOF', $linktype; +testdb_%1$s test_%1$s :: subdirs-test_%1$s + $(NOECHO) $(ECHO) 'No tests defined for $(NAME) extension.' -END +EOF + } } - push(@m, "\t\$(NOECHO) \$(ECHO) 'No tests defined for \$(NAME) extension.'\n") - unless $tests or -f "test.pl" or @{$self->{DIR}}; - push(@m, "\n"); - - push(@m, "test_dynamic :: pure_all\n"); - push(@m, $self->test_via_harness('$(FULLPERLRUN)', '$(TEST_FILES)')) - if $tests; - push(@m, $self->test_via_script('$(FULLPERLRUN)', '$(TEST_FILE)')) - if -f "test.pl"; - push(@m, "\n"); - - push(@m, "testdb_dynamic :: pure_all\n"); - push(@m, $self->test_via_script('$(FULLPERLRUN) $(TESTDB_SW)', - '$(TEST_FILE)')); - push(@m, "\n"); - - # Occasionally we may face this degenerate target: - push @m, "test_ : test_dynamic\n\n"; - - if ($self->needs_linking()) { - push(@m, "test_static :: pure_all \$(MAP_TARGET)\n"); - push(@m, $self->test_via_harness('./$(MAP_TARGET)', '$(TEST_FILES)')) if $tests; - push(@m, $self->test_via_script('./$(MAP_TARGET)', '$(TEST_FILE)')) if -f "test.pl"; - push(@m, "\n"); - push(@m, "testdb_static :: pure_all \$(MAP_TARGET)\n"); - push(@m, $self->test_via_script('./$(MAP_TARGET) $(TESTDB_SW)', '$(TEST_FILE)')); - push(@m, "\n"); - } else { - push @m, "test_static :: test_dynamic\n"; - push @m, "testdb_static :: testdb_dynamic\n"; - } - join("", @m); + join "", @m; } =item test_via_harness (override) @@ -3605,7 +3752,7 @@ sub tool_xsubpp { } die "ExtUtils::MM_Unix::tool_xsubpp : Can't find xsubpp" if !$foundxsubpp; - my $tmdir = File::Spec->catdir($self->{PERL_LIB},"ExtUtils"); + my $tmdir = $self->catdir($self->{PERL_LIB},"ExtUtils"); my(@tmdeps) = $self->catfile($tmdir,'typemap'); if( $self->{TYPEMAPS} ){ foreach my $typemap (@{$self->{TYPEMAPS}}){ @@ -3613,12 +3760,21 @@ sub tool_xsubpp { warn "Typemap $typemap not found.\n"; } else { - push(@tmdeps, $typemap); + $typemap = vmsify($typemap) if $Is{VMS}; + push(@tmdeps, $typemap); } } } push(@tmdeps, "typemap") if -f "typemap"; - my @tmargs = map(qq{-typemap "$_"}, @tmdeps); + # absolutised because with deep-located typemaps, eg "lib/XS/typemap", + # if xsubpp is called from top level with + # $(XSUBPP) ... -typemap "lib/XS/typemap" "lib/XS/Test.xs" + # it says: + # Can't find lib/XS/type map in (fulldir)/lib/XS + # because ExtUtils::ParseXS::process_file chdir's to .xs file's + # location. This is the only way to get all specified typemaps used, + # wherever located. + my @tmargs = map { '-typemap '.$self->quote_literal(File::Spec->rel2abs($_)) } @tmdeps; $_ = $self->quote_dep($_) for @tmdeps; if( exists $self->{XSOPT} ){ unshift( @tmargs, $self->{XSOPT} ); @@ -3679,19 +3835,21 @@ sub top_targets { push @m, $self->all_target, "\n" unless $self->{SKIPHASH}{'all'}; - push @m, ' + push @m, sprintf <<'EOF'; pure_all :: config pm_to_blib subdirs linkext $(NOECHO) $(NOOP) + $(NOECHO) $(NOOP) + subdirs :: $(MYEXTLIB) $(NOECHO) $(NOOP) config :: $(FIRST_MAKEFILE) blibdirs $(NOECHO) $(NOOP) -'; +EOF push @m, ' -$(O_FILES): $(H_FILES) +$(O_FILES) : $(H_FILES) ' if @{$self->{O_FILES} || []} && @{$self->{H} || []}; push @m, q{ @@ -3728,7 +3886,8 @@ sub xs_c { return '' unless $self->needs_linking(); ' .xs.c: - $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(XSUBPP_EXTRA_ARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c + $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(XSUBPP_EXTRA_ARGS) $*.xs > $*.xsc + $(MV) $*.xsc $*.c '; } @@ -3743,27 +3902,73 @@ sub xs_cpp { return '' unless $self->needs_linking(); ' .xs.cpp: - $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.cpp + $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc + $(MV) $*.xsc $*.cpp '; } =item xs_o (o) -Defines suffix rules to go from XS to object files directly. This is -only intended for broken make implementations. +Defines suffix rules to go from XS to object files directly. This was +originally only intended for broken make implementations, but is now +necessary for per-XS file under C, since each XS file might +have an individual C<$(VERSION)>. =cut -sub xs_o { # many makes are too dumb to use xs_c then c_o - my($self) = shift; +sub xs_o { + my ($self) = @_; return '' unless $self->needs_linking(); - ' -.xs$(OBJ_EXT): - $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c - $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c -'; + my $m_o = $self->{XSMULTI} ? $self->xs_obj_opt('$*$(OBJ_EXT)') : ''; + my $frag = ''; + # dmake makes noise about ambiguous rule + $frag .= sprintf <<'EOF', $m_o unless $self->is_make_type('dmake'); +.xs$(OBJ_EXT) : + $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc + $(MV) $*.xsc $*.c + $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c %s +EOF + if ($self->{XSMULTI}) { + for my $ext ($self->_xs_list_basenames) { + my $pmfile = "$ext.pm"; + croak "$ext.xs has no matching $pmfile: $!" unless -f $pmfile; + my $version = $self->parse_version($pmfile); + my $cccmd = $self->{CONST_CCCMD}; + $cccmd =~ s/^\s*CCCMD\s*=\s*//; + $cccmd =~ s/\$\(DEFINE_VERSION\)/-DVERSION=\\"$version\\"/; + $cccmd =~ s/\$\(XS_DEFINE_VERSION\)/-DXS_VERSION=\\"$version\\"/; + $self->_xsbuild_replace_macro($cccmd, 'xs', $ext, 'INC'); + my $define = '$(DEFINE)'; + $self->_xsbuild_replace_macro($define, 'xs', $ext, 'DEFINE'); + # 1 2 3 4 + $frag .= _sprintf562 <<'EOF', $ext, $cccmd, $m_o, $define; + +%1$s$(OBJ_EXT): %1$s.xs + $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc + $(MV) $*.xsc $*.c + %2$s $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) %4$s $*.c %3$s +EOF + } + } + $frag; } +# param gets modified +sub _xsbuild_replace_macro { + my ($self, undef, $xstype, $ext, $varname) = @_; + my $value = $self->_xsbuild_value($xstype, $ext, $varname); + return unless defined $value; + $_[1] =~ s/\$\($varname\)/$value/; +} + +sub _xsbuild_value { + my ($self, $xstype, $ext, $varname) = @_; + return $self->{XSBUILD}{$xstype}{$ext}{$varname} + if $self->{XSBUILD}{$xstype}{$ext}{$varname}; + return $self->{XSBUILD}{$xstype}{all}{$varname} + if $self->{XSBUILD}{$xstype}{all}{$varname}; + (); +} 1; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm index fab18df..8565dc2 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm @@ -15,13 +15,14 @@ BEGIN { use File::Basename; -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; require ExtUtils::MM_Any; require ExtUtils::MM_Unix; our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); -use ExtUtils::MakeMaker qw($Verbose neatvalue); +use ExtUtils::MakeMaker qw($Verbose neatvalue _sprintf562); our $Revision = $ExtUtils::MakeMaker::Revision; @@ -302,15 +303,22 @@ sub maybe_command { =item pasthru (override) -VMS has $(MMSQUALIFIERS) which is a listing of all the original command line -options. This is used in every invocation of make in the VMS Makefile so -PASTHRU should not be necessary. Using PASTHRU tends to blow commands past -the 256 character limit. +The list of macro definitions to be passed through must be specified using +the /MACRO qualifier and must not add another /DEFINE qualifier. We prepend +our own comma here to the contents of $(PASTHRU_DEFINE) because it is often +empty and a comma always present in CCFLAGS would generate a missing +qualifier value error. =cut sub pasthru { - return "PASTHRU=\n"; + my($self) = shift; + my $pasthru = $self->SUPER::pasthru; + $pasthru =~ s|(PASTHRU\s*=\s*)|$1/MACRO=(|; + $pasthru =~ s|\n\z|)\n|m; + $pasthru =~ s|/defi?n?e?=\(?([^\),]+)\)?|,$1|ig; + + return $pasthru; } @@ -725,13 +733,14 @@ sub cflags { my $term = $1; $term =~ s:^\((.+)\)$:$1:; push @terms, $term; - } + } if ($type eq 'Def') { push @terms, qw[ $(DEFINE_VERSION) $(XS_DEFINE_VERSION) ]; } if (@terms) { $quals =~ s:/${type}i?n?e?=[^/]+::ig; - $quals .= "/${type}ine=(" . join(',',@terms) . ')'; + # PASTHRU_DEFINE will have its own comma + $quals .= "/${type}ine=(" . join(',',@terms) . ($type eq 'Def' ? '$(PASTHRU_DEFINE)' : '') . ')'; } } @@ -884,13 +893,13 @@ sub c_o { return '' unless $self->needs_linking(); ' .c$(OBJ_EXT) : - $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c + $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c /OBJECT=$(MMS$TARGET_NAME)$(OBJ_EXT) .cpp$(OBJ_EXT) : - $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cpp + $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cpp /OBJECT=$(MMS$TARGET_NAME)$(OBJ_EXT) .cxx$(OBJ_EXT) : - $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cxx + $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cxx /OBJECT=$(MMS$TARGET_NAME)$(OBJ_EXT) '; } @@ -906,7 +915,8 @@ sub xs_c { return '' unless $self->needs_linking(); ' .xs.c : - $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET) + $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).xsc + $(MV) $(MMS$TARGET_NAME).xsc $(MMS$TARGET_NAME).c '; } @@ -916,85 +926,211 @@ Use MM[SK] macros, and VMS command line for C compiler. =cut -sub xs_o { # many makes are too dumb to use xs_c then c_o - my($self) = @_; +sub xs_o { + my ($self) = @_; return '' unless $self->needs_linking(); - ' + my $frag = ' .xs$(OBJ_EXT) : - $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).c - $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c + $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).xsc + $(MV) $(MMS$TARGET_NAME).xsc $(MMS$TARGET_NAME).c + $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c /OBJECT=$(MMS$TARGET_NAME)$(OBJ_EXT) '; + if ($self->{XSMULTI}) { + for my $ext ($self->_xs_list_basenames) { + my $version = $self->parse_version("$ext.pm"); + my $ccflags = $self->{CCFLAGS}; + $ccflags =~ s/\$\(DEFINE_VERSION\)/\"VERSION_MACRO=\\"\"$version\\"\"/; + $ccflags =~ s/\$\(XS_DEFINE_VERSION\)/\"XS_VERSION_MACRO=\\"\"$version\\"\"/; + $self->_xsbuild_replace_macro($ccflags, 'xs', $ext, 'INC'); + $self->_xsbuild_replace_macro($ccflags, 'xs', $ext, 'DEFINE'); + + $frag .= _sprintf562 <<'EOF', $ext, $ccflags; + +%1$s$(OBJ_EXT) : %1$s.xs + $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs > $(MMS$TARGET_NAME).xsc + $(MV) $(MMS$TARGET_NAME).xsc $(MMS$TARGET_NAME).c + $(CC)%2$s$(OPTIMIZE) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c /OBJECT=$(MMS$TARGET_NAME)$(OBJ_EXT) +EOF + } + } + $frag; } +=item _xsbuild_replace_macro (override) -=item dlsyms (override) +There is no simple replacement possible since a qualifier and all its +subqualifiers must be considered together, so we use our own utility +routine for the replacement. -Create VMS linker options files specifying universal symbols for this -extension's shareable image, and listing other shareable images or -libraries to which it should be linked. +=cut + +sub _xsbuild_replace_macro { + my ($self, undef, $xstype, $ext, $varname) = @_; + my $value = $self->_xsbuild_value($xstype, $ext, $varname); + return unless defined $value; + $_[1] = _vms_replace_qualifier($self, $_[1], $value, $varname); +} + +=item _xsbuild_value (override) + +Convert the extension spec to Unix format, as that's what will +match what's in the XSBUILD data structure. =cut -sub dlsyms { - my($self,%attribs) = @_; +sub _xsbuild_value { + my ($self, $xstype, $ext, $varname) = @_; + $ext = unixify($ext); + return $self->SUPER::_xsbuild_value($xstype, $ext, $varname); +} - return '' unless $self->needs_linking(); +sub _vms_replace_qualifier { + my ($self, $flags, $newflag, $macro) = @_; + my $qual_type; + my $type_suffix; + my $quote_subquals = 0; + my @subquals_new = split /\s+/, $newflag; + + if ($macro eq 'DEFINE') { + $qual_type = 'Def'; + $type_suffix = 'ine'; + map { $_ =~ s/^-D// } @subquals_new; + $quote_subquals = 1; + } + elsif ($macro eq 'INC') { + $qual_type = 'Inc'; + $type_suffix = 'lude'; + map { $_ =~ s/^-I//; $_ = $self->fixpath($_) } @subquals_new; + } - my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; - my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; - my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || []; - my(@m); + my @subquals = (); + while ($flags =~ m:/${qual_type}\S{0,4}=([^/]+):ig) { + my $term = $1; + $term =~ s/\"//g; + $term =~ s:^\((.+)\)$:$1:; + push @subquals, split /,/, $term; + } + for my $new (@subquals_new) { + my ($sq_new, $sqval_new) = split /=/, $new; + my $replaced_old = 0; + for my $old (@subquals) { + my ($sq, $sqval) = split /=/, $old; + if ($sq_new eq $sq) { + $old = $sq_new; + $old .= '=' . $sqval_new if defined($sqval_new) and length($sqval_new); + $replaced_old = 1; + last; + } + } + push @subquals, $new unless $replaced_old; + } - unless ($self->{SKIPHASH}{'dynamic'}) { - push(@m,' -dynamic :: $(INST_ARCHAUTODIR)$(BASEEXT).opt - $(NOECHO) $(NOOP) -'); + if (@subquals) { + $flags =~ s:/${qual_type}\S{0,4}=[^/]+::ig; + # add quotes if requested but not for unexpanded macros + map { $_ = qq/"$_"/ if $_ !~ m/^\$\(/ } @subquals if $quote_subquals; + $flags .= "/${qual_type}$type_suffix=(" . join(',',@subquals) . ')'; } - push(@m,' -static :: $(INST_ARCHAUTODIR)$(BASEEXT).opt - $(NOECHO) $(NOOP) -') unless $self->{SKIPHASH}{'static'}; + return $flags; +} - push @m,' -$(INST_ARCHAUTODIR)$(BASEEXT).opt : $(BASEEXT).opt - $(CP) $(MMS$SOURCE) $(MMS$TARGET) -$(BASEEXT).opt : Makefile.PL - $(PERLRUN) -e "use ExtUtils::Mksymlists;" - - ',qq[-e "Mksymlists('NAME' => '$self->{NAME}', 'DL_FUNCS' => ], - neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars), - q[, 'FUNCLIST' => ],neatvalue($funclist),qq[)"\n]; - - push @m, ' $(PERL) -e "print ""$(INST_STATIC)/Include='; - if ($self->{OBJECT} =~ /\bBASEEXT\b/ or - $self->{OBJECT} =~ /\b$self->{BASEEXT}\b/i) { - push @m, ($Config{d_vms_case_sensitive_symbols} - ? uc($self->{BASEEXT}) :'$(BASEEXT)'); - } - else { # We don't have a "main" object file, so pull 'em all in - # Upcase module names if linker is being case-sensitive - my($upcase) = $Config{d_vms_case_sensitive_symbols}; - my(@omods) = split ' ', $self->eliminate_macros($self->{OBJECT}); - for (@omods) { - s/\.[^.]*$//; # Trim off file type - s[\$\(\w+_EXT\)][]; # even as a macro - s/.*[:>\/\]]//; # Trim off dir spec - $_ = uc if $upcase; - }; - - my(@lines); - my $tmp = shift @omods; - foreach my $elt (@omods) { - $tmp .= ",$elt"; - if (length($tmp) > 80) { push @lines, $tmp; $tmp = ''; } +sub xs_dlsyms_ext { + '.opt'; +} + +=item dlsyms (override) + +Create VMS linker options files specifying universal symbols for this +extension's shareable image(s), and listing other shareable images or +libraries to which it should be linked. + +=cut + +sub dlsyms { + my ($self, %attribs) = @_; + return '' unless $self->needs_linking; + $self->xs_dlsyms_iterator; +} + +sub xs_make_dlsyms { + my ($self, $attribs, $target, $dep, $name, $dlbase, $funcs, $funclist, $imports, $vars, $extra) = @_; + my @m; + my $instloc; + if ($self->{XSMULTI}) { + my ($v, $d, $f) = File::Spec->splitpath($target); + my @d = File::Spec->splitdir($d); + shift @d if $d[0] eq 'lib'; + $instloc = $self->catfile('$(INST_ARCHLIB)', 'auto', @d, $f); + push @m,"\ndynamic :: $instloc\n\t\$(NOECHO) \$(NOOP)\n" + unless $self->{SKIPHASH}{'dynamic'}; + push @m,"\nstatic :: $instloc\n\t\$(NOECHO) \$(NOOP)\n" + unless $self->{SKIPHASH}{'static'}; + push @m, "\n", sprintf <<'EOF', $instloc, $target; +%s : %s + $(CP) $(MMS$SOURCE) $(MMS$TARGET) +EOF + } + else { + push @m,"\ndynamic :: \$(INST_ARCHAUTODIR)$self->{BASEEXT}.opt\n\t\$(NOECHO) \$(NOOP)\n" + unless $self->{SKIPHASH}{'dynamic'}; + push @m,"\nstatic :: \$(INST_ARCHAUTODIR)$self->{BASEEXT}.opt\n\t\$(NOECHO) \$(NOOP)\n" + unless $self->{SKIPHASH}{'static'}; + push @m, "\n", sprintf <<'EOF', $target; +$(INST_ARCHAUTODIR)$(BASEEXT).opt : %s + $(CP) $(MMS$SOURCE) $(MMS$TARGET) +EOF + } + push @m, + "\n$target : $dep\n\t", + q!$(PERLRUN) -MExtUtils::Mksymlists -e "Mksymlists('NAME'=>'!, $name, + q!', 'DLBASE' => '!,$dlbase, + q!', 'DL_FUNCS' => !,neatvalue($funcs), + q!, 'FUNCLIST' => !,neatvalue($funclist), + q!, 'IMPORTS' => !,neatvalue($imports), + q!, 'DL_VARS' => !, neatvalue($vars); + push @m, $extra if defined $extra; + push @m, qq!);"\n\t!; + # Can't use dlbase as it's been through mod2fname. + my $olb_base = basename($target, '.opt'); + if ($self->{XSMULTI}) { + # We've been passed everything but the kitchen sink -- and the location of the + # static library we're using to build the dynamic library -- so concoct that + # location from what we do have. + my $olb_dir = $self->catdir(dirname($instloc), $olb_base); + push @m, qq!\$(PERL) -e "print ""${olb_dir}${olb_base}\$(LIB_EXT)/Include=!; + push @m, ($Config{d_vms_case_sensitive_symbols} ? uc($olb_base) : $olb_base); + push @m, '\n' . $olb_dir . $olb_base . '$(LIB_EXT)/Library\n"";" >>$(MMS$TARGET)',"\n"; + } + else { + push @m, qq!\$(PERL) -e "print ""\$(INST_ARCHAUTODIR)${olb_base}\$(LIB_EXT)/Include=!; + if ($self->{OBJECT} =~ /\bBASEEXT\b/ or + $self->{OBJECT} =~ /\b$self->{BASEEXT}\b/i) { + push @m, ($Config{d_vms_case_sensitive_symbols} + ? uc($self->{BASEEXT}) :'$(BASEEXT)'); + } + else { # We don't have a "main" object file, so pull 'em all in + # Upcase module names if linker is being case-sensitive + my($upcase) = $Config{d_vms_case_sensitive_symbols}; + my(@omods) = split ' ', $self->eliminate_macros($self->{OBJECT}); + for (@omods) { + s/\.[^.]*$//; # Trim off file type + s[\$\(\w+_EXT\)][]; # even as a macro + s/.*[:>\/\]]//; # Trim off dir spec + $_ = uc if $upcase; + }; + my(@lines); + my $tmp = shift @omods; + foreach my $elt (@omods) { + $tmp .= ",$elt"; + if (length($tmp) > 80) { push @lines, $tmp; $tmp = ''; } + } + push @lines, $tmp; + push @m, '(', join( qq[, -\\n\\t"";" >>\$(MMS\$TARGET)\n\t\$(PERL) -e "print ""], @lines),')'; } - push @lines, $tmp; - push @m, '(', join( qq[, -\\n\\t"";" >>\$(MMS\$TARGET)\n\t\$(PERL) -e "print ""], @lines),')'; + push @m, '\n$(INST_ARCHAUTODIR)' . $olb_base . '$(LIB_EXT)/Library\n"";" >>$(MMS$TARGET)',"\n"; } - push @m, '\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET)',"\n"; - if (length $self->{LDLOADLIBS}) { my($line) = ''; foreach my $lib (split ' ', $self->{LDLOADLIBS}) { @@ -1007,9 +1143,19 @@ $(BASEEXT).opt : Makefile.PL } push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n" if $line; } + join '', @m; +} - join('',@m); +=item xs_obj_opt + +Override to fixup -o flags. + +=cut + +sub xs_obj_opt { + my ($self, $output_file) = @_; + "/OBJECT=$output_file"; } =item dynamic_lib (override) @@ -1018,54 +1164,58 @@ Use VMS Link command. =cut -sub dynamic_lib { - my($self, %attribs) = @_; - return '' unless $self->needs_linking(); #might be because of a subdir - - return '' unless $self->has_link_code(); +sub xs_dynamic_lib_macros { + my ($self, $attribs) = @_; + my $otherldflags = $attribs->{OTHERLDFLAGS} || ""; + my $inst_dynamic_dep = $attribs->{INST_DYNAMIC_DEP} || ""; + sprintf <<'EOF', $otherldflags, $inst_dynamic_dep; +# This section creates the dynamically loadable objects from relevant +# objects and possibly $(MYEXTLIB). +OTHERLDFLAGS = %s +INST_DYNAMIC_DEP = %s +EOF +} - my($otherldflags) = $attribs{OTHERLDFLAGS} || ""; - my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || ""; +sub xs_make_dynamic_lib { + my ($self, $attribs, $from, $to, $todir, $ldfrom, $exportlist) = @_; my $shr = $Config{'dbgprefix'} . 'PerlShr'; - my(@m); - push @m," - -OTHERLDFLAGS = $otherldflags -INST_DYNAMIC_DEP = $inst_dynamic_dep - -"; - push @m, ' -$(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) - If F$TrnLNm("',$shr,'").eqs."" Then Define/NoLog/User ',"$shr Sys\$Share:$shr.$Config{'dlext'}",' - Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,$(PERL_INC)perlshr_attr.opt/Option -'; - - join('',@m); + $exportlist =~ s/.def$/.opt/; # it's a linker options file + # 1 2 3 4 5 + _sprintf562 <<'EOF', $to, $todir, $exportlist, $shr, "$shr Sys\$Share:$shr.$Config{'dlext'}"; +%1$s : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt %2$s$(DFSEP).exists %3$s $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) + If F$TrnLNm("%4$s").eqs."" Then Define/NoLog/User %5$s + Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) %3$s/Option,$(PERL_INC)perlshr_attr.opt/Option +EOF } - -=item static_lib (override) +=item xs_make_static_lib (override) Use VMS commands to manipulate object library. =cut -sub static_lib { - my($self) = @_; - return '' unless $self->needs_linking(); - - return ' -$(INST_STATIC) : - $(NOECHO) $(NOOP) -' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB}); +sub xs_make_static_lib { + my ($self, $object, $to, $todir) = @_; + + my @objects; + if ($self->{XSMULTI}) { + # The extension name should be the main object file name minus file type. + my $lib = $object; + $lib =~ s/\$\(OBJ_EXT\)\z//; + my $override = $self->_xsbuild_value('xs', $lib, 'OBJECT'); + $object = $override if defined $override; + @objects = map { $self->fixpath($_,0) } split /(?{MYEXTLIB}; @@ -1076,8 +1226,11 @@ $(INST_STATIC) : $(OBJECT) $(MYEXTLIB) # 'cause it's a library and you can't stick them in other libraries. # In that case, we use $OBJECT instead and hope for the best if ($self->{MYEXTLIB}) { - push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(OBJECT)',"\n"); - } else { + for my $obj (@objects) { + push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) ' . $obj,"\n"); + } + } + else { push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n"); } @@ -1359,7 +1512,7 @@ $(PERL_ARCHLIB)Config.pm : $(PERL_SRC)config.sh ]); } - push(@m, join(" ", map($self->fixpath($_,0),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n") + push(@m, join(" ", map($self->fixpath($_,0),sort values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n") if %{$self->{XS}}; join('',@m); @@ -1469,7 +1622,7 @@ $(MAP_TARGET) :: $(MAKE_APERL_FILE) # (e.g. Intuit::DWIM will precede Intuit, so unresolved # references from [.intuit.dwim]dwim.obj can be found # in [.intuit]intuit.olb). - for (sort { length($a) <=> length($b) } keys %olbs) { + for (sort { length($a) <=> length($b) || $a cmp $b } keys %olbs) { next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/; my($dir) = $self->fixpath($_,1); my($extralibs) = $dir . "extralibs.ld"; @@ -1615,7 +1768,7 @@ map_clean : =item maketext_filter (override) -Insure that colons marking targets are preceded by space, in order +Ensure that colons marking targets are preceded by space, in order to distinguish the target delimiter from a colon appearing as part of a filespec. @@ -1778,7 +1931,7 @@ sub oneliner { =item B perl trips up on "" thinking it's an input redirect. So we use the -native Write command instead. Besides, its faster. +native Write command instead. Besides, it's faster. =cut @@ -1975,7 +2128,12 @@ sub eliminate_macros { $complex = 1; } } - else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; } + else { + $macro = $self->{$macro}; + # Don't unixify if there is unescaped whitespace + $macro = unixify($macro) unless ($macro =~ /(?{cc} =~ /^bcc/i ? 1 : 0; + my $BORLAND = $config->{cc} =~ /\bbcc/i ? 1 : 0; my $GCC = $config->{cc} =~ /\bgcc\b/i ? 1 : 0; - my $DLLTOOL = $config->{dlltool} || 'dlltool'; + my $MSVC = $config->{cc} =~ /\b(?:cl|icl)/i ? 1 : 0; # MSVC can come as clarm.exe, icl=Intel C - return ( $BORLAND, $GCC, $DLLTOOL ); + return ( $BORLAND, $GCC, $MSVC ); } @@ -54,31 +55,18 @@ sub _identify_compiler_environment { sub dlsyms { my($self,%attribs) = @_; + return '' if $self->{SKIPHASH}{'dynamic'}; + $self->xs_dlsyms_iterator(\%attribs); +} - my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; - my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; - my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || []; - my($imports) = $attribs{IMPORTS} || $self->{IMPORTS} || {}; - my(@m); - - if (not $self->{SKIPHASH}{'dynamic'}) { - push(@m," -$self->{BASEEXT}.def: Makefile.PL -", - q! $(PERLRUN) -MExtUtils::Mksymlists \\ - -e "Mksymlists('NAME'=>\"!, $self->{NAME}, - q!\", 'DLBASE' => '!,$self->{DLBASE}, - # The above two lines quoted differently to work around - # a bug in the 4DOS/4NT command line interpreter. The visible - # result of the bug was files named q('extension_name',) *with the - # single quotes and the comma* in the extension build directories. - q!', 'DL_FUNCS' => !,neatvalue($funcs), - q!, 'FUNCLIST' => !,neatvalue($funclist), - q!, 'IMPORTS' => !,neatvalue($imports), - q!, 'DL_VARS' => !, neatvalue($vars), q!);" -!); - } - join('',@m); +=item xs_dlsyms_ext + +On Win32, is C<.def>. + +=cut + +sub xs_dlsyms_ext { + '.def'; } =item replace_manpage_separator @@ -292,104 +280,76 @@ MAKE_FRAG return $make_frag; } +=item static_lib_pure_cmd -=item static_lib - -Changes how to run the linker. - -The rest is duplicate code from MM_Unix. Should move the linker code -to its own method. +Defines how to run the archive utility =cut -sub static_lib { - my($self) = @_; - return '' unless $self->has_link_code; - - my(@m); - push(@m, <<'END'); -$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists - $(RM_RF) $@ -END - - # If this extension has its own library (eg SDBM_File) - # then copy that to $(INST_STATIC) and add $(OBJECT) into it. - push @m, <<'MAKE_FRAG' if $self->{MYEXTLIB}; - $(CP) $(MYEXTLIB) $@ -MAKE_FRAG - - push @m, -q{ $(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")' - : ($GCC ? '-ru $@ $(OBJECT)' - : '-out:$@ $(OBJECT)')).q{ - $(CHMOD) $(PERM_RWX) $@ - $(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld -}; - - # Old mechanism - still available: - push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS}; - $(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs -MAKE_FRAG - - join('', @m); +sub static_lib_pure_cmd { + my ($self, $from) = @_; + $from =~ s/(\$\(\w+)(\))/$1:^"+"$2/g if $BORLAND; + sprintf qq{\t\$(AR) %s\n}, ($BORLAND ? '$@ ' . $from + : ($GCC ? '-ru $@ ' . $from + : '-out:$@ ' . $from)); } - =item dynamic_lib -Complicated stuff for Win32 that I don't understand. :( +Methods are overridden here: not dynamic_lib itself, but the utility +ones that do the OS-specific work. =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} || ($BORLAND ? 'c0d32.obj': ''); - 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)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVEDEP) $(INST_DYNAMIC_DEP) -'); +sub xs_make_dynamic_lib { + my ($self, $attribs, $from, $to, $todir, $ldfrom, $exportlist) = @_; + my @m = sprintf '%s : %s $(MYEXTLIB) %s$(DFSEP).exists %s $(PERL_ARCHIVEDEP) $(INST_DYNAMIC_DEP)'."\n", $to, $from, $todir, $exportlist; if ($GCC) { - push(@m, - q{ }.$DLLTOOL.q{ --def $(EXPORT_LIST) --output-exp dll.exp - $(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) "$(PERL_ARCHIVE)" $(LDLOADLIBS) dll.exp - }.$DLLTOOL.q{ --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp - $(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) "$(PERL_ARCHIVE)" $(LDLOADLIBS) dll.exp }); + # per https://rt.cpan.org/Ticket/Display.html?id=78395 no longer + # uses dlltool - relies on post 2002 MinGW + # 1 2 + push @m, _sprintf562 <<'EOF', $exportlist, $ldfrom; + $(LD) %1$s -o $@ $(LDDLFLAGS) %2$s $(OTHERLDFLAGS) $(MYEXTLIB) "$(PERL_ARCHIVE)" $(LDLOADLIBS) -Wl,--enable-auto-image-base +EOF } elsif ($BORLAND) { - push(@m, - q{ $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,} - .($self->is_make_type('dmake') - ? q{"$(PERL_ARCHIVE:s,/,\,)" $(LDLOADLIBS:s,/,\,) } - .q{$(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,)} - : q{"$(subst /,\,$(PERL_ARCHIVE))" $(subst /,\,$(LDLOADLIBS)) } - .q{$(subst /,\,$(MYEXTLIB)),$(subst /,\,$(EXPORT_LIST))}) - .q{,$(RESFILES)}); + my $ldargs = $self->is_make_type('dmake') + ? q{"$(PERL_ARCHIVE:s,/,\,)" $(LDLOADLIBS:s,/,\,) $(MYEXTLIB:s,/,\,),} + : q{"$(subst /,\,$(PERL_ARCHIVE))" $(subst /,\,$(LDLOADLIBS)) $(subst /,\,$(MYEXTLIB)),}; + my $subbed; + if ($exportlist eq '$(EXPORT_LIST)') { + $subbed = $self->is_make_type('dmake') + ? q{$(EXPORT_LIST:s,/,\,)} + : q{$(subst /,\,$(EXPORT_LIST))}; + } else { + # in XSMULTI, exportlist is per-XS, so have to sub in perl not make + ($subbed = $exportlist) =~ s#/#\\#g; + } + push @m, sprintf <<'EOF', $ldfrom, $ldargs . $subbed; + $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) %s,$@,,%s,$(RESFILES) +EOF } else { # VC - push(@m, - q{ $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) } - .q{$(MYEXTLIB) "$(PERL_ARCHIVE)" $(LDLOADLIBS) -def:$(EXPORT_LIST)}); - + push @m, sprintf <<'EOF', $ldfrom, $exportlist; + $(LD) -out:$@ $(LDDLFLAGS) %s $(OTHERLDFLAGS) $(MYEXTLIB) "$(PERL_ARCHIVE)" $(LDLOADLIBS) -def:%s +EOF # Embed the manifest file if it exists - push(@m, q{ - if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2 + push(@m, q{ if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2 if exist $@.manifest del $@.manifest}); } - push @m, ' - $(CHMOD) $(PERM_RWX) $@ -'; + push @m, "\n\t\$(CHMOD) \$(PERM_RWX) \$\@\n"; + + join '', @m; +} - join('',@m); +sub xs_dynamic_lib_macros { + my ($self, $attribs) = @_; + my $otherldflags = $attribs->{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': ''); + my $inst_dynamic_dep = $attribs->{INST_DYNAMIC_DEP} || ""; + sprintf <<'EOF', $otherldflags, $inst_dynamic_dep; +# This section creates the dynamically loadable objects from relevant +# objects and possibly $(MYEXTLIB). +OTHERLDFLAGS = %s +INST_DYNAMIC_DEP = %s +EOF } =item extra_clean_files @@ -458,14 +418,16 @@ EOF return $self->SUPER::quote_dep($arg); } -=item xs_o -This target is stubbed out. Not sure why. +=item xs_obj_opt + +Override to fixup -o flags for MSVC. =cut -sub xs_o { - return '' +sub xs_obj_opt { + my ($self, $output_file) = @_; + ($MSVC ? "/Fo" : "-o ") . $output_file; } @@ -478,7 +440,10 @@ banner. sub pasthru { my($self) = shift; - return "PASTHRU = " . ($self->is_make_type('nmake') ? "-nologo" : ""); + my $old = $self->SUPER::pasthru; + return $old unless $self->is_make_type('nmake'); + $old =~ s/(PASTHRU\s*=\s*)/$1 -nologo /; + $old; } @@ -658,6 +623,23 @@ PERLTYPE = $self->{PERLTYPE} } +=item make_type + +Returns a suitable string describing the type of makefile being written. + +=cut + +sub make_type { + my ($self) = @_; + my $make = $self->make; + $make = +( File::Spec->splitpath( $make ) )[-1]; + $make =~ s!\.exe$!!i; + if ( $make =~ m![^A-Z0-9]!i ) { + ($make) = grep { m!make!i } split m![^A-Z0-9]!i, $make; + } + return "$make-style"; +} + 1; __END__ diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm index 2c31d7c..f9a4f9d 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm @@ -2,7 +2,8 @@ package ExtUtils::MM_Win95; use strict; -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; require ExtUtils::MM_Win32; our @ISA = qw(ExtUtils::MM_Win32); @@ -26,59 +27,10 @@ to get MakeMaker playing nice with command.com and other Win9Xisms. =head2 Overridden methods Most of these make up for limitations in the Win9x/nmake command shell. -Mostly its lack of &&. =over 4 -=item xs_c - -The && problem. - -=cut - -sub xs_c { - my($self) = shift; - return '' unless $self->needs_linking(); - ' -.xs.c: - $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.c - ' -} - - -=item xs_cpp - -The && problem - -=cut - -sub xs_cpp { - my($self) = shift; - return '' unless $self->needs_linking(); - ' -.xs.cpp: - $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.cpp - '; -} - -=item xs_o - -The && problem. - -=cut - -sub xs_o { - my($self) = shift; - return '' unless $self->needs_linking(); - ' -.xs$(OBJ_EXT): - $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.c - $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c - '; -} - - =item max_exec_len Win98 chokes on things like Encode if we set the max length to nmake's max diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm index 3973e37..be4c708 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm @@ -3,7 +3,8 @@ package ExtUtils::MY; use strict; require ExtUtils::MM; -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; our @ISA = qw(ExtUtils::MM); { diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm index f9fb8fe..e840410 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm @@ -24,7 +24,7 @@ my %Recognized_Att_Keys; our %macro_fsentity; # whether a macro is a filesystem name our %macro_dep; # whether a macro is a dependency -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; $VERSION = eval $VERSION; ## no critic [BuiltinFunctions::ProhibitStringyEval] # Emulate something resembling CVS $Revision$ @@ -36,7 +36,8 @@ our $Filename = __FILE__; # referenced outside MakeMaker our @ISA = qw(Exporter); our @EXPORT = qw(&WriteMakefile $Verbose &prompt); our @EXPORT_OK = qw($VERSION &neatvalue &mkbootstrap &mksymlists - &WriteEmptyMakefile); + &WriteEmptyMakefile &open_for_writing &write_file_via_tmp + &_sprintf562); # These will go away once the last of the Win32 & VMS specific code is # purged. @@ -54,6 +55,15 @@ require ExtUtils::MY; # XXX pre-5.8 versions of ExtUtils::Embed expect # This will go when Embed is its own CPAN module. +# 5.6.2 can't do sprintf "%1$s" - this can only do %s +sub _sprintf562 { + my ($format, @args) = @_; + for (my $i = 1; $i <= @args; $i++) { + $format =~ s#%$i\$s#$args[$i-1]#g; + } + $format; +} + sub WriteMakefile { croak "WriteMakefile: Need even number of args" if @_ % 2; @@ -106,6 +116,7 @@ my %Special_Sigs = ( SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', + XSBUILD => 'HASH', VERSION => ['version',''], _KEEP_AFTER_FLUSH => '', @@ -141,7 +152,8 @@ sub _convert_compat_attrs { #result of running several times should be same sub _verify_att { my($att) = @_; - while( my($key, $val) = each %$att ) { + foreach my $key (sort keys %$att) { + my $val = $att->{$key}; my $sig = $Att_Sigs{$key}; unless( defined $sig ) { warn "WARNING: $key is not a known parameter.\n"; @@ -301,9 +313,9 @@ sub full_setup { PERM_DIR PERM_RW PERM_RWX MAGICXS PL_FILES PM PM_FILTER PMLIBDIRS PMLIBPARENTDIRS POLLUTE PREREQ_FATAL PREREQ_PM PREREQ_PRINT PRINT_PREREQ - SIGN SKIP TEST_REQUIRES TYPEMAPS UNINST VERSION VERSION_FROM XS XSOPT XSPROTOARG - XS_VERSION clean depend dist dynamic_lib linkext macro realclean - tool_autosplit + SIGN SKIP TEST_REQUIRES TYPEMAPS UNINST VERSION VERSION_FROM XS + XSBUILD XSMULTI XSOPT XSPROTOARG XS_VERSION + clean depend dist dynamic_lib linkext macro realclean tool_autosplit MAN1EXT MAN3EXT @@ -405,6 +417,14 @@ sub full_setup { ); } +sub _has_cpan_meta_requirements { + return eval { + require CPAN::Meta::Requirements; + CPAN::Meta::Requirements->VERSION(2.130); + require B; # CMR requires this, for core we have to too. + }; +} + sub new { my($class,$self) = @_; my($key); @@ -423,12 +443,53 @@ sub new { bless $self, "MM"; # Cleanup all the module requirement bits + my %key2cmr; for my $key (qw(PREREQ_PM BUILD_REQUIRES CONFIGURE_REQUIRES TEST_REQUIRES)) { $self->{$key} ||= {}; - $self->clean_versions( $key ); + if (_has_cpan_meta_requirements) { + my $cmr = CPAN::Meta::Requirements->from_string_hash( + $self->{$key}, + { + bad_version_hook => sub { + #no warnings 'numeric'; # module doesn't use warnings + my $fallback; + if ( $_[0] =~ m!^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$! ) { + $fallback = sprintf "%f", $_[0]; + } else { + ($fallback) = $_[0] ? ($_[0] =~ /^([0-9.]+)/) : 0; + $fallback += 0; + carp "Unparsable version '$_[0]' for prerequisite $_[1] treated as $fallback"; + } + version->new($fallback); + }, + }, + ); + $self->{$key} = $cmr->as_string_hash; + $key2cmr{$key} = $cmr; + } else { + for my $module (sort keys %{ $self->{$key} }) { + my $version = $self->{$key}->{$module}; + my $fallback = 0; + if (!defined($version) or !length($version)) { + carp "Undefined requirement for $module treated as '0' (CPAN::Meta::Requirements not available)"; + } + elsif ($version =~ /^\d+(?:\.\d+(?:_\d+)*)?$/) { + next; + } + else { + if ( $version =~ m!^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$! ) { + $fallback = sprintf "%f", $version; + } else { + ($fallback) = $version ? ($version =~ /^([0-9.]+)/) : 0; + $fallback += 0; + carp "Unparsable version '$version' for prerequisite $module treated as $fallback (CPAN::Meta::Requirements not available)"; + } + } + $self->{$key}->{$module} = $fallback; + } + } } - if ("@ARGV" =~ /\bPREREQ_PRINT\b/) { $self->_PREREQ_PRINT; } @@ -495,9 +556,24 @@ END my(%initial_att) = %$self; # record initial attributes my(%unsatisfied) = (); - my $prereqs = $self->_all_prereqs; - foreach my $prereq (sort keys %$prereqs) { - my $required_version = $prereqs->{$prereq}; + my %prereq2version; + my $cmr; + if (_has_cpan_meta_requirements) { + $cmr = CPAN::Meta::Requirements->new; + for my $key (qw(PREREQ_PM BUILD_REQUIRES CONFIGURE_REQUIRES TEST_REQUIRES)) { + $cmr->add_requirements($key2cmr{$key}) if $key2cmr{$key}; + } + foreach my $prereq ($cmr->required_modules) { + $prereq2version{$prereq} = $cmr->requirements_for_module($prereq); + } + } else { + for my $key (qw(PREREQ_PM BUILD_REQUIRES CONFIGURE_REQUIRES TEST_REQUIRES)) { + next unless my $module2version = $self->{$key}; + $prereq2version{$_} = $module2version->{$_} for keys %$module2version; + } + } + foreach my $prereq (sort keys %prereq2version) { + my $required_version = $prereq2version{$prereq}; my $pr_version = 0; my $installed_file; @@ -516,6 +592,18 @@ END $installed_file = MM->_installed_file_for_module($prereq); $pr_version = MM->parse_version($installed_file) if $installed_file; $pr_version = 0 if $pr_version eq 'undef'; + if ( !eval { version->new( $pr_version ); 1 } ) { + #no warnings 'numeric'; # module doesn't use warnings + my $fallback; + if ( $pr_version =~ m!^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$! ) { + $fallback = sprintf '%f', $pr_version; + } else { + ($fallback) = $pr_version ? ($pr_version =~ /^([0-9.]+)/) : 0; + $fallback += 0; + carp "Unparsable version '$pr_version' for installed prerequisite $prereq treated as $fallback"; + } + $pr_version = $fallback; + } } # convert X.Y_Z alpha version #s to X.YZ for easier comparisons @@ -529,13 +617,17 @@ END $unsatisfied{$prereq} = 'not installed'; } - elsif ($pr_version < $required_version ){ + elsif ( + $cmr + ? !$cmr->accepts_module($prereq, $pr_version) + : $required_version > $pr_version + ) { warn sprintf "Warning: prerequisite %s %s not found. We have %s.\n", $prereq, $required_version, ($pr_version || 'unknown version') unless $self->{PREREQ_FATAL} or $UNDER_CORE; - $unsatisfied{$prereq} = $required_version ? $required_version : 'unknown version' ; + $unsatisfied{$prereq} = $required_version || 'unknown version' ; } } @@ -671,7 +763,9 @@ END $self->init_others(); $self->init_platform(); $self->init_PERM(); - my($argv) = neatvalue(\@ARGV); + my @args = @ARGV; + @args = map { Encode::decode(locale => $_) } @args if $CAN_DECODE; + my($argv) = neatvalue(\@args); $argv =~ s/^\[/(/; $argv =~ s/\]$/)/; @@ -757,6 +851,7 @@ sub WriteEmptyMakefile { croak "WriteEmptyMakefile: Need an even number of args" if @_ % 2; my %att = @_; + $att{DIR} = [] unless $att{DIR}; # don't recurse by default my $self = MM->new(\%att); my $new = $self->{MAKEFILE}; @@ -771,6 +866,14 @@ sub WriteEmptyMakefile { print $mfh <<'EOP'; all : +manifypods : + +subdirs : + +dynamic : + +static : + clean : install : @@ -779,6 +882,10 @@ makemakerdflt : test : +test_dynamic : + +test_static : + EOP close $mfh or die "close $new for write: $!"; } @@ -1051,7 +1158,7 @@ sub _run_hintfile { my($hint_file) = shift; local($@, $!); - warn "Processing hints file $hint_file\n"; + print "Processing hints file $hint_file\n" if $Verbose; # Just in case the ./ isn't on the hint file, which File::Spec can # often strip off, we bung the curdir into @INC @@ -1065,69 +1172,34 @@ sub _run_hintfile { sub mv_all_methods { my($from,$to) = @_; - - # Here you see the *current* list of methods that are overridable - # from Makefile.PL via MY:: subroutines. As of VERSION 5.07 I'm - # still trying to reduce the list to some reasonable minimum -- - # because I want to make it easier for the user. A.K. - local $SIG{__WARN__} = sub { # can't use 'no warnings redefined', 5.6 only warn @_ unless $_[0] =~ /^Subroutine .* redefined/ }; foreach my $method (@Overridable) { - - # We cannot say "next" here. Nick might call MY->makeaperl - # which isn't defined right now - - # Above statement was written at 4.23 time when Tk-b8 was - # around. As Tk-b9 only builds with 5.002something and MM 5 is - # standard, we try to enable the next line again. It was - # commented out until MM 5.23 - next unless defined &{"${from}::$method"}; + no strict 'refs'; ## no critic + *{"${to}::$method"} = \&{"${from}::$method"}; + + # If we delete a method, then it will be undefined and cannot + # be called. But as long as we have Makefile.PLs that rely on + # %MY:: being intact, we have to fill the hole with an + # inheriting method: { - no strict 'refs'; ## no critic - *{"${to}::$method"} = \&{"${from}::$method"}; - - # If we delete a method, then it will be undefined and cannot - # be called. But as long as we have Makefile.PLs that rely on - # %MY:: being intact, we have to fill the hole with an - # inheriting method: - - { - package MY; - my $super = "SUPER::".$method; - *{$method} = sub { - shift->$super(@_); - }; - } + package MY; + my $super = "SUPER::".$method; + *{$method} = sub { + shift->$super(@_); + }; } } - - # We have to clean out %INC also, because the current directory is - # changed frequently and Graham Barr prefers to get his version - # out of a History.pl file which is "required" so wouldn't get - # loaded again in another extension requiring a History.pl - - # With perl5.002_01 the deletion of entries in %INC caused Tk-b11 - # to core dump in the middle of a require statement. The required - # file was Tk/MMutil.pm. The consequence is, we have to be - # extremely careful when we try to give perl a reason to reload a - # library with same name. The workaround prefers to drop nothing - # from %INC and teach the writers not to use such libraries. - -# my $inc; -# foreach $inc (keys %INC) { -# #warn "***$inc*** deleted"; -# delete $INC{$inc}; -# } } sub skipcheck { my($self) = shift; my($section) = @_; + return 'skipped' if $section eq 'metafile' && $UNDER_CORE; if ($section eq 'dynamic') { print "Warning (non-fatal): Target 'dynamic' depends on targets ", "in skipped section 'dynamic_bs'\n" @@ -1150,64 +1222,63 @@ sub skipcheck { return ''; } +# returns filehandle, dies on fail. :raw so no :crlf +sub open_for_writing { + my ($file) = @_; + open my $fh ,">", $file or die "Unable to open $file: $!"; + my @layers = ':raw'; + push @layers, join ' ', ':encoding(locale)' if $CAN_DECODE; + binmode $fh, join ' ', @layers; + $fh; +} + sub flush { my $self = shift; - # This needs a bit more work for more wacky OSen - my $type = 'Unix-style'; - if ( $self->os_flavor_is('Win32') ) { - my $make = $self->make; - $make = +( File::Spec->splitpath( $make ) )[-1]; - $make =~ s!\.exe$!!i; - $type = $make . '-style'; - } - elsif ( $Is_VMS ) { - $type = $Config{make} . '-style'; - } - my $finalname = $self->{MAKEFILE}; - print "Generating a $type $finalname\n"; - print "Writing $finalname for $self->{NAME}\n"; + printf "Generating a %s %s\n", $self->make_type, $finalname if $Verbose || !$self->{PARENT}; + print "Writing $finalname for $self->{NAME}\n" if $Verbose || !$self->{PARENT}; unlink($finalname, "MakeMaker.tmp", $Is_VMS ? 'Descrip.MMS' : ()); - open(my $fh,">", "MakeMaker.tmp") - or die "Unable to open MakeMaker.tmp: $!"; - binmode $fh, ':encoding(locale)' if $CAN_DECODE; - for my $chunk (@{$self->{RESULT}}) { + write_file_via_tmp($finalname, $self->{RESULT}); + + # Write MYMETA.yml to communicate metadata up to the CPAN clients + print "Writing MYMETA.yml and MYMETA.json\n" + if !$self->{NO_MYMETA} and $self->write_mymeta( $self->mymeta ); + + # save memory + if ($self->{PARENT} && !$self->{_KEEP_AFTER_FLUSH}) { + my %keep = map { ($_ => 1) } qw(NEEDS_LINKING HAS_LINK_CODE); + delete $self->{$_} for grep !$keep{$_}, keys %$self; + } + + system("$Config::Config{eunicefix} $finalname") + if $Config::Config{eunicefix} ne ":"; + + return; +} + +sub write_file_via_tmp { + my ($finalname, $contents) = @_; + my $fh = open_for_writing("MakeMaker.tmp"); + die "write_file_via_tmp: 2nd arg must be ref" unless ref $contents; + for my $chunk (@$contents) { my $to_write = $chunk; utf8::encode $to_write if !$CAN_DECODE && $] > 5.008; print $fh "$to_write\n" or die "Can't write to MakeMaker.tmp: $!"; } - - close $fh - or die "Can't write to MakeMaker.tmp: $!"; + close $fh or die "Can't write to MakeMaker.tmp: $!"; _rename("MakeMaker.tmp", $finalname) or warn "rename MakeMaker.tmp => $finalname: $!"; - chmod 0644, $finalname unless $Is_VMS; - - unless ($self->{NO_MYMETA}) { - # Write MYMETA.yml to communicate metadata up to the CPAN clients - if ( $self->write_mymeta( $self->mymeta ) ) { - print "Writing MYMETA.yml and MYMETA.json\n"; - } - - } - my %keep = map { ($_ => 1) } qw(NEEDS_LINKING HAS_LINK_CODE); - if ($self->{PARENT} && !$self->{_KEEP_AFTER_FLUSH}) { - foreach (keys %$self) { # safe memory - delete $self->{$_} unless $keep{$_}; - } - } - - system("$Config::Config{eunicefix} $finalname") unless $Config::Config{eunicefix} eq ":"; + chmod 0644, $finalname if !$Is_VMS; + return; } # This is a rename for OS's where the target must be unlinked first. sub _rename { my($src, $dest) = @_; - chmod 0666, $dest; - unlink $dest; + _unlink($dest); return rename $src, $dest; } @@ -1283,36 +1354,6 @@ sub _find_magic_vstring { return $tvalue; } - -# Look for weird version numbers, warn about them and set them to 0 -# before CPAN::Meta chokes. -sub clean_versions { - my($self, $key) = @_; - my $reqs = $self->{$key}; - for my $module (keys %$reqs) { - my $v = $reqs->{$module}; - my $printable = _find_magic_vstring($v); - $v = $printable if length $printable; - my $version = eval { - local $SIG{__WARN__} = sub { - # simulate "use warnings FATAL => 'all'" for vintage perls - die @_; - }; - version->new($v)->stringify; - }; - if( $@ || $reqs->{$module} eq '' ) { - if ( $] < 5.008 && $v !~ /^v?[\d_\.]+$/ ) { - $v = sprintf "v%vd", $v unless $v eq ''; - } - carp "Unparsable version '$v' for prerequisite $module"; - $reqs->{$module} = 0; - } - else { - $reqs->{$module} = $version; - } - } -} - sub selfdocument { my($self) = @_; my(@m); @@ -1326,6 +1367,16 @@ sub selfdocument { push @m, "# $key => $v"; } } + # added here as selfdocument is not overridable + push @m, <<'EOF'; + +# here so even if top_targets is overridden, these will still be defined +# gmake will silently still work if any are .PHONY-ed but nmake won't +EOF + push @m, join "\n", map "$_ ::\n\t\$(NOECHO) \$(NOOP)\n", + # config is so manifypods won't puke if no subdirs + grep !$self->{SKIPHASH}{$_}, + qw(static dynamic config); join "\n", @m; } @@ -2381,7 +2432,14 @@ passed to subdirectory makes. =item PERL -Perl binary for tasks that can be done by miniperl. +Perl binary for tasks that can be done by miniperl. If it contains +spaces or other shell metacharacters, it needs to be quoted in a way +that protects them, since this value is intended to be inserted in a +shell command line in the Makefile. E.g.: + + # Perl executable lives in "C:/Program Files/Perl/bin" + # Normally you don't need to set this yourself! + $ perl Makefile.PL PERL='"C:/Program Files/Perl/bin/perl.exe" -w' =item PERL_CORE @@ -2480,7 +2538,9 @@ Desired permission for executable files. Defaults to C<755>. MakeMaker can run programs to generate files for you at build time. By default any file named *.PL (except Makefile.PL and Build.PL) in the top level directory will be assumed to be a Perl program and run -passing its own basename in as an argument. For example... +passing its own basename in as an argument. This basename is actually a build +target, and there is an intention, but not a requirement, that the *.PL file +make the file passed to to as an argument. For example... perl foo.PL foo @@ -2490,6 +2550,8 @@ and the value is passed in as the first argument when the PL file is run. PL_FILES => {'bin/foobar.PL' => 'bin/foobar'} + PL_FILES => {'foo.PL' => 'foo.c'} + Would run bin/foobar.PL like this: perl bin/foobar.PL bin/foobar @@ -2508,8 +2570,14 @@ INST_ARCH in their C<@INC>, so the just built modules can be accessed... unless the PL file is making a module (or anything else in PM) in which case it is run B pm_to_blib and does not include INST_LIB and INST_ARCH in its C<@INC>. This apparently odd behavior -is there for backwards compatibility (and it's somewhat DWIM). - +is there for backwards compatibility (and it's somewhat DWIM). The argument +passed to the .PL is set up as a target to build in the Makefile. In other +sections such as C you can specify a dependency on the +filename/argument that the .PL is supposed (or will have, now that that is +is a dependency) to generate. Note the file to be generated will still be +generated and the .PL will still run even without an explicit dependency created +by you, since the C target still depends on running all eligible to run.PL +files. =item PM @@ -2536,24 +2604,23 @@ Defining PM in the Makefile.PL will override PMLIBDIRS. A filter program, in the traditional Unix sense (input from stdin, output to stdout) that is passed on each .pm file during the build (in the pm_to_blib() phase). It is empty by default, meaning no filtering is done. +You could use: -Great care is necessary when defining the command if quoting needs to be -done. For instance, you would need to say: - - {'PM_FILTER' => 'grep -v \\"^\\#\\"'} + PM_FILTER => 'perl -ne "print unless /^\\#/"', -to remove all the leading comments on the fly during the build. The -extra \\ are necessary, unfortunately, because this variable is interpolated -within the context of a Perl program built on the command line, and double -quotes are what is used with the -e switch to build that command line. The -# is escaped for the Makefile, since what is going to be generated will then -be: +to remove all the leading comments on the fly during the build. In order +to be as portable as possible, please consider using a Perl one-liner +rather than Unix (or other) utilities, as above. The # is escaped for +the Makefile, since what is going to be generated will then be: - PM_FILTER = grep -v \"^\#\" + PM_FILTER = perl -ne "print unless /^\#/" -Without the \\ before the #, we'd have the start of a Makefile comment, +Without the \ before the #, we'd have the start of a Makefile comment, and the macro would be incorrectly defined. +You will almost certainly be better off using the C system, +instead. See above, or the L entry. + =item POLLUTE Release 5.005 grandfathered old global symbol names by providing preprocessor @@ -2623,8 +2690,11 @@ doesn't. See L for more details. A hash of modules that are needed to run your module. The keys are the module names ie. Test::More, and the minimum version is the value. If the required version number is 0 any version will do. +The versions given may be a Perl v-string (see L) or a range +(see L). -This will go into the C field of your F and the C of the C field of your F. +This will go into the C field of your F and the +C of the C field of your F. PREREQ_PM => { # Require Test::More at least 0.47 @@ -2793,6 +2863,49 @@ Hashref of .xs files. MakeMaker will default this. e.g. The .c files will automatically be included in the list of files deleted by a make clean. +=item XSBUILD + +Hashref with options controlling the operation of C: + + { + xs => { + all => { + # options applying to all .xs files for this distribution + }, + 'lib/Class/Name/File' => { # specifically for this file + DEFINE => '-Dfunktastic', # defines for only this file + INC => "-I$funkyliblocation", # include flags for only this file + # OBJECT => 'lib/Class/Name/File$(OBJ_EXT)', # default + LDFROM => "lib/Class/Name/File\$(OBJ_EXT) $otherfile\$(OBJ_EXT)", # what's linked + }, + }, + } + +Note C is the file-extension. More possibilities may arise in the +future. Note that object names are specified without their XS extension. + +C defaults to the same as C. C defaults to, +for C, just the XS filename with the extension replaced with +the compiler-specific object-file extension. + +The distinction between C and C: C is the make +target, so make will try to build it. However, C is what will +actually be linked together to make the shared object or static library +(SO/SL), so if you override it, make sure it includes what you want to +make the final SO/SL, almost certainly including the XS basename with +C<$(OBJ_EXT)> appended. + +=item XSMULTI + +When this is set to C<1>, multiple XS files may be placed under F +next to their corresponding C<*.pm> files (this is essential for compiling +with the correct C values). This feature should be considered +experimental, and details of it may change. + +This feature was inspired by, and small portions of code copied from, +L. Hopefully this feature will render +that module mainly obsolete. + =item XSOPT String of options to pass to xsubpp. This might include C<-C++> or @@ -3112,13 +3225,13 @@ part of the 'distdir' target (and thus the 'dist' target). This is intended to seamlessly and rapidly populate CPAN with module meta-data. If you wish to shut this feature off, set the C C flag to true. -At the 2008 QA Hackathon in Oslo, Perl module toolchain maintainers agrees +At the 2008 QA Hackathon in Oslo, Perl module toolchain maintainers agreed to use the CPAN Meta format to communicate post-configuration requirements between toolchain components. These files, F and F, are generated when F generates a F (if L -is installed). Clients like L or L will read this +is installed). Clients like L or L will read these files to see what prerequisites must be fulfilled before building or testing -the distribution. If you with to shut this feature off, set the C +the distribution. If you wish to shut this feature off, set the C C flag to true. =head2 Disabling an extension diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Config.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Config.pm index 3b96836..7259f34 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Config.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Config.pm @@ -2,7 +2,8 @@ package ExtUtils::MakeMaker::Config; use strict; -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; use Config (); diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod index d3aa100..6f59192 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod @@ -1,6 +1,7 @@ package ExtUtils::MakeMaker::FAQ; -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; 1; __END__ @@ -21,8 +22,12 @@ FAQs, tricks and tips for C. =item How do I install a module into my home directory? If you're not the Perl administrator you probably don't have -permission to install a module to its default location. Then you -should install it for your own use into your home directory like so: +permission to install a module to its default location. Ways of handling +this with a B less manual effort on your part are L +and L. + +Otherwise, you can install it for your own use into your home directory +like so: # Non-unix folks, replace ~ with /path/to/your/home/dir perl Makefile.PL INSTALL_BASE=~ @@ -41,7 +46,6 @@ reason, do it the long way. use lib "/path/to/your/home/dir/lib/perl5"; - =item How do I get MakeMaker and Module::Build to install to the same place? Module::Build, as of 0.28, supports two ways to install to the same @@ -99,8 +103,10 @@ Two ways. One is to build the module normally... make make test -...and then set the PERL5LIB environment variable to point at the -blib/lib and blib/arch directories. +...and then use L to point Perl at the built but uninstalled module: + + perl -Mblib script.pl + perl -Mblib -e '...' The other is to install the module in a temporary location. @@ -112,20 +118,66 @@ The other is to install the module in a temporary location. And then set PERL5LIB to F<~/tmp/lib/perl5>. This works well when you have multiple modules to work with. It also ensures that the module goes through its full installation process which may modify it. +Again, L may assist you here. =item PREFIX vs INSTALL_BASE from Module::Build::Cookbook The behavior of PREFIX is complicated and depends closely on how your -Perl is configured. The resulting installation locations will vary from -machine to machine and even different installations of Perl on the same machine. -Because of this, its difficult to document where prefix will place your modules. +Perl is configured. The resulting installation locations will vary +from machine to machine and even different installations of Perl on the +same machine. Because of this, its difficult to document where prefix +will place your modules. + +In contrast, INSTALL_BASE has predictable, easy to explain installation +locations. Now that Module::Build and MakeMaker both have INSTALL_BASE +there is little reason to use PREFIX other than to preserve your existing +installation locations. If you are starting a fresh Perl installation we +encourage you to use INSTALL_BASE. If you have an existing installation +installed via PREFIX, consider moving it to an installation structure +matching INSTALL_BASE and using that instead. + +=item Generating *.pm files with substitutions eg of $VERSION + +If you want to configure your module files for local conditions, or to +automatically insert a version number, you can use EUMM's C +capability, where it will automatically run each F<*.PL> it finds to +generate its basename. For instance: + + # Makefile.PL: + require 'common.pl'; + my $version = get_version(); + my @pms = qw(Foo.pm); + WriteMakefile( + NAME => 'Foo', + VERSION => $version, + PM => { map { ($_ => "\$(INST_LIB)/$_") } @pms }, + clean => { FILES => join ' ', @pms }, + ); -In contrast, INSTALL_BASE has predictable, easy to explain installation locations. -Now that Module::Build and MakeMaker both have INSTALL_BASE there is little reason -to use PREFIX other than to preserve your existing installation locations. If you -are starting a fresh Perl installation we encourage you to use INSTALL_BASE. If -you have an existing installation installed via PREFIX, consider moving it to an -installation structure matching INSTALL_BASE and using that instead. + # common.pl: + sub get_version { '0.04' } + sub process { my $v = get_version(); s/__VERSION__/$v/g; } + 1; + + # Foo.pm.PL: + require 'common.pl'; + $_ = join '', ; + process(); + my $file = shift; + open my $fh, '>', $file or die "$file: $!"; + print $fh $_; + __DATA__ + package Foo; + our $VERSION = '__VERSION__'; + 1; + +You may notice that C is not specified above, since the default +of mapping each .PL file to its basename works well. + +If the generated module were architecture-specific, you could replace +C<$(INST_LIB)> above with C<$(INST_ARCHLIB)>, although if you locate +modules under F, that would involve ensuring any C in front +of the module location were removed. =back @@ -184,16 +236,16 @@ Its primary advantages are: =back -Module::Build was long the official heir apparent to MakeMaker. The rate of -both its development and adoption has slowed in recent years, though, and it is -unclear what the future holds for it. That said, Module::Build set the stage -for I to become the heir to MakeMaker. MakeMaker's maintainers have -long said that it is a dead end and should be kept functioning, but not -extended with new features. It's complicated enough as it is! +Module::Build was long the official heir apparent to MakeMaker. The +rate of both its development and adoption has slowed in recent years, +though, and it is unclear what the future holds for it. That said, +Module::Build set the stage for I to become the heir to +MakeMaker. MakeMaker's maintainers have long said that it is a dead +end and should be kept functioning, while being cautious about extending +with new features. =back - =head2 Module Writing =over 4 @@ -207,8 +259,14 @@ modules in your dist, $VERSION is really just bookkeeping and all that's important is it goes up every time the module is changed. Doing this by hand is a pain and you often forget. -Simplest way to do it automatically is to use your version control -system's revision number (you are using version control, right?). +Probably the easiest way to do this is using F in +L: + + perl-reversion -bump + +If your version control system supports revision numbers (git doesn't +easily), the simplest way to do it automatically is to use its revision +number (you are using version control, right?). In CVS, RCS and SVN you use $Revision$ (see the documentation of your version control system for details). Every time the file is checked @@ -300,7 +358,7 @@ do that. Use at your own risk. Have fun blowing holes in your foot. We recommend ptar from Archive::Tar not older than 1.66 with '-C' option. -=item Which zip should I use on Windows for '[nd]make zipdist'? +=item Which zip should I use on Windows for '[ndg]make zipdist'? We recommend InfoZIP: L @@ -309,9 +367,7 @@ We recommend InfoZIP: L =head2 XS -=over 4 - -=item How do I prevent "object version X.XX does not match bootstrap parameter Y.YY" errors? +=head3 How do I prevent "object version X.XX does not match bootstrap parameter Y.YY" errors? XS code is very sensitive to the module version number and will complain if the version number in your Perl module doesn't match. If @@ -326,12 +382,28 @@ WriteMakefile() arguments. depend => { '$(FIRST_MAKEFILE)' => '$(VERSION_FROM)' } -=item How do I make two or more XS files coexist in the same directory? +=head3 How do I make two or more XS files coexist in the same directory? Sometimes you need to have two and more XS files in the same package. -One way to go is to put them into separate directories, but sometimes -this is not the most suitable solution. The following technique allows -you to put two (and more) XS files in the same directory. +There are three ways: C, separate directories, and bootstrapping +one XS from another. + +=head4 XSMULTI + +Structure your modules so they are all located under F, such that +C is in F and F, etc. Have your +top-level C set the variable C to a true value. + +Er, that's it. + +=head4 Separate directories + +Put each XS files into separate directories, each with their own +F. Make sure each of those Fs has the correct +C, C, C etc. You will need to make sure the top-level +F refers to each of these using C. + +=head4 Bootstrapping Let's assume that we have a package C, which includes C and C modules each having a separate XS @@ -446,12 +518,113 @@ And of course a very basic test: This tip has been brought to you by Nick Ing-Simmons and Stas Bekman. +An alternative way to achieve this can be seen in L +and L. + =back +=head1 DESIGN + +=head2 MakeMaker object hierarchy (simplified) + +What most people need to know (superclasses on top.) + + ExtUtils::MM_Any + | + ExtUtils::MM_Unix + | + ExtUtils::MM_{Current OS} + | + ExtUtils::MakeMaker + | + MY + +The object actually used is of the class MY which allows you to +override bits of MakeMaker inside your Makefile.PL by declaring +MY::foo() methods. + +=head2 MakeMaker object hierarchy (real) + +Here's how it really works: + + ExtUtils::MM_Any + | + ExtUtils::MM_Unix + | + ExtUtils::Liblist::Kid ExtUtils::MM_{Current OS} (if necessary) + | | + ExtUtils::Liblist ExtUtils::MakeMaker | + | | | + | | |----------------------- + ExtUtils::MM + | | + ExtUtils::MY MM (created by ExtUtils::MM) + | | + MY (created by ExtUtils::MY) | + . | + (mixin) | + . | + PACK### (created each call to ExtUtils::MakeMaker->new) + +NOTE: Yes, this is a mess. See +L +for some history. + +NOTE: When ExtUtils::MM is loaded it chooses a superclass for MM from +amongst the ExtUtils::MM_* modules based on the current operating +system. + +NOTE: ExtUtils::MM_{Current OS} represents one of the ExtUtils::MM_* +modules except ExtUtils::MM_Any chosen based on your operating system. + +NOTE: The main object used by MakeMaker is a PACK### object, *not* +ExtUtils::MakeMaker. It is, effectively, a subclass of MY, +ExtUtils::Makemaker, ExtUtils::Liblist and ExtUtils::MM_{Current OS} + +NOTE: The methods in MY are simply copied into PACK### rather than +MY being a superclass of PACK###. I don't remember the rationale. + +NOTE: ExtUtils::Liblist should be removed from the inheritence hiearchy +and simply be called as functions. + +NOTE: Modules like File::Spec and Exporter have been omitted for clarity. + + +=head2 The MM_* hierarchy + + MM_Win95 MM_NW5 + \ / + MM_BeOS MM_Cygwin MM_OS2 MM_VMS MM_Win32 MM_DOS MM_UWIN + \ | | | / / / + ------------------------------------------------ + | | + MM_Unix | + | | + MM_Any + +NOTE: Each direct MM_Unix subclass is also an MM_Any subclass. This +is a temporary hack because MM_Unix overrides some MM_Any methods with +Unix specific code. It allows the non-Unix modules to see the +original MM_Any implementations. + +NOTE: Modules like File::Spec and Exporter have been omitted for clarity. + =head1 PATCHING If you have a question you'd like to see added to the FAQ (whether or -not you have the answer) please send it to makemaker@perl.org. +not you have the answer) please either: + +=over 2 + +=item * make a pull request on the MakeMaker github repository + +=item * raise a issue on the MakeMaker github repository + +=item * file an RT ticket + +=item * email makemaker@perl.org + +=back =head1 AUTHOR diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Locale.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Locale.pm index 68fcd4c..21f5974 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Locale.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Locale.pm @@ -1,7 +1,8 @@ package ExtUtils::MakeMaker::Locale; use strict; -our $VERSION = "7.10"; +our $VERSION = "7.18"; +$VERSION = eval $VERSION; use base 'Exporter'; our @EXPORT_OK = qw( @@ -137,7 +138,7 @@ Encode::Alias::define_alias(sub { sub _flush_aliases { no strict 'refs'; - for my $a (keys %Encode::Alias::Alias) { + for my $a (sort keys %Encode::Alias::Alias) { if (defined ${"ENCODING_" . uc($a)}) { delete $Encode::Alias::Alias{$a}; warn "Flushed alias cache for $a" if DEBUG; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Tutorial.pod b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Tutorial.pod index 7e53baa..976345f 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Tutorial.pod +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Tutorial.pod @@ -1,6 +1,7 @@ package ExtUtils::MakeMaker::Tutorial; -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; =head1 NAME diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version.pm index 35cd2ab..a6584c7 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version.pm @@ -10,12 +10,13 @@ package ExtUtils::MakeMaker::version; -use 5.006002; +use 5.006001; use strict; use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv); -$VERSION = '7.10_01'; +$VERSION = '7.18'; +$VERSION = eval $VERSION; $CLASS = 'version'; { diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version/regex.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version/regex.pm index a0213b1..896998e 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version/regex.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version/regex.pm @@ -10,7 +10,8 @@ use strict; use vars qw($VERSION $CLASS $STRICT $LAX); -$VERSION = '7.10_01'; +$VERSION = '7.18'; +$VERSION = eval $VERSION; #--------------------------------------------------------------------------# # Version regexp components diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm index a393329..2a0d463 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm @@ -3,7 +3,8 @@ package ExtUtils::Mkbootstrap; # There's just too much Dynaloader incest here to turn on strict vars. use strict 'refs'; -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; require Exporter; our @ISA = ('Exporter'); @@ -47,7 +48,7 @@ sub Mkbootstrap { my(@all) = (@bsloadlibs, @DynaLoader::dl_resolve_using); my($method) = ''; - if (@all){ + if (@all || (defined $DynaLoader::bscode && length $DynaLoader::bscode)){ open my $bs, ">", "$baseext.bs" or die "Unable to open $baseext.bs: $!"; print "Writing $baseext.bs\n"; @@ -56,13 +57,15 @@ sub Mkbootstrap { print $bs "# Do not edit this file, changes will be lost.\n"; print $bs "# This file was automatically generated by the\n"; print $bs "# Mkbootstrap routine in ExtUtils::Mkbootstrap (v$VERSION).\n"; - print $bs "\@DynaLoader::dl_resolve_using = "; - # If @all contains names in the form -lxxx or -Lxxx then it's asking for - # runtime library location so we automatically add a call to dl_findfile() - if (" @all" =~ m/ -[lLR]/){ - print $bs " dl_findfile(qw(\n @all\n ));\n"; - }else{ - print $bs " qw(@all);\n"; + if (@all) { + print $bs "\@DynaLoader::dl_resolve_using = "; + # If @all contains names in the form -lxxx or -Lxxx then it's asking for + # runtime library location so we automatically add a call to dl_findfile() + if (" @all" =~ m/ -[lLR]/){ + print $bs " dl_findfile(qw(\n @all\n ));\n"; + } else { + print $bs " qw(@all);\n"; + } } # write extra code if *_BS says so print $bs $DynaLoader::bscode if $DynaLoader::bscode; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm index b80310e..582b290 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm @@ -10,7 +10,8 @@ use Config; our @ISA = qw(Exporter); our @EXPORT = qw(&Mksymlists); -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; sub Mksymlists { my(%spec) = @_; @@ -135,7 +136,7 @@ sub _write_win32 { open( my $def, ">", "$data->{FILE}.def" ) or croak("Can't create $data->{FILE}.def: $!\n"); # put library name in quotes (it could be a keyword, like 'Alias') - if ($Config::Config{'cc'} !~ /^gcc/i) { + if ($Config::Config{'cc'} !~ /\bgcc/i) { print $def "LIBRARY \"$data->{DLBASE}\"\n"; } print $def "EXPORTS\n "; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm index 6f5d870..3f2795b 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm @@ -3,7 +3,8 @@ package ExtUtils::testlib; use strict; use warnings; -our $VERSION = '7.10_01'; +our $VERSION = '7.18'; +$VERSION = eval $VERSION; use Cwd; use File::Spec; diff --git a/cpan/ExtUtils-MakeMaker/t/01perl_bugs.t b/cpan/ExtUtils-MakeMaker/t/01perl_bugs.t index 618dc09..71d29b6 100644 --- a/cpan/ExtUtils-MakeMaker/t/01perl_bugs.t +++ b/cpan/ExtUtils-MakeMaker/t/01perl_bugs.t @@ -7,7 +7,7 @@ use warnings; use lib 't/lib'; -use Test::More; +use Test::More tests => 1; note "The 0.01 / Gconvert bug"; { my $number = 0.01; @@ -21,5 +21,3 @@ or upgrade to a newer version of Perl. END }; } - -done_testing; diff --git a/cpan/ExtUtils-MakeMaker/t/02-xsdynamic.t b/cpan/ExtUtils-MakeMaker/t/02-xsdynamic.t new file mode 100644 index 0000000..5ed28de --- /dev/null +++ b/cpan/ExtUtils-MakeMaker/t/02-xsdynamic.t @@ -0,0 +1,23 @@ +#!/usr/bin/perl -w + +use strict; +use warnings; +use Config; +BEGIN { + chdir 't' or die "chdir(t): $!\n"; + unshift @INC, 'lib/'; +} +use MakeMaker::Test::Utils; +use MakeMaker::Test::Setup::XS; +use Test::More; + +plan skip_all => 'Dynaloading not enabled' if !$Config{usedl} or $Config{usedl} ne 'define'; +plan skip_all => "ExtUtils::CBuilder not installed or couldn't find a compiler" + unless have_compiler(); +my @tests = list_dynamic(); +plan skip_all => "No tests" unless @tests; +plan tests => 6 * @tests; +my $perl = which_perl(); +perl_lib; +$| = 1; +run_tests($perl, @$_) for @tests; diff --git a/cpan/ExtUtils-MakeMaker/t/03-xsstatic.t b/cpan/ExtUtils-MakeMaker/t/03-xsstatic.t new file mode 100644 index 0000000..1d748eb --- /dev/null +++ b/cpan/ExtUtils-MakeMaker/t/03-xsstatic.t @@ -0,0 +1,27 @@ +#!/usr/bin/perl -w + +use strict; +use warnings; +use Config; +BEGIN { + chdir 't' or die "chdir(t): $!\n"; + unshift @INC, 'lib/'; +} +use MakeMaker::Test::Utils; +use MakeMaker::Test::Setup::XS; +use Test::More; + +plan skip_all => "Disabled as broken perl installs give false negative" + # if not static perl, and not author + unless !$Config{usedl} or $ENV{AUTHOR_TESTING}; +plan skip_all => "ExtUtils::CBuilder not installed or couldn't find a compiler" + unless have_compiler(); +plan skip_all => 'Shared perl library' if $Config{useshrplib} eq 'true'; +plan skip_all => $^O if $^O =~ m!^(MSWin32|cygwin|haiku)$!; +my @tests = list_static(); +plan skip_all => "No tests" unless @tests; +plan tests => 6 * @tests; +my $perl = which_perl(); +perl_lib; +$| = 1; +run_tests($perl, @$_) for @tests; diff --git a/cpan/ExtUtils-MakeMaker/t/FIRST_MAKEFILE.t b/cpan/ExtUtils-MakeMaker/t/FIRST_MAKEFILE.t index 7218dd3..cb8d0db 100644 --- a/cpan/ExtUtils-MakeMaker/t/FIRST_MAKEFILE.t +++ b/cpan/ExtUtils-MakeMaker/t/FIRST_MAKEFILE.t @@ -4,20 +4,22 @@ BEGIN { unshift @INC, 't/lib'; } -use File::Temp qw[tempdir]; -my $tmpdir = tempdir( DIR => 't', CLEANUP => 1 ); -chdir $tmpdir; - use strict; use Test::More tests => 7; use MakeMaker::Test::Setup::BFD; use MakeMaker::Test::Utils; +chdir 't'; +perl_lib; # sets $ENV{PERL5LIB} relative to t/ + +use File::Temp qw[tempdir]; +my $tmpdir = tempdir( DIR => '../t', CLEANUP => 1 ); +use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup +chdir $tmpdir; + my $perl = which_perl(); my $make = make_run(); -perl_lib(); - ok( setup_recurs(), 'setup' ); END { diff --git a/cpan/ExtUtils-MakeMaker/t/INST.t b/cpan/ExtUtils-MakeMaker/t/INST.t index 91058bb..3562162 100644 --- a/cpan/ExtUtils-MakeMaker/t/INST.t +++ b/cpan/ExtUtils-MakeMaker/t/INST.t @@ -18,12 +18,14 @@ use File::Spec; use TieOut; use Config; +chdir 't'; +perl_lib; # sets $ENV{PERL5LIB} relative to t/ + use File::Temp qw[tempdir]; -my $tmpdir = tempdir( DIR => 't', CLEANUP => 1 ); +my $tmpdir = tempdir( DIR => '../t', CLEANUP => 1 ); +use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup chdir $tmpdir; -perl_lib; - $| = 1; my $Makefile = makefile_name; @@ -47,8 +49,8 @@ my $mm = WriteMakefile( PERL_CORE => $ENV{PERL_CORE}, ); like( $stdout->read, qr{ - Generating\ a\ \w+?-style\ $Makefile\n - Writing\ $Makefile\ for\ Big::Liar\n + (?:Generating\ a\ \w+?-style\ $Makefile\n)? + (?:Writing\ $Makefile\ for\ Big::Liar\n)? (?:Writing\ MYMETA.yml\ and\ MYMETA.json\n)? Big::Liar's\ vars\n INST_LIB\ =\ \S+\n @@ -135,8 +137,8 @@ $mm = WriteMakefile( INST_MAN1DIR => 'none', ); like( $stdout->read, qr{ - Generating\ a\ \w+?-style\ $Makefile\n - Writing\ $Makefile\ for\ Big::Liar\n + (?:Generating\ a\ \w+?-style\ $Makefile\n)? + (?:Writing\ $Makefile\ for\ Big::Liar\n)? (?:Writing\ MYMETA.yml\ and\ MYMETA.json\n)? Big::Liar's\ vars\n INST_LIB\ =\ \S+\n diff --git a/cpan/ExtUtils-MakeMaker/t/INSTALL_BASE.t b/cpan/ExtUtils-MakeMaker/t/INSTALL_BASE.t index fc31611..6939811 100644 --- a/cpan/ExtUtils-MakeMaker/t/INSTALL_BASE.t +++ b/cpan/ExtUtils-MakeMaker/t/INSTALL_BASE.t @@ -15,33 +15,40 @@ $CLEANUP &&= 1; # so always 1 or numerically 0 use MakeMaker::Test::Utils; use MakeMaker::Test::Setup::BFD; -use Test::More; use Config; use ExtUtils::MM; -plan !MM->can_run(make()) && $ENV{PERL_CORE} && $Config{'usecrosscompile'} +use Test::More + !MM->can_run(make()) && $ENV{PERL_CORE} && $Config{'usecrosscompile'} ? (skip_all => "cross-compiling and make not available") - : (tests => 3 + $CLEANUP + @INSTDIRS * (15 + $CLEANUP)); + : (); +plan tests => 4 + $CLEANUP + @INSTDIRS * (15 + $CLEANUP); my $Is_VMS = $^O eq 'VMS'; my $perl = which_perl(); +chdir 't'; +perl_lib; # sets $ENV{PERL5LIB} relative to t/ + use File::Temp qw[tempdir]; -my $tmpdir = tempdir( DIR => 't', CLEANUP => $CLEANUP ); +my $tmpdir = tempdir( DIR => '../t', CLEANUP => $CLEANUP ); +use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup chdir $tmpdir; -perl_lib; - -ok( setup_recurs(), 'setup' ); +my $SPACEDIR = 'space dir'; +ok( setup_recurs($SPACEDIR), 'setup' ); END { ok( chdir File::Spec->updir, 'chdir updir' ); + ok( chdir File::Spec->updir, 'chdir updir again' ); ok( teardown_recurs(), 'teardown' ) if $CLEANUP; map { rmtree $_ } @INSTDIRS if $CLEANUP; } -ok( chdir('Big-Dummy'), "chdir'd to Big-Dummy") || diag("chdir failed; $!"); +ok( chdir(File::Spec->catdir($SPACEDIR, 'Big-Dummy')), "chdir'd to Big-Dummy") || diag("chdir failed; $!"); for my $instdir (@INSTDIRS) { + $instdir = File::Spec->rel2abs($instdir); + $instdir = VMS::Filespec::unixpath($instdir) if $Is_VMS; my @mpl_out = run(qq{$perl Makefile.PL "INSTALL_BASE=$instdir"}); cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) || diff --git a/cpan/ExtUtils-MakeMaker/t/INST_PREFIX.t b/cpan/ExtUtils-MakeMaker/t/INST_PREFIX.t index e8de7c6..5f7d395 100644 --- a/cpan/ExtUtils-MakeMaker/t/INST_PREFIX.t +++ b/cpan/ExtUtils-MakeMaker/t/INST_PREFIX.t @@ -20,12 +20,14 @@ use ExtUtils::MakeMaker::Config; my $Is_VMS = $^O eq 'VMS'; +chdir 't'; +perl_lib; # sets $ENV{PERL5LIB} relative to t/ + use File::Temp qw[tempdir]; -my $tmpdir = tempdir( DIR => 't', CLEANUP => 1 ); +my $tmpdir = tempdir( DIR => '../t', CLEANUP => 1 ); +use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup chdir $tmpdir; -perl_lib; - $| = 1; my $Makefile = makefile_name; @@ -51,8 +53,8 @@ my $mm = WriteMakefile( ); like( $stdout->read, qr{ - Generating\ a\ \w+?-style\ $Makefile\n - Writing\ $Makefile\ for\ Big::Liar\n + (?:Generating\ a\ \w+?-style\ $Makefile\n)? + (?:Writing\ $Makefile\ for\ Big::Liar\n)? (?:Writing\ MYMETA.yml\ and\ MYMETA.json\n)? Big::Liar's\ vars\n INST_LIB\ =\ \S+\n @@ -83,8 +85,8 @@ $mm = WriteMakefile( PREFIX => $PREFIX, ); like( $stdout->read, qr{ - Generating\ a\ \w+?-style\ $Makefile\n - Writing\ $Makefile\ for\ Big::Liar\n + (?:Generating\ a\ \w+?-style\ $Makefile\n)? + (?:Writing\ $Makefile\ for\ Big::Liar\n)? (?:Writing\ MYMETA.yml\ and\ MYMETA.json\n)? Big::Liar's\ vars\n INST_LIB\ =\ \S+\n diff --git a/cpan/ExtUtils-MakeMaker/t/MM_Cygwin.t b/cpan/ExtUtils-MakeMaker/t/MM_Cygwin.t index 0655d17..4e7336c 100644 --- a/cpan/ExtUtils-MakeMaker/t/MM_Cygwin.t +++ b/cpan/ExtUtils-MakeMaker/t/MM_Cygwin.t @@ -74,7 +74,7 @@ unlike( $MM->manifypods(), qr/foo/, $MM->{MAN3PODS} = { foo => 'foo.1' }; my $res = $MM->manifypods(); -like( $res, qr/pure_all.*foo.*foo.1/s, '... should add MAN3PODS targets' ); +like( $res, qr/manifypods.*foo.*foo.1/s, '... should add MAN3PODS targets' ); # init_linker diff --git a/cpan/ExtUtils-MakeMaker/t/MM_NW5.t b/cpan/ExtUtils-MakeMaker/t/MM_NW5.t index 383e6d9..447abd2 100644 --- a/cpan/ExtUtils-MakeMaker/t/MM_NW5.t +++ b/cpan/ExtUtils-MakeMaker/t/MM_NW5.t @@ -131,7 +131,6 @@ delete $ENV{PATHEXT} unless $had_pathext; $mm_w32->{$key} = ''; } my $s_PM = join( " \\\n\t", sort keys %{$mm_w32->{PM}} ); - my $k_PM = join( " \\\n\t", %{$mm_w32->{PM}} ); like( $mm_w32->constants(), qr|^NAME\ =\ TestMM_NW5\s+VERSION\ =\ 1\.00.+ @@ -139,7 +138,6 @@ delete $ENV{PATHEXT} unless $had_pathext; MM_VERSION\ =\ \Q$ExtUtils::MakeMaker::VERSION\E.+ VERSION_FROM\ =\ TestMM_NW5.+ TO_INST_PM\ =\ \Q$s_PM\E\s+ - PM_TO_BLIB\ =\ \Q$k_PM\E |xs, 'constants()' ); } diff --git a/cpan/ExtUtils-MakeMaker/t/MM_OS2.t b/cpan/ExtUtils-MakeMaker/t/MM_OS2.t index f0a3889..3af343d 100644 --- a/cpan/ExtUtils-MakeMaker/t/MM_OS2.t +++ b/cpan/ExtUtils-MakeMaker/t/MM_OS2.t @@ -268,6 +268,6 @@ is( $mm->{EXPORT_LIST}, '$(BASEEXT).def', END { use File::Path; - rmtree('tmp_imp'); + rmtree('tmp_imp') if -e 'tmp_imp'; unlink 'tmpimp.imp'; } diff --git a/cpan/ExtUtils-MakeMaker/t/MM_Unix.t b/cpan/ExtUtils-MakeMaker/t/MM_Unix.t index ed07691..9a8d18f 100644 --- a/cpan/ExtUtils-MakeMaker/t/MM_Unix.t +++ b/cpan/ExtUtils-MakeMaker/t/MM_Unix.t @@ -98,7 +98,6 @@ foreach ( qw / ppd prefixify processPL - quote_paren realclean static static_lib @@ -223,3 +222,10 @@ foreach (qw/ EXPORT_LIST PERL_ARCHIVE PERL_ARCHIVE_AFTER /) like( $t->{CCFLAGS}, qr/\-DMY_THING/, 'cflags retains CCFLAGS' ); } +{ + my @targv = ("var=don't forget about spaces and single quotes"); + local @ARGV = @targv; + my $t = bless { NAME => "Foo", FULLPERL => $0, DIR => [] }, $class; + $t->makeaperl( TARGET => "Tgt" ); + is_deeply( \@ARGV, \@targv, 'ARGV is not polluted by makeaperl' ); +} diff --git a/cpan/ExtUtils-MakeMaker/t/MM_Win32.t b/cpan/ExtUtils-MakeMaker/t/MM_Win32.t index fee1e5e..bac36bf 100644 --- a/cpan/ExtUtils-MakeMaker/t/MM_Win32.t +++ b/cpan/ExtUtils-MakeMaker/t/MM_Win32.t @@ -13,6 +13,7 @@ BEGIN { plan skip_all => 'This is not Win32'; } } +plan 'no_plan'; # BinGOs says there are 63 but I can only see 62 use Config; use File::Spec; @@ -146,7 +147,6 @@ note "init_others creates expected keys"; { $mm_w32->init_xs; my $s_PM = join( " \\\n\t", sort keys %{$mm_w32->{PM}} ); - my $k_PM = join( " \\\n\t", %{$mm_w32->{PM}} ); my $constants = $mm_w32->constants; @@ -156,7 +156,6 @@ note "init_others creates expected keys"; { qr|^MAKEMAKER \s* = \s* \Q$INC{'ExtUtils/MakeMaker.pm'}\E \s* $|xms, qr|^MM_VERSION \s* = \s* \Q$ExtUtils::MakeMaker::VERSION\E \s* $|xms, qr|^TO_INST_PM \s* = \s* \Q$s_PM\E \s* $|xms, - qr|^PM_TO_BLIB \s* = \s* \Q$k_PM\E \s* $|xms, ) { like( $constants, $regex, 'constants() check' ); @@ -281,7 +280,7 @@ unlink "${script_name}$script_ext" if -f "${script_name}$script_ext"; my @cc_env = ExtUtils::MM_Win32::_identify_compiler_environment( $config ); - my %cc_env = ( BORLAND => $cc_env[0], GCC => $cc_env[1], DLLTOOL => $cc_env[2] ); + my %cc_env = ( BORLAND => $cc_env[0], GCC => $cc_env[1], MSVC => $cc_env[2] ); return \%cc_env; } @@ -302,16 +301,6 @@ unlink "${script_name}$script_ext" if -f "${script_name}$script_ext"; my @tests = ( { config => {}, - key => 'DLLTOOL', expect => 'dlltool', - desc => 'empty dlltool defaults to "dlltool"', - }, - { - config => { dlltool => 'test' }, - key => 'DLLTOOL', expect => 'test', - desc => 'dlltool value is taken over verbatim from %Config, if set', - }, - { - config => {}, key => 'GCC', expect => 0, desc => 'empty cc is not recognized as gcc', }, @@ -347,8 +336,8 @@ unlink "${script_name}$script_ext" if -f "${script_name}$script_ext"; }, { config => { cc => 'C:/Borland/bin/bcc.exe' }, - key => 'BORLAND', expect => 0, - desc => 'fully qualified borland cc is not recognized', + key => 'BORLAND', expect => 1, + desc => 'fully qualified borland cc is recognized', }, { config => { cc => 'bcc-1.exe' }, @@ -365,10 +354,6 @@ unlink "${script_name}$script_ext" if -f "${script_name}$script_ext"; _check_cc_id_value($_) for @tests; } - -done_testing; - - package FakeOut; sub TIEHANDLE { diff --git a/cpan/ExtUtils-MakeMaker/t/MakeMaker_Parameters.t b/cpan/ExtUtils-MakeMaker/t/MakeMaker_Parameters.t index 8e921bd..b0100e6 100644 --- a/cpan/ExtUtils-MakeMaker/t/MakeMaker_Parameters.t +++ b/cpan/ExtUtils-MakeMaker/t/MakeMaker_Parameters.t @@ -11,7 +11,7 @@ use strict; use warnings; use ExtUtils::MakeMaker; -use Test::More; +use Test::More tests => 6; my $mm = bless {}, "MM"; @@ -62,5 +62,3 @@ process_cmp # NAME => q[Foo] # PREREQ_PM => { Baz=>q[0.12], Foo::Bar=>q[1.23], Long=>q[1.45], Short=>q[0] } EXPECT - -done_testing(); diff --git a/cpan/ExtUtils-MakeMaker/t/Mkbootstrap.t b/cpan/ExtUtils-MakeMaker/t/Mkbootstrap.t index db061a4..81e49c0 100644 --- a/cpan/ExtUtils-MakeMaker/t/Mkbootstrap.t +++ b/cpan/ExtUtils-MakeMaker/t/Mkbootstrap.t @@ -75,7 +75,7 @@ SKIP: { chmod 0444, 'dasboot.bs'; SKIP: { - skip("cannot write readonly files", 1) if -w 'dasboot.bs'; + skip("cannot write readonly files", 1) if -w 'dasboot.bs' || $^O eq 'cygwin'; eval{ Mkbootstrap('dasboot', 1) }; like( $@, qr/Unable to open dasboot\.bs/, 'should die given bad filename' ); diff --git a/cpan/ExtUtils-MakeMaker/t/PL_FILES.t b/cpan/ExtUtils-MakeMaker/t/PL_FILES.t index f96186f..51aed5e 100644 --- a/cpan/ExtUtils-MakeMaker/t/PL_FILES.t +++ b/cpan/ExtUtils-MakeMaker/t/PL_FILES.t @@ -5,33 +5,70 @@ BEGIN { } use strict; +use warnings; -use File::Spec; -use File::Temp qw[tempdir]; -use MakeMaker::Test::Setup::PL_FILES; use MakeMaker::Test::Utils; use Config; -use Test::More; use ExtUtils::MM; -plan !MM->can_run(make()) && $ENV{PERL_CORE} && $Config{'usecrosscompile'} +use Test::More + !MM->can_run(make()) && $ENV{PERL_CORE} && $Config{'usecrosscompile'} ? (skip_all => "cross-compiling and make not available") - : (tests => 9); + : (tests => 10); +use File::Spec; +use File::Temp qw[tempdir]; +use File::Path; my $perl = which_perl(); my $make = make_run(); -perl_lib(); +chdir 't'; +perl_lib; # sets $ENV{PERL5LIB} relative to t/ -my $tmpdir = tempdir( DIR => 't', CLEANUP => 1 ); +my $tmpdir = tempdir( DIR => '../t', CLEANUP => 1 ); +use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup chdir $tmpdir; -setup; +my $DIRNAME = 'PL-Module'; +my %FILES = ( + 'Makefile.PL' => <<'END', +use ExtUtils::MakeMaker; +# A module for testing PL_FILES +WriteMakefile( + NAME => 'PL::Module', + PL_FILES => { 'single.PL' => 'single.out', + 'multi.PL' => [qw(1.out 2.out)], + 'Bar_pm.PL' => '$(INST_LIB)/PL/Bar.pm', + 'Bar2.pm.PL' => 'Bar2.pm', + }, +); + +package MY; +sub init_PM { + my ($self) = @_; + $self->SUPER::init_PM; + $self->{PM}{'Bar2.pm'} = '$(INST_LIBDIR)/Bar2.pm'; # PDL does this in WM args +} +END + + 'single.PL' => _gen_pl_files(), + 'multi.PL' => _gen_pl_files(), + 'Bar_pm.PL' => _gen_pm_files(), + 'Bar2.pm.PL' => _gen_pm_files(), + 'lib/PL/Foo.pm' => <<'END', +# Module to load to ensure PL_FILES have blib in @INC. +package PL::Foo; +sub bar { 42 } +1; +END +); + +hash2files($DIRNAME, \%FILES); END { ok( chdir File::Spec->updir ); - ok( teardown ); + ok( rmtree($DIRNAME) ); } -ok chdir('PL_FILES-Module'); +ok chdir($DIRNAME); run(qq{$perl Makefile.PL}); cmp_ok( $?, '==', 0 ); @@ -39,6 +76,54 @@ cmp_ok( $?, '==', 0 ); my $make_out = run("$make"); is( $?, 0 ) || diag $make_out; -foreach my $file (qw(single.out 1.out 2.out blib/lib/PL/Bar.pm)) { +foreach my $file (qw(single.out 1.out 2.out blib/lib/PL/Bar.pm blib/lib/PL/Bar2.pm)) { ok( -e $file, "$file was created" ); } + +sub _gen_pl_files { + my $test = <<'END'; +#!/usr/bin/perl -w + +# Ensure we have blib in @INC +use PL::Foo; +die unless PL::Foo::bar() == 42; + +# Had a bug where PL_FILES weren't sent the file to generate +die "argv empty\n" unless @ARGV; +die "too many in argv: @ARGV\n" unless @ARGV == 1; + +my $file = $ARGV[0]; +open OUT, ">$file" or die $!; + +print OUT "Testing\n"; +close OUT +END + + $test =~ s/^\n//; + + return $test; +} + +sub _gen_pm_files { + my $test = <<'END'; +#!/usr/bin/perl -w + +# Ensure we do NOT have blib in @INC when building a module +eval { require PL::Foo; }; +#die $@ unless $@ =~ m{^Can't locate PL/Foo.pm in \@INC }; + +# Had a bug where PL_FILES weren't sent the file to generate +die "argv empty\n" unless @ARGV; +die "too many in argv: @ARGV\n" unless @ARGV == 1; + +my $file = $ARGV[0]; +open OUT, ">$file" or die $!; + +print OUT "Testing\n"; +close OUT +END + + $test =~ s/^\n//; + + return $test; +} diff --git a/cpan/ExtUtils-MakeMaker/t/WriteEmptyMakefile.t b/cpan/ExtUtils-MakeMaker/t/WriteEmptyMakefile.t index 7a86fa1..662c48d 100644 --- a/cpan/ExtUtils-MakeMaker/t/WriteEmptyMakefile.t +++ b/cpan/ExtUtils-MakeMaker/t/WriteEmptyMakefile.t @@ -8,6 +8,7 @@ BEGIN { use File::Temp qw[tempdir]; my $tmpdir = tempdir( DIR => 't', CLEANUP => 1 ); +use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup chdir $tmpdir; use strict; diff --git a/cpan/ExtUtils-MakeMaker/t/basic.t b/cpan/ExtUtils-MakeMaker/t/basic.t index f58211a..c98e28c 100644 --- a/cpan/ExtUtils-MakeMaker/t/basic.t +++ b/cpan/ExtUtils-MakeMaker/t/basic.t @@ -20,11 +20,11 @@ use utf8; use MakeMaker::Test::Utils; use MakeMaker::Test::Setup::BFD; use Config; -use Test::More; use ExtUtils::MM; -plan !MM->can_run(make()) && $ENV{PERL_CORE} && $Config{'usecrosscompile'} +use Test::More + !MM->can_run(make()) && $ENV{PERL_CORE} && $Config{'usecrosscompile'} ? (skip_all => "cross-compiling and make not available") - : (tests => 171); + : (tests => 186); use File::Find; use File::Spec; use File::Path; @@ -55,28 +55,31 @@ END { } } -my $tmpdir = tempdir( DIR => 't', CLEANUP => 1 ); -chdir $tmpdir; +chdir 't'; +perl_lib; # sets $ENV{PERL5LIB} relative to t/ -perl_lib; +my $tmpdir = tempdir( DIR => '../t', CLEANUP => 1 ); +use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup +chdir $tmpdir; my $Touch_Time = calibrate_mtime(); $| = 1; ok( setup_recurs(), 'setup' ); -END { - ok chdir File::Spec->updir or die; - ok teardown_recurs, "teardown"; -} ok( chdir('Big-Dummy'), "chdir'd to Big-Dummy" ) || diag("chdir failed: $!"); -sub extrachar { $] > 5.008 && !$ENV{PERL_CORE} ? utf8::decode(my $c='Å¡') : 's' } +sub extrachar { + return 's' + if 1; # until Perl gains native support for Unicode filenames +# if $] <= 5.008 || $ENV{PERL_CORE} +# || $^O =~ /bsd|dragonfly|mswin32/i; + 'Å¡'; +} my $DUMMYINST = '../dummy-in'.extrachar().'tall'; my @mpl_out = run(qq{$perl Makefile.PL "PREFIX=$DUMMYINST"}); -END { rmtree $DUMMYINST; } cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) || diag(@mpl_out); @@ -96,8 +99,6 @@ ok( -e $makefile, 'Makefile exists' ); my $mtime = (stat($makefile))[9]; cmp_ok( $Touch_Time, '<=', $mtime, ' been touched' ); -END { unlink makefile_name(), makefile_backup() } - my $make = make_run(); { @@ -108,8 +109,6 @@ my $make = make_run(); ok( -s 'MANIFEST', ' not empty' ); } -END { unlink 'MANIFEST'; } - my $ppd_out = run("$make ppd"); is( $?, 0, ' exited normally' ) || diag $ppd_out; ok( open(PPD, 'Big-Dummy.ppd'), ' .ppd file generated' ); @@ -138,8 +137,6 @@ like( $ppd_html, qr{^\s*}m, like( $ppd_html, qr{^\s*}m, ' '); like( $ppd_html, qr{^\s*}m, ' '); like( $ppd_html, qr{^\s*}m, ' '); -END { unlink 'Big-Dummy.ppd' } - my $test_out = run("$make test"); like( $test_out, qr/All tests successful/, 'make test' ); @@ -150,10 +147,28 @@ is( $?, 0, ' exited normally' ) || my $make_test_verbose = make_macro($make, 'test', TEST_VERBOSE => 1); $test_out = run("$make_test_verbose"); like( $test_out, qr/ok \d+ - TEST_VERBOSE/, 'TEST_VERBOSE' ); +like( $test_out, qr/ok \d+ - testing test.pl/, 'test.pl' ); # in test.pl +like( $test_out, qr/ok \d+ - testing t\/\*.t/, 't/*.t' ); # in *.t like( $test_out, qr/All tests successful/, ' successful' ); is( $?, 0, ' exited normally' ) || diag $test_out; +# Test 'make testdb TEST_FILE=t/compile.t' +# TESTDB_SW override is because perl -d is too clever for me to outwit +my $make_testdb_file = make_macro( + $make, + 'testdb', + TEST_FILE => 't/compile.t', + TESTDB_SW => '-Ixyzzy', +); +$test_out = run($make_testdb_file); +unlike( $test_out, qr/harness/, 'no harness' ); +unlike( $test_out, qr/sanity\.t/, 'no wrong test' ); +like( $test_out, qr/compile\.t/, 'get right test' ); +like( $test_out, qr/xyzzy/, 'signs of TESTDB_SW' ); +is( $?, 0, ' exited normally' ) || + diag $test_out; + # now simulate what Module::Install does, and edit $(PERL) to add flags open my $fh, '<', $makefile; my $mtext = join '', <$fh>; @@ -168,7 +183,7 @@ is( $?, 0, 'install' ) || diag $install_out; like( $install_out, qr/^Installing /m ); sub check_dummy_inst { - my $loc = shift; + my ($loc, $skipsubdir) = @_; my %files = (); find( sub { # do it case-insensitive for non-case preserving OSs @@ -178,7 +193,7 @@ sub check_dummy_inst { $files{$file} = $File::Find::name; }, $loc ); ok( $files{'dummy.pm'}, ' Dummy.pm installed' ); - ok( $files{'liar.pm'}, ' Liar.pm installed' ); + ok( $files{'liar.pm'}, ' Liar.pm installed' ) unless $skipsubdir; ok( $files{'program'}, ' program installed' ); ok( $files{'.packlist'}, ' packlist created' ); ok( $files{'perllocal.pod'},' perllocal.pod created' ); @@ -249,22 +264,28 @@ SKIP: { rmtree('other'); } +my ($dist_test_out, $distdir, $meta_yml, $mymeta_yml, $meta_json, $mymeta_json); +SKIP: { + skip 'disttest depends on metafile, which is not run in core', 1 if $ENV{PERL_CORE}; + $dist_test_out = run("$make disttest"); + is( $?, 0, 'disttest' ) || diag($dist_test_out); + + # Test META.yml generation + use ExtUtils::Manifest qw(maniread); + + $distdir = 'Big-Dummy-0.01'; + $distdir =~ s/\./_/g if $Is_VMS; + $meta_yml = "$distdir/META.yml"; + $mymeta_yml = "$distdir/MYMETA.yml"; + $meta_json = "$distdir/META.json"; + $mymeta_json = "$distdir/MYMETA.json"; +} -my $dist_test_out = run("$make disttest"); -is( $?, 0, 'disttest' ) || diag($dist_test_out); - -# Test META.yml generation -use ExtUtils::Manifest qw(maniread); - -my $distdir = 'Big-Dummy-0.01'; -$distdir =~ s/\./_/g if $Is_VMS; -my $meta_yml = "$distdir/META.yml"; -my $mymeta_yml = "$distdir/MYMETA.yml"; -my $meta_json = "$distdir/META.json"; -my $mymeta_json = "$distdir/MYMETA.json"; +note "META file validity"; SKIP: { + skip 'disttest depends on metafile, which is not run in core', 104 if $ENV{PERL_CORE}; -note "META file validity"; { - require CPAN::Meta; + eval { require CPAN::Meta; }; + skip 'Loading CPAN::Meta failed', 104 if $@; ok( !-f 'META.yml', 'META.yml not written to source dir' ); ok( -f $meta_yml, 'META.yml written to dist dir' ); @@ -438,6 +459,27 @@ is( $?, 0, 'realclean' ) || diag($realclean_out); open(STDERR, ">&SAVERR") or die $!; close SAVERR; +# test linkext=>{LINKTYPE=>''} still installs a pure-perl installation +# warning, edits the Makefile.PL so either rewrite after this or do this last +my $file = 'Makefile.PL'; +my $text = slurp $file; +ok(($text =~ s#\);# linkext=>{LINKTYPE=>''},\n$&#), 'successful M.PL edit'); +open $fh, '>', $file or die "$file: $!"; +print $fh $text; +close $fh; +# now do with "Liar" subdir still there +rmtree $DUMMYINST; # so no false positive from before +@mpl_out = run(qq{$perl Makefile.PL "PREFIX=$DUMMYINST"}); +$install_out = run("$make install"); +check_dummy_inst($DUMMYINST); +# now clean, delete "Liar" subdir, do again +$realclean_out = run("$make realclean"); +rmtree 'Liar'; +rmtree $DUMMYINST; # so no false positive from before +@mpl_out = run(qq{$perl Makefile.PL "PREFIX=$DUMMYINST"}); +$install_out = run("$make install"); +check_dummy_inst($DUMMYINST, 1); + sub _normalize { my $hash = shift; diff --git a/cpan/ExtUtils-MakeMaker/t/build_man.t b/cpan/ExtUtils-MakeMaker/t/build_man.t index 47e5f4b..a88ccd2 100644 --- a/cpan/ExtUtils-MakeMaker/t/build_man.t +++ b/cpan/ExtUtils-MakeMaker/t/build_man.t @@ -7,7 +7,7 @@ BEGIN { } use strict; -use Test::More tests => 9; +use Test::More tests => 10; use File::Spec; use File::Temp qw[tempdir]; @@ -22,31 +22,37 @@ use ExtUtils::MakeMaker::Config; # ensure these tests will still work. $Config{installman3dir} = 'none'; -my $tmpdir = tempdir( DIR => 't', CLEANUP => 1 ); -chdir $tmpdir; +chdir 't'; +perl_lib; # sets $ENV{PERL5LIB} relative to t/ -perl_lib(); +my $tmpdir = tempdir( DIR => '../t', CLEANUP => 1 ); +use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup +chdir $tmpdir; ok( setup_recurs(), 'setup' ); END { - ok( chdir File::Spec->updir ); - ok( teardown_recurs(), 'teardown' ); + ok chdir File::Spec->updir, 'chdir updir'; + ok teardown_recurs(), 'teardown'; } ok( chdir 'Big-Dummy', "chdir'd to Big-Dummy" ) || diag("chdir failed: $!"); +my $README = 'README.pod'; +{ open my $fh, '>', $README or die "$README: $!"; } -ok( my $stdout = tie *STDOUT, 'TieOut' ); +ok((my $stdout = tie *STDOUT, 'TieOut'), 'tie stdout'); { local $Config{installman3dir} = File::Spec->catdir(qw(t lib)); - my $mm = WriteMakefile( NAME => 'Big::Dummy', VERSION_FROM => 'lib/Big/Dummy.pm', ); - - ok( keys %{ $mm->{MAN3PODS} } ); + my %got = %{ $mm->{MAN3PODS} }; + # because value too OS-specific + my $delete_key = $^O eq 'VMS' ? '[.lib.Big]Dummy.pm' : 'lib/Big/Dummy.pm'; + ok delete($got{$delete_key}), 'normal man3pod'; + is_deeply \%got, {}, 'no extra man3pod'; } { @@ -55,28 +61,23 @@ ok( my $stdout = tie *STDOUT, 'TieOut' ); VERSION_FROM => 'lib/Big/Dummy.pm', INSTALLMAN3DIR => 'none' ); - - is_deeply( $mm->{MAN3PODS}, {} ); + is_deeply $mm->{MAN3PODS}, {}, 'suppress man3pod with "none"'; } - { my $mm = WriteMakefile( NAME => 'Big::Dummy', VERSION_FROM => 'lib/Big/Dummy.pm', MAN3PODS => {} ); - - is_deeply( $mm->{MAN3PODS}, { } ); + is_deeply $mm->{MAN3PODS}, {}, 'suppress man3pod with {}'; } - { my $mm = WriteMakefile( NAME => 'Big::Dummy', VERSION_FROM => 'lib/Big/Dummy.pm', MAN3PODS => { "Foo.pm" => "Foo.1" } ); - - is_deeply( $mm->{MAN3PODS}, { "Foo.pm" => "Foo.1" } ); + is_deeply $mm->{MAN3PODS}, { "Foo.pm" => "Foo.1" }, 'override man3pod'; } diff --git a/cpan/ExtUtils-MakeMaker/t/cd.t b/cpan/ExtUtils-MakeMaker/t/cd.t index 67dfd98..57da1df 100644 --- a/cpan/ExtUtils-MakeMaker/t/cd.t +++ b/cpan/ExtUtils-MakeMaker/t/cd.t @@ -6,6 +6,7 @@ BEGIN { use File::Temp qw[tempdir]; my $tmpdir = tempdir( DIR => 't', CLEANUP => 1 ); +use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup chdir $tmpdir; my $Is_VMS = $^O eq 'VMS'; diff --git a/cpan/ExtUtils-MakeMaker/t/dir_target.t b/cpan/ExtUtils-MakeMaker/t/dir_target.t index 5cb8e49..95dce69 100644 --- a/cpan/ExtUtils-MakeMaker/t/dir_target.t +++ b/cpan/ExtUtils-MakeMaker/t/dir_target.t @@ -4,6 +4,7 @@ use lib 't/lib'; use File::Temp qw[tempdir]; my $tmpdir = tempdir( DIR => 't', CLEANUP => 1 ); +use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup chdir $tmpdir; use Test::More tests => 1; diff --git a/cpan/ExtUtils-MakeMaker/t/echo.t b/cpan/ExtUtils-MakeMaker/t/echo.t index 6d424d1..872c2b1 100644 --- a/cpan/ExtUtils-MakeMaker/t/echo.t +++ b/cpan/ExtUtils-MakeMaker/t/echo.t @@ -14,11 +14,11 @@ use MakeMaker::Test::Utils; use File::Temp; use Cwd 'abs_path'; -use Test::More; use ExtUtils::MM; -plan !MM->can_run(make()) && $ENV{PERL_CORE} && $Config{'usecrosscompile'} +use Test::More + !MM->can_run(make()) && $ENV{PERL_CORE} && $Config{'usecrosscompile'} ? (skip_all => "cross-compiling and make not available") - : (); + : (tests => 18); #--------------------- Setup @@ -117,5 +117,3 @@ test_for_echo( "Foo\nBar\nBaz\n", "append" ); - -done_testing; diff --git a/cpan/ExtUtils-MakeMaker/t/fixin.t b/cpan/ExtUtils-MakeMaker/t/fixin.t index 72c86ef..061e456 100644 --- a/cpan/ExtUtils-MakeMaker/t/fixin.t +++ b/cpan/ExtUtils-MakeMaker/t/fixin.t @@ -7,10 +7,6 @@ BEGIN { unshift @INC, 't/lib/'; } -use File::Temp qw[tempdir]; -my $tmpdir = tempdir( DIR => 't', CLEANUP => 1 ); -chdir $tmpdir; - use File::Spec; use Test::More tests => 22; @@ -23,8 +19,12 @@ use MakeMaker::Test::Setup::BFD; use ExtUtils::MakeMaker; chdir 't'; +perl_lib; # sets $ENV{PERL5LIB} relative to t/ -perl_lib(); +use File::Temp qw[tempdir]; +my $tmpdir = tempdir( DIR => '../t', CLEANUP => 1 ); +use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup +chdir $tmpdir; ok( setup_recurs(), 'setup' ); END { diff --git a/cpan/ExtUtils-MakeMaker/t/hints.t b/cpan/ExtUtils-MakeMaker/t/hints.t index af4d183..6b3cf73 100644 --- a/cpan/ExtUtils-MakeMaker/t/hints.t +++ b/cpan/ExtUtils-MakeMaker/t/hints.t @@ -7,6 +7,7 @@ use lib 't/lib'; use File::Temp qw[tempdir]; my $tmpdir = tempdir( DIR => 't', CLEANUP => 1 ); +use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup chdir $tmpdir; use File::Spec; @@ -41,7 +42,7 @@ CLOO $mm->check_hints; is( $mm->{CCFLAGS}, 'basset hounds got long ears' ); - is( $stderr, "Processing hints file $Hint_File\n" ); + is( $stderr, "" ); } @@ -61,7 +62,6 @@ CLOO $mm->check_hints; is( $stderr, < 4; use File::Spec; @@ -43,6 +43,3 @@ sub path_is { my $want = $INC{"Test/More.pm"}; path_is( MM->_installed_file_for_module("Test::More"), $want, "Foo::Bar style" ); } - - -done_testing(4); diff --git a/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/BFD.pm b/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/BFD.pm index e5af93c..3d093fc 100644 --- a/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/BFD.pm +++ b/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/BFD.pm @@ -55,16 +55,20 @@ program - this is a program 1; END - 'Big-Dummy/t/compile.t' => <<'END', -print "1..2\n"; + 'Big-Dummy/test.pl' => <<'END', +print "1..1\n"; +print "ok 1 - testing test.pl\n"; +END + 'Big-Dummy/t/compile.t' => <<'END', +print "1..3\n"; print eval "use Big::Dummy; 1;" ? "ok 1\n" : "not ok 1\n"; print "ok 2 - TEST_VERBOSE\n"; +print "ok 3 - testing t/*.t\n"; END 'Big-Dummy/Liar/t/sanity.t' => <<'END', print "1..3\n"; - print eval "use Big::Dummy; 1;" ? "ok 1\n" : "not ok 1\n"; print eval "use Big::Liar; 1;" ? "ok 2\n" : "not ok 2\n"; print "ok 3 - TEST_VERBOSE\n"; @@ -96,11 +100,13 @@ END ); +# if given args, those are inserted as components in resulting path, eg: +# setup_recurs('dir') means instead of creating Big-Dummy/*, dir/Big-Dummy/* sub setup_recurs { - while(my($file, $text) = each %Files) { # Convert to a relative, native file path. - $file = File::Spec->catfile(File::Spec->curdir, split m{\/}, $file); + $file = File::Spec->catfile(File::Spec->curdir, @_, split m{\/}, $file); + $file = File::Spec->rel2abs($file); my $dir = dirname($file); mkpath $dir; diff --git a/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/MPV.pm b/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/MPV.pm deleted file mode 100644 index f30d65f..0000000 --- a/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/MPV.pm +++ /dev/null @@ -1,67 +0,0 @@ -package MakeMaker::Test::Setup::MPV; - -@ISA = qw(Exporter); -require Exporter; -@EXPORT = qw(setup_recurs teardown_recurs); - -use strict; -use File::Path; -use File::Basename; - -my %Files = ( - 'Min-PerlVers/Makefile.PL' => <<'END', -use ExtUtils::MakeMaker; - -WriteMakefile( - NAME => 'Min::PerlVers', - AUTHOR => 'John Doe ', - VERSION_FROM => 'lib/Min/PerlVers.pm', - PREREQ_PM => { strict => 0 }, - MIN_PERL_VERSION => '5.005', -); -END - - 'Min-PerlVers/lib/Min/PerlVers.pm' => <<'END', -package Min::PerlVers; - -$VERSION = 0.05; - -=head1 NAME - -Min::PerlVers - being picky about perl versions - -=cut - -1; -END - -); - - -sub setup_recurs { - while(my($file, $text) = each %Files) { - # Convert to a relative, native file path. - $file = File::Spec->catfile(File::Spec->curdir, split m{\/}, $file); - - my $dir = dirname($file); - mkpath $dir; - open(FILE, ">$file") || die "Can't create $file: $!"; - print FILE $text; - close FILE; - } - - return 1; -} - -sub teardown_recurs { - foreach my $file (keys %Files) { - my $dir = dirname($file); - if( -e $dir ) { - rmtree($dir) || return; - } - } - return 1; -} - - -1; diff --git a/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/PL_FILES.pm b/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/PL_FILES.pm deleted file mode 100644 index f412368..0000000 --- a/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/PL_FILES.pm +++ /dev/null @@ -1,119 +0,0 @@ -package MakeMaker::Test::Setup::PL_FILES; - -@ISA = qw(Exporter); -require Exporter; -@EXPORT = qw(setup teardown); - -use strict; -use File::Path; -use File::Basename; -use File::Spec; -use MakeMaker::Test::Utils; - -my %Files = ( - 'PL_FILES-Module/Makefile.PL' => <<'END', -use ExtUtils::MakeMaker; - -# A module for testing PL_FILES -WriteMakefile( - NAME => 'PL_FILES::Module', - PL_FILES => { 'single.PL' => 'single.out', - 'multi.PL' => [qw(1.out 2.out)], - 'Bar_pm.PL' => '$(INST_LIB)/PL/Bar.pm', - } -); -END - - 'PL_FILES-Module/single.PL' => _gen_pl_files(), - 'PL_FILES-Module/multi.PL' => _gen_pl_files(), - 'PL_FILES-Module/Bar_pm.PL' => _gen_pm_files(), - 'PL_FILES-Module/lib/PL/Foo.pm' => <<'END', -# Module to load to ensure PL_FILES have blib in @INC. -package PL::Foo; -sub bar { 42 } -1; -END - -); - - -sub _gen_pl_files { - my $test = <<'END'; -#!/usr/bin/perl -w - -# Ensure we have blib in @INC -use PL::Foo; -die unless PL::Foo::bar() == 42; - -# Had a bug where PL_FILES weren't sent the file to generate -die "argv empty\n" unless @ARGV; -die "too many in argv: @ARGV\n" unless @ARGV == 1; - -my $file = $ARGV[0]; -open OUT, ">$file" or die $!; - -print OUT "Testing\n"; -close OUT -END - - $test =~ s/^\n//; - - return $test; -} - - -sub _gen_pm_files { - my $test = <<'END'; -#!/usr/bin/perl -w - -# Ensure we do NOT have blib in @INC when building a module -eval { require PL::Foo; }; -#die $@ unless $@ =~ m{^Can't locate PL/Foo.pm in \@INC }; - -# Had a bug where PL_FILES weren't sent the file to generate -die "argv empty\n" unless @ARGV; -die "too many in argv: @ARGV\n" unless @ARGV == 1; - -my $file = $ARGV[0]; -open OUT, ">$file" or die $!; - -print OUT "Testing\n"; -close OUT -END - - $test =~ s/^\n//; - - return $test; -} - - -sub setup { - - while(my($file, $text) = each %Files) { - # Convert to a relative, native file path. - $file = File::Spec->catfile(File::Spec->curdir, split m{\/}, $file); - - my $dir = dirname($file); - mkpath $dir; - open(FILE, ">$file") || die "Can't create $file: $!"; - print FILE $text; - close FILE; - - # ensure file at least 1 second old for makes that assume - # files with the same time are out of date. - my $time = calibrate_mtime(); - utime $time, $time - 1, $file; - } - - return 1; -} - -sub teardown { - foreach my $file (keys %Files) { - my $dir = dirname($file); - if( -e $dir ) { - rmtree($dir) || return; - } - } - return 1; -} diff --git a/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/Problem.pm b/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/Problem.pm deleted file mode 100644 index 59ac151..0000000 --- a/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/Problem.pm +++ /dev/null @@ -1,62 +0,0 @@ -package MakeMaker::Test::Setup::Problem; - -@ISA = qw(Exporter); -require Exporter; -@EXPORT = qw(setup_recurs teardown_recurs); - -use strict; -use File::Path; -use File::Basename; -use MakeMaker::Test::Utils; - -my %Files = ( - 'Problem-Module/Makefile.PL' => <<'END', -use ExtUtils::MakeMaker; - -WriteMakefile( - NAME => 'Problem::Module', -); -END - - 'Problem-Module/subdir/Makefile.PL' => <<'END', -printf "\@INC %s .\n", (grep { $_ eq '.' } @INC) ? "has" : "doesn't have"; - -warn "I think I'm going to be sick\n"; -die "YYYAaaaakkk\n"; -END - -); - - -sub setup_recurs { - while(my($file, $text) = each %Files) { - # Convert to a relative, native file path. - $file = File::Spec->catfile(File::Spec->curdir, split m{\/}, $file); - - my $dir = dirname($file); - mkpath $dir; - open(FILE, ">$file") || die "Can't create $file: $!"; - print FILE $text; - close FILE; - - # ensure file at least 1 second old for makes that assume - # files with the same time are out of date. - my $time = calibrate_mtime(); - utime $time, $time - 1, $file; - } - - return 1; -} - -sub teardown_recurs { - foreach my $file (keys %Files) { - my $dir = dirname($file); - if( -e $dir ) { - rmtree($dir) || return; - } - } - return 1; -} - - -1; diff --git a/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/Recurs.pm b/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/Recurs.pm deleted file mode 100644 index 8694321..0000000 --- a/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/Recurs.pm +++ /dev/null @@ -1,72 +0,0 @@ -package MakeMaker::Test::Setup::Recurs; - -@ISA = qw(Exporter); -require Exporter; -@EXPORT = qw(setup_recurs teardown_recurs); - -use strict; -use File::Path; -use File::Basename; -use MakeMaker::Test::Utils; - -my %Files = ( - 'Recurs/Makefile.PL' => <<'END', -use ExtUtils::MakeMaker; - -WriteMakefile( - NAME => 'Recurs', - VERSION => 1.00, -); -END - - 'Recurs/prj2/Makefile.PL' => <<'END', -use ExtUtils::MakeMaker; - -WriteMakefile( - NAME => 'Recurs::prj2', - VERSION => 1.00, -); -END - - # Check if a test failure in a subdir causes make test to fail - 'Recurs/prj2/t/fail.t' => <<'END', -#!/usr/bin/perl -w - -print "1..1\n"; -print "not ok 1\n"; -END - ); - -sub setup_recurs { - - while(my($file, $text) = each %Files) { - # Convert to a relative, native file path. - $file = File::Spec->catfile(File::Spec->curdir, split m{\/}, $file); - - my $dir = dirname($file); - mkpath $dir; - open(FILE, ">$file") || die "Can't create $file: $!"; - print FILE $text; - close FILE; - - # ensure file at least 1 second old for makes that assume - # files with the same time are out of date. - my $time = calibrate_mtime(); - utime $time, $time - 1, $file; - } - - return 1; -} - -sub teardown_recurs { - foreach my $file (keys %Files) { - my $dir = dirname($file); - if( -e $dir ) { - rmtree($dir) || return; - } - } - return 1; -} - - -1; diff --git a/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/SAS.pm b/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/SAS.pm deleted file mode 100644 index 04d9bd3..0000000 --- a/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/SAS.pm +++ /dev/null @@ -1,67 +0,0 @@ -package MakeMaker::Test::Setup::SAS; - -@ISA = qw(Exporter); -require Exporter; -@EXPORT = qw(setup_recurs teardown_recurs); - -use strict; -use File::Path; -use File::Basename; - -our $dirname='Multiple-Authors'; -my %Files = ( - $dirname.'/Makefile.PL' => <<'END', -use ExtUtils::MakeMaker; - -WriteMakefile( - NAME => 'Multiple::Authors', - AUTHOR => ['John Doe ', 'Jane Doe '], - VERSION_FROM => 'lib/Multiple/Authors.pm', - PREREQ_PM => { strict => 0 }, -); -END - - $dirname.'/lib/Multiple/Authors.pm' => <<'END', -package Multiple::Authors; - -$VERSION = 0.05; - -=head1 NAME - -Multiple::Authors - several authors - -=cut - -1; -END - -); - - -sub setup_recurs { - while(my($file, $text) = each %Files) { - # Convert to a relative, native file path. - $file = File::Spec->catfile(File::Spec->curdir, split m{\/}, $file); - - my $dir = dirname($file); - mkpath $dir; - open(FILE, ">$file") || die "Can't create $file: $!"; - print FILE $text; - close FILE; - } - - return 1; -} - -sub teardown_recurs { - foreach my $file (keys %Files) { - my $dir = dirname($file); - if( -e $dir ) { - rmtree($dir) || return; - } - } - return 1; -} - - -1; diff --git a/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/Unicode.pm b/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/Unicode.pm deleted file mode 100644 index 76641f0..0000000 --- a/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/Unicode.pm +++ /dev/null @@ -1,90 +0,0 @@ -package MakeMaker::Test::Setup::Unicode; - -@ISA = qw(Exporter); -require Exporter; -@EXPORT = qw(setup_recurs teardown_recurs); - -use strict; -use File::Path; -use File::Basename; -use MakeMaker::Test::Utils; -use utf8; -use Config; - -my %Files = ( - 'Problem-Module/Makefile.PL' => <<'PL_END', -use ExtUtils::MakeMaker; -use utf8; - -WriteMakefile( - NAME => 'Problem::Module', - ABSTRACT_FROM => 'lib/Problem/Module.pm', - AUTHOR => q{Danijel TaÅ¡ov}, - EXE_FILES => [ qw(bin/probscript) ], - INSTALLMAN1DIR => "some", # even if disabled in $Config{man1dir} - MAN1EXT => 1, # set to 0 if man pages disabled -); -PL_END - - 'Problem-Module/lib/Problem/Module.pm' => <<'pm_END', -use utf8; - -=pod - -=encoding utf8 - -=head1 NAME - -Problem::Module - Danijel TaÅ¡ov's great new module - -=cut - -1; -pm_END - - 'Problem-Module/bin/probscript' => <<'pl_END', -#!/usr/bin/perl -use utf8; - -=encoding utf8 - -=head1 NAME - -文档 - Problem script -pl_END -); - - -sub setup_recurs { - while(my($file, $text) = each %Files) { - # Convert to a relative, native file path. - $file = File::Spec->catfile(File::Spec->curdir, split m{\/}, $file); - - my $dir = dirname($file); - mkpath $dir; - my $utf8 = ($] < 5.008 or !$Config{useperlio}) ? "" : ":utf8"; - open(FILE, ">$utf8", $file) || die "Can't create $file: $!"; - print FILE $text; - close FILE; - - # ensure file at least 1 second old for makes that assume - # files with the same time are out of date. - my $time = calibrate_mtime(); - utime $time, $time - 1, $file; - } - - return 1; -} - -sub teardown_recurs { - foreach my $file (keys %Files) { - my $dir = dirname($file); - if( -e $dir ) { - rmtree($dir) || return; - } - } - return 1; -} - - -1; diff --git a/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/XS.pm b/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/XS.pm index 6ebca59..2c3ac61 100644 --- a/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/XS.pm +++ b/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/XS.pm @@ -2,101 +2,396 @@ package MakeMaker::Test::Setup::XS; @ISA = qw(Exporter); require Exporter; -@EXPORT = qw(setup_xs teardown_xs); +@EXPORT = qw(run_tests list_dynamic list_static); use strict; use File::Path; -use File::Basename; use MakeMaker::Test::Utils; use Config; +use Carp qw(croak); +use Test::More; +use File::Spec; +use File::Temp qw[tempdir]; +use Cwd; use ExtUtils::MM; +# this is to avoid MM->new overwriting _eumm in top dir +my $tempdir = tempdir(DIR => getcwd, CLEANUP => 1); +chdir $tempdir; my $typemap = 'type map'; -$typemap =~ s/ //g unless MM->new({NAME=>'name'})->can_dep_space; +$typemap =~ s/ //g unless MM->new({NAME=>'name', NORECURS=>1})->can_dep_space; +chdir File::Spec->updir; -my %Files = ( - 'XS-Test/lib/XS/Test.pm' => <<'END', +my $PM_TEST = <<'END'; package XS::Test; - require Exporter; require DynaLoader; - $VERSION = 1.01; @ISA = qw(Exporter DynaLoader); @EXPORT = qw(is_even); - bootstrap XS::Test $VERSION; - 1; END - 'XS-Test/Makefile.PL' => < 3; +use_ok "XS::Test"; +ok !is_even(1); +ok is_even(2); +END + +my $MAKEFILEPL = <<'END'; +use ExtUtils::MakeMaker; WriteMakefile( - NAME => 'XS::Test', - VERSION_FROM => 'lib/XS/Test.pm', - TYPEMAPS => [ '$typemap' ], - PERL => "\$^X -w", + NAME => 'XS::%s', + VERSION_FROM => '%s', + TYPEMAPS => [ %s ], + PERL => "$^X -w", + %s ); END - "XS-Test/$typemap" => '', +my $BS_TEST = '$DynaLoader::bscode = q(warn "BIG NOISE";)'; + +my $T_BOOTSTRAP = <<'EOF'; +use Test::More tests => 1; +my $w = ''; +$SIG{__WARN__} = sub { $w .= join '', @_; }; +require XS::Test; +like $w, qr/NOISE/; +EOF + +my $PM_OTHER = <<'END'; +package XS::Other; +require Exporter; +require DynaLoader; +$VERSION = 1.20; +@ISA = qw(Exporter DynaLoader); +@EXPORT = qw(is_odd); +bootstrap XS::Other $VERSION; +1; +END - 'XS-Test/Test.xs' => <<'END', +my $XS_OTHER = <<'END'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" - -MODULE = XS::Test PACKAGE = XS::Test - +MODULE = XS::Other PACKAGE = XS::Other PROTOTYPES: DISABLE - int -is_even(input) +is_odd(input) int input CODE: - RETVAL = (input % 2 == 0); + RETVAL = (INVAR % 2 == 1); OUTPUT: RETVAL END - 'XS-Test/t/is_even.t' => <<'END', +my $T_OTHER = <<'END'; #!/usr/bin/perl -w - use Test::More tests => 3; +use_ok "XS::Other"; +ok is_odd(1); +ok !is_odd(2); +END -use_ok "XS::Test"; -ok !is_even(1); -ok is_even(2); +my $PLUS1_C = <<'EOF'; +#ifdef __cplusplus +extern "C" { +int plus1(int i) +#else +int plus1(i) +int i; +#endif +{ return i + 1; } +#ifdef __cplusplus +} +#endif +EOF + +my %Files = ( + 'lib/XS/Test.pm' => $PM_TEST, + $typemap => '', + 'Test.xs' => $XS_TEST, + 't/is_even.t' => $T_TEST, + 'Makefile.PL' => sprintf($MAKEFILEPL, 'Test', 'lib/XS/Test.pm', qq{'$typemap'}, ''), +); + +my %label2files = (basic => \%Files); + +$label2files{bscode} = +{ + %{ $label2files{'basic'} }, # make copy + 'Test_BS' => $BS_TEST, + 't/bs.t' => $T_BOOTSTRAP, +}; +delete $label2files{bscode}->{'t/is_even.t'}; + +$label2files{static} = +{ + %{ $label2files{'basic'} }, # make copy + 'Makefile.PL' => sprintf( + $MAKEFILEPL, 'Test', 'lib/XS/Test.pm', qq{'$typemap'}, + q{LINKTYPE => 'static'}, + ), +}; + +$label2files{subdirs} = +{ + %{ $label2files{'basic'} }, # make copy + 'Makefile.PL' => sprintf( + $MAKEFILEPL, 'Test', 'Test.pm', qq{'$typemap'}, + q{DEFINE => '-DINVAR=input', INC => "-Inewline\n", LIBS => "-Lnewline\n",}, + ), + 'Other/Makefile.PL' => sprintf($MAKEFILEPL, 'Other', 'Other.pm', qq{}, ''), + 'Other/Other.pm' => $PM_OTHER, + 'Other/Other.xs' => $XS_OTHER, + 't/is_odd.t' => $T_OTHER, +}; +virtual_rename('subdirs', 'lib/XS/Test.pm', 'Test.pm'); + +# to mimic behaviour of Unicode-LineBreak version 2015.07.16 +$label2files{subdirscomplex} = +{ + %{ $label2files{'subdirs'} }, # make copy + 'Other/Makefile.PL' => sprintf( + $MAKEFILEPL, + 'Other', 'Other.pm', qq{}, + <<'EOF', +C => [qw(lib$(DIRFILESEP)file.c)], +OBJECT => 'lib$(DIRFILESEP)file$(OBJ_EXT)', +EOF + ) . <<'EOF', +sub MY::c_o { + package MY; + my $self = shift; + my $inherited = $self->SUPER::c_o(@_); + $inherited =~ s{(:\n\t)(.*(?:\n\t.*)*)} + { $1 . $self->cd('lib', split /(? $PLUS1_C, +}; +delete $label2files{subdirscomplex}{'Other/Other.xs'}; +delete $label2files{subdirscomplex}{'t/is_odd.t'}; + +$label2files{subdirsstatic} = +{ + %{ $label2files{'subdirs'} }, # make copy + 'Makefile.PL' => sprintf( + $MAKEFILEPL, 'Test', 'Test.pm', qq{'$typemap'}, + q{DEFINE => '-DINVAR=input', LINKTYPE => 'static',}, + ), +}; + +my $XS_MULTI = $XS_OTHER; +# check compiling from top dir still can include local +$XS_MULTI =~ s:(#include "XSUB.h"):$1\n#include "header.h":; +$label2files{multi} = +{ + %{ $label2files{'basic'} }, # make copy + 'Makefile.PL' => sprintf( + $MAKEFILEPL, 'Test', 'lib/XS/Test.pm', qq{'lib/XS/$typemap'}, + q{XSMULTI => 1,}, + ), + 'lib/XS/Other.pm' => $PM_OTHER, + 'lib/XS/Other.xs' => $XS_MULTI, + 't/is_odd.t' => $T_OTHER, + 'lib/XS/header.h' => "#define INVAR input\n", +}; +virtual_rename('multi', $typemap, "lib/XS/$typemap"); +virtual_rename('multi', 'Test.xs', 'lib/XS/Test.xs'); + +$label2files{bscodemulti} = +{ + %{ $label2files{'multi'} }, # make copy + 'lib/XS/Test_BS' => $BS_TEST, + 't/bs.t' => $T_BOOTSTRAP, +}; +delete $label2files{bscodemulti}->{'t/is_even.t'}; +delete $label2files{bscodemulti}->{'t/is_odd.t'}; + +$label2files{staticmulti} = +{ + %{ $label2files{'multi'} }, # make copy + 'Makefile.PL' => sprintf( + $MAKEFILEPL, 'Test', 'lib/XS/Test.pm', qq{'$typemap'}, + q{LINKTYPE => 'static', XSMULTI => 1,}, + ), +}; + +$label2files{xsbuild} = +{ + %{ $label2files{'multi'} }, # make copy + 'Makefile.PL' => sprintf( + $MAKEFILEPL, 'Test', 'lib/XS/Test.pm', qq{'$typemap'}, + q{ + XSMULTI => 1, + XSBUILD => { + xs => { + 'lib/XS/Other' => { + DEFINE => '-DINVAR=input', + OBJECT => 'lib/XS/Other$(OBJ_EXT) lib/XS/plus1$(OBJ_EXT)' + } + }, + }, + }, + ), + + 'lib/XS/Other.xs' => < $PLUS1_C, + + 't/is_odd.t' => <<'END', +#!/usr/bin/perl -w +use Test::More tests => 4; +use_ok "XS::Other"; +ok is_odd(1); +ok !is_odd(2); +is XS::Other::plus1(3), 4; END - ); +}; + +sub virtual_rename { + my ($label, $oldfile, $newfile) = @_; + $label2files{$label}->{$newfile} = delete $label2files{$label}->{$oldfile}; +} sub setup_xs { + my ($label, $sublabel) = @_; + croak "Must supply label" unless defined $label; + my $files = $label2files{$label}; + croak "Must supply valid label" unless defined $files; + croak "Must supply sublabel" unless defined $sublabel; + my $prefix = "XS-Test$label$sublabel"; + hash2files($prefix, $files); + return $prefix; +} + +sub list_static { + ( + ( !$Config{usedl} ? [ 'basic', '', '' ] : ()), # still needs testing on static perl + [ 'static', '', '' ], + [ 'basic', ' static', '_static' ], + [ 'multi', ' static', '_static' ], + [ 'subdirs', ' LINKTYPE=static', ' LINKTYPE=static' ], + [ 'subdirsstatic', '', '' ], + [ 'staticmulti', '', '' ], + ); +} + +sub list_dynamic { + ( + [ 'basic', '', '' ], + $^O ne 'MSWin32' ? ( + [ 'bscode', '', '' ], + [ 'bscodemulti', '', '' ], + [ 'subdirscomplex', '', '' ], + ) : (), # DynaLoader different + [ 'subdirs', '', '' ], + [ 'subdirsstatic', ' LINKTYPE=dynamic', ' LINKTYPE=dynamic' ], + [ 'subdirsstatic', ' dynamic', '_dynamic' ], + [ 'multi', '', '' ], + [ 'staticmulti', ' LINKTYPE=dynamic', ' LINKTYPE=dynamic' ], + [ 'staticmulti', ' dynamic', '_dynamic' ], + [ 'xsbuild', '', '' ], + ); +} - while(my($file, $text) = each %Files) { - # Convert to a relative, native file path. - $file = File::Spec->catfile(File::Spec->curdir, split m{\/}, $file); +sub run_tests { + my ($perl, $label, $add_target, $add_testtarget) = @_; + my $sublabel = $add_target; + $sublabel =~ s#[\s=]##g; + ok( my $dir = setup_xs($label, $sublabel), "setup $label$sublabel" ); - my $dir = dirname($file); - mkpath $dir; - open(FILE, ">$file") || die "Can't create $file: $!"; - print FILE $text; - close FILE; + ok( chdir($dir), "chdir'd to $dir" ) || diag("chdir failed: $!"); + + my @mpl_out = run(qq{$perl Makefile.PL}); + SKIP: { + unless (cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' )) { + diag(@mpl_out); + skip 'perl Makefile.PL failed', 2; } - return 1; -} + my $make = make_run(); + my $target = ''; + my %macros = (); + if (defined($add_target)) { + if ($add_target =~ m/(\S+)=(\S+)/) { + $macros{$1} = $2; + } + else { + $target = $add_target; + } + } + my $make_cmd = make_macro($make, $target, %macros); + my $make_out = run($make_cmd); + unless (is( $?, 0, "$make_cmd exited normally" )) { + diag $make_out; + skip 'Make failed - skipping test', 1; + } -sub teardown_xs { - foreach my $file (keys %Files) { - my $dir = dirname($file); - if( -e $dir ) { - rmtree($dir) || return; + $target = 'test'; + %macros = (); + if (defined($add_testtarget) && length($add_testtarget)) { + if ($add_testtarget =~ m/(\S+)=(\S+)/) { + $macros{$1} = $2; + } + else { + # an underscore prefix means combine, e.g. 'test' + '_dynamic' + unless ($add_testtarget =~ m/^_/) { + $target .= ($make =~ m/^MM(K|S)/i) ? ',' : ' '; + } + $target .= $add_testtarget; } } - return 1; + my $test_cmd = make_macro($make, $target, %macros); + my $test_out = run($test_cmd); + is( $?, 0, "$test_cmd exited normally" ) || diag "$make_out\n$test_out"; + } + + chdir File::Spec->updir or die; + ok rmtree($dir), "teardown $dir"; } 1; diff --git a/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Utils.pm b/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Utils.pm index 16d6688..ce73b30 100644 --- a/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Utils.pm +++ b/cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Utils.pm @@ -3,6 +3,10 @@ package MakeMaker::Test::Utils; use File::Spec; use strict; use Config; +use Cwd qw(getcwd); +use Carp qw(croak); +use File::Path; +use File::Basename; require Exporter; our @ISA = qw(Exporter); @@ -16,6 +20,8 @@ our @EXPORT = qw(which_perl perl_lib makefile_name makefile_backup have_compiler slurp $Is_VMS $Is_MacOS run_ok + hash2files + in_dir ); @@ -155,6 +161,9 @@ Sets up environment variables so perl can find its libraries. my $old5lib = $ENV{PERL5LIB}; my $had5lib = exists $ENV{PERL5LIB}; sub perl_lib { + my $basecwd = (File::Spec->splitdir(getcwd))[-1]; + croak "Basename of cwd needs to be 't' but is '$basecwd'\n" + unless $basecwd eq 't'; # perl-src/t/ my $lib = $ENV{PERL_CORE} ? qq{../lib} # ExtUtils-MakeMaker/t/ @@ -255,14 +264,18 @@ sub make_macro { my $is_mms = $make =~ /^MM(K|S)/i; - my $cmd = $make; - my $macros = ''; + my @macros; while( my($key,$val) = splice(@_, 0, 2) ) { - if( $is_mms ) { - $macros .= qq{/macro="$key=$val"}; + push @macros, qq{$key=$val}; + } + my $macros = ''; + if (scalar(@macros)) { + if ($is_mms) { + map { $_ = qq{"$_"} } @macros; + $macros = '/MACRO=(' . join(',', @macros) . ')'; } else { - $macros .= qq{ $key=$val}; + $macros = join(' ', @macros); } } @@ -280,11 +293,12 @@ touched. =cut sub calibrate_mtime { - open(FILE, ">calibrate_mtime.tmp") || die $!; + my $file = "calibrate_mtime-$$.tmp"; + open(FILE, ">$file") || die $!; print FILE "foo"; close FILE; - my($mtime) = (stat('calibrate_mtime.tmp'))[9]; - unlink 'calibrate_mtime.tmp'; + my($mtime) = (stat($file))[9]; + unlink $file; return $mtime; } @@ -345,23 +359,11 @@ Returns true if there is a compiler available for XS builds. sub have_compiler { my $have_compiler = 0; - - # ExtUtils::CBuilder prints its compilation lines to the screen. - # Shut it up. - use TieOut; - local *STDOUT = *STDOUT; - local *STDERR = *STDERR; - - tie *STDOUT, 'TieOut'; - tie *STDERR, 'TieOut'; - eval { - require ExtUtils::CBuilder; - my $cb = ExtUtils::CBuilder->new; - - $have_compiler = $cb->have_compiler; + require ExtUtils::CBuilder; + my $cb = ExtUtils::CBuilder->new(quiet=>1); + $have_compiler = $cb->have_compiler; }; - return $have_compiler; } @@ -386,6 +388,72 @@ sub slurp { return $text; } +=item hash2files + + hash2files('dirname', { 'filename' => 'some content' }); + +Goes through given hash-ref, treating each key as a /-separated filename +under the specified directory, and writing the value into it. Will create +any necessary directories. + +Will die if errors occur. + +=cut + +sub hash2files { + my ($prefix, $hashref) = @_; + while(my ($file, $text) = each %$hashref) { + # Convert to a relative, native file path. + $file = File::Spec->catfile(File::Spec->curdir, $prefix, split m{\/}, $file); + my $dir = dirname($file); + mkpath $dir; + my $utf8 = ($] < 5.008 or !$Config{useperlio}) ? "" : ":utf8"; + open(FILE, ">$utf8", $file) || die "Can't create $file: $!"; + print FILE $text; + close FILE; + # ensure file at least 1 second old for makes that assume + # files with the same time are out of date. + my $time = calibrate_mtime(); + utime $time, $time - 1, $file; + } +} + +=item in_dir + + $retval = in_dir(\&coderef); + $retval = in_dir(\&coderef, $specified_dir); + $retval = in_dir { somecode(); }; + $retval = in_dir { somecode(); } $specified_dir; + +Does a C to either a directory. If none is specified, one is +created with L and then automatically deleted after. It ends +by Cing back to where it started. + +If the given code throws an exception, it will be re-thrown after the +re-C. + +Returns the return value of the given code. + +=cut + +sub in_dir(&;$) { + my $code = shift; + require File::Temp; + my $dir = shift || File::Temp::tempdir(TMPDIR => 1, CLEANUP => 1); + # chdir to the new directory + my $orig_dir = getcwd(); + chdir $dir or die "Can't chdir to $dir: $!"; + # Run the code, but trap the error so we can chdir back + my $return; + my $ok = eval { $return = $code->(); 1; }; + my $err = $@; + # chdir back + chdir $orig_dir or die "Can't chdir to $orig_dir: $!"; + # rethrow if necessary + die $err unless $ok; + return $return; +} + =back =head1 AUTHOR diff --git a/cpan/ExtUtils-MakeMaker/t/meta_convert.t b/cpan/ExtUtils-MakeMaker/t/meta_convert.t index 7053c33..c99926d 100644 --- a/cpan/ExtUtils-MakeMaker/t/meta_convert.t +++ b/cpan/ExtUtils-MakeMaker/t/meta_convert.t @@ -1,127 +1,108 @@ -BEGIN { - chdir '..' if -d '../t'; - unshift @INC, 't/lib'; - use lib 'lib'; -} +#!perl -w use strict; use warnings; -use Test::More 'no_plan'; +BEGIN { unshift @INC, 't/lib'; } +use Test::More eval { require CPAN::Meta; CPAN::Meta->VERSION(2.143240) } ? () + : (skip_all => 'CPAN::Meta 2.143240 required for this test'); +use File::Temp qw[tempdir]; require ExtUtils::MM_Any; -sub ExtUtils::MM_Any::quote_literal { $_[1] } - -my $new_mm = sub { - return bless { ARGS => {@_}, @_ }, 'ExtUtils::MM_Any'; -}; +my $tmpdir = tempdir( DIR => 't', CLEANUP => 1 ); +use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup +chdir $tmpdir or die "chdir $tmpdir: $!"; + +my $EMPTY = qr/['"]?version['"]?\s*:\s*['"]['"]/; +my @DATA = ( + [ + [ DISTNAME => 'Net::FTP::Recursive', VERSION => 'Recursive.pm', ], + qr{Can't parse version 'Recursive.pm'}, + 'VERSION => filename', + $EMPTY, + ], + [ + [ DISTNAME => 'Image::Imgur', VERSION => 'undef', ], + qr{Can't parse version 'undef'}, + 'no $VERSION in file -> VERSION=>"undef"', + $EMPTY, + ], + [ + [ DISTNAME => 'SQL::Library', VERSION => 0.0.3, ], + qr{Can't parse version '\x00\x00\x03'}, + "x.y.z version", + $EMPTY, + ], + [ + [ DISTNAME => 'Array::Suffix', VERSION => '.5', ], + qr{Can't parse version '.5'}, + ".5 version", + $EMPTY, + ], + [ + [ + DISTNAME => 'Attribute::Signature', + META_MERGE => { + resources => { + repository => 'http://github.com/chorny/Attribute-Signature', + 'Repository-clone' => 'git://github.com/chorny/Attribute-Signature.git', + }, + }, + ], + qr/^$/, + "Non-camel case metadata", + qr/x_Repositoryclone/, + ], + [ + [ + DISTNAME => 'CPAN::Testers::ParseReport', + VERSION => '2.34', + META_ADD => { + provides => { + "CPAN::Testers::ParseReport" => { + version => version->new("v1.2.3"), + file => "lib/CPAN/Testers/ParseReport.pm" + } + } + }, + ], + qr/^$/, + "version object in provides", + qr/['"]?version['"]?\s*:\s*['"]v1\.2\.3['"]/, + ], + [ + [ + DISTNAME => 'Bad::License', + VERSION => '2.34', + LICENSE => 'death and retribution', + ], + qr/Invalid LICENSE value/, + "Bad licence warns", + qr/['"]?version['"]?\s*:\s*['"]2\.34['"]/, + ], +); + +plan tests => 3 * @DATA; +run_test(@$_) for @DATA; -my $warn_ok = sub { - my($code, $want, $name) = @_; +sub ExtUtils::MM_Any::quote_literal { $_[1] } - my @have; +sub run_test { + my ($mmargs, $expected, $label, $metadata_re) = @_; + my $mm = bless { ARGS => {@$mmargs}, @$mmargs }, 'ExtUtils::MM_Any'; + my @warnings; my $ret; { - local $SIG{__WARN__} = sub { push @have, @_ }; - $ret = $code->(); + local $SIG{__WARN__} = sub { push @warnings, @_ }; + eval { $ret = $mm->metafile_target; }; + } + SKIP: { + if ($@) { + diag $@; + skip "$label got exception", 3 if $@; + } + ok 1, "$label metafile_target"; + like join("", @warnings), $expected, "$label right warning"; + like $ret, $metadata_re, "$label metadata"; } - - like join("", @have), $want, $name; - return $ret; -}; - -my $version_regex = qr/version: ''/; -my $version_action = "they're converted to empty string"; - - -note "Filename as version"; { - my $mm = $new_mm->( - DISTNAME => 'Net::FTP::Recursive', - VERSION => 'Recursive.pm', - ); - - my $res = $warn_ok->( - sub { eval { $mm->metafile_target } }, - qr{Can't parse version 'Recursive.pm'} - ); - ok $res, 'we know how to deal with bogus versions defined in Makefile.PL'; - like $res, $version_regex, $version_action; -} - - -note "'undef' version from parse_version"; { - my $mm = $new_mm->( - DISTNAME => 'Image::Imgur', - VERSION => 'undef', - ); - my $res = $warn_ok->( - sub { eval { $mm->metafile_target } }, - qr{Can't parse version 'undef'} - ); - ok $res, q|when there's no $VERSION in Module.pm, $self->{VERSION} = 'undef'; via MM_Unix::parse_version and we know how to deal with that|; - like $res, $version_regex, $version_action; -} - - -note "x.y.z version"; { - my $mm = $new_mm->( - DISTNAME => 'SQL::Library', - VERSION => 0.0.3, - ); - - # It would be more useful if the warning got translated to visible characters - my $res = $warn_ok->( - sub { eval { $mm->metafile_target } }, - qr{Can't parse version '\x00\x00\x03'} - ); - ok $res, q|we know how to deal with our $VERSION = 0.0.3; style versions defined in the module|; - like $res, $version_regex, $version_action; -} - - -note ".5 version"; { - my $mm = $new_mm->( - DISTNAME => 'Array::Suffix', - VERSION => '.5', - ); - my $res = $warn_ok->( - sub { eval { $mm->metafile_target } }, - qr{Can't parse version '.5'} - ); - ok $res, q|we know how to deal with our $VERSION = '.5'; style versions defined in the module|; - like $res, $version_regex, $version_action; -} - - -note "Non-camel case metadata"; { - my $mm = $new_mm->( - DISTNAME => 'Attribute::Signature', - META_MERGE => { - resources => { - repository => 'http://github.com/chorny/Attribute-Signature', - 'Repository-clone' => 'git://github.com/chorny/Attribute-Signature.git', - }, - }, - ); - my $res = eval { $mm->metafile_target }; - ok $res, q|we know how to deal with non-camel-cased custom meta resource keys defined in Makefile.PL|; - like $res, qr/x_Repositoryclone/, "they're camel-cased"; -} - - -note "version object in provides"; { - my $mm = $new_mm->( - DISTNAME => 'CPAN::Testers::ParseReport', - VERSION => '2.34', - META_ADD => { - provides => { - "CPAN::Testers::ParseReport" => { - version => version->new("v1.2.3"), - file => "lib/CPAN/Testers/ParseReport.pm" - } - } - }, - ); - my $res = eval { $mm->metafile_target }; - like $res, qr{version: \s* v1.2.3}x; } diff --git a/cpan/ExtUtils-MakeMaker/t/metafile_data.t b/cpan/ExtUtils-MakeMaker/t/metafile_data.t index a9c90ae..01d72d8 100644 --- a/cpan/ExtUtils-MakeMaker/t/metafile_data.t +++ b/cpan/ExtUtils-MakeMaker/t/metafile_data.t @@ -3,226 +3,133 @@ BEGIN { } use strict; -use Test::More tests => 31; - +use Test::More; +BEGIN { + eval { require CPAN::Meta; CPAN::Meta->VERSION(2.143240) } + or plan skip_all => 'CPAN::Meta 2.143240 required for this test'; + eval { require CPAN::Meta::Converter; } + or plan skip_all => 'CPAN::Meta::Converter required for this test'; + eval { require Parse::CPAN::Meta; } + or plan skip_all => 'Parse::CPAN::Meta required for this test'; +} use Data::Dumper; use File::Temp; use Cwd; -use Parse::CPAN::Meta; +use MakeMaker::Test::Utils; +plan tests => 31; require ExtUtils::MM_Any; -sub in_dir(&;$) { - my $code = shift; - my $dir = shift || File::Temp->newdir; - - # chdir to the new directory - my $orig_dir = cwd(); - chdir $dir or die "Can't chdir to $dir: $!"; - - # Run the code, but trap the error so we can chdir back - my $return; - my $ok = eval { $return = $code->(); 1; }; - my $err = $@; - - # chdir back - chdir $orig_dir or die "Can't chdir to $orig_dir: $!"; - - # rethrow if necessary - die $err unless $ok; - - return $return; -} - sub mymeta_ok { my($have, $want, $name) = @_; - local $Test::Builder::Level = $Test::Builder::Level + 1; - my $have_gen = delete $have->{generated_by}; my $want_gen = delete $want->{generated_by}; my $have_url = delete $have->{'meta-spec'}->{url}; my $want_url = delete $want->{'meta-spec'}->{url}; - is_deeply $have, $want, $name; like $have_gen, qr{CPAN::Meta}, "CPAN::Meta mentioned in the generated_by"; like $have_url, qr{CPAN::Meta::Spec}, "CPAN::Meta::Spec mentioned in meta-spec URL"; - return; } my $new_mm = sub { return bless { ARGS => {@_}, @_ }, 'ExtUtils::MM_Any'; }; +my @METASPEC14 = ( + 'meta-spec' => { + url => 'http://module-build.sourceforge.net/META-spec-v1.4.html', + version => 1.4 + }, +); +my @METASPEC20 = ( + 'meta-spec' => { + url => 'https://metacpan.org/pod/CPAN::Meta::Spec', + version => 2 + }, +); +my @REQ20 = ( + configure => { requires => { 'ExtUtils::MakeMaker' => 0, }, }, + build => { requires => { 'ExtUtils::MakeMaker' => 0, }, }, +); +my @GENERIC_IN = ( + DISTNAME => 'Foo-Bar', + VERSION => 1.23, + PM => { "Foo::Bar" => 'lib/Foo/Bar.pm', }, +); +my @GENERIC_OUT = ( + # mandatory + abstract => 'unknown', + author => [qw(unknown)], + dynamic_config => 1, + generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION", + license => ['unknown'], + @METASPEC20, + name => 'Foo-Bar', + release_status => 'stable', + version => 1.23, + # optional + no_index => { directory => [qw(t inc)], }, +); { - my $mm = $new_mm->( - DISTNAME => 'Foo-Bar', - VERSION => 1.23, - PM => { - "Foo::Bar" => 'lib/Foo/Bar.pm', - }, - ); - - is_deeply {$mm->metafile_data}, { - name => 'Foo-Bar', - version => 1.23, - abstract => 'unknown', - author => [], - license => 'unknown', - dynamic_config => 1, - distribution_type => 'module', - - configure_requires => { - 'ExtUtils::MakeMaker' => 0, - }, - build_requires => { - 'ExtUtils::MakeMaker' => 0, - }, - - no_index => { - directory => [qw(t inc)], - }, - - generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION", - 'meta-spec' => { - url => 'http://module-build.sourceforge.net/META-spec-v1.4.html', - version => 1.4 - }, + my $mm = $new_mm->(@GENERIC_IN); + is_deeply $mm->metafile_data, { + @GENERIC_OUT, + prereqs => { @REQ20, }, }; - - - is_deeply {$mm->metafile_data({}, { no_index => { directory => [qw(foo)] } })}, { - name => 'Foo-Bar', - version => 1.23, - abstract => 'unknown', - author => [], - license => 'unknown', - dynamic_config => 1, - distribution_type => 'module', - - configure_requires => { - 'ExtUtils::MakeMaker' => 0, - }, - build_requires => { - 'ExtUtils::MakeMaker' => 0, - }, - - no_index => { - directory => [qw(t inc foo)], - }, - - generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION", - 'meta-spec' => { - url => 'http://module-build.sourceforge.net/META-spec-v1.4.html', - version => 1.4 - }, + is_deeply $mm->metafile_data({}, { no_index => { directory => [qw(foo)] } }), { + @GENERIC_OUT, + prereqs => { @REQ20, }, + no_index => { directory => [qw(t inc foo)], }, }, 'rt.cpan.org 39348'; } - { my $mm = $new_mm->( DISTNAME => 'Foo-Bar', VERSION => 1.23, AUTHOR => ['Some Guy'], - PREREQ_PM => { - Foo => 2.34, - Bar => 4.56, - }, + PREREQ_PM => { Foo => 2.34, Bar => 4.56, }, ); - - is_deeply {$mm->metafile_data( + is_deeply $mm->metafile_data( { - configure_requires => { - Stuff => 2.34 - }, + configure_requires => { Stuff => 2.34 }, wobble => 42 }, { - no_index => { - package => "Thing" - }, + no_index => { package => "Thing" }, wibble => 23 }, - )}, + ), { - name => 'Foo-Bar', - version => 1.23, - abstract => 'unknown', + @GENERIC_OUT, # some overridden, which is fine author => ['Some Guy'], - license => 'unknown', - dynamic_config => 1, - distribution_type => 'script', - - configure_requires => { - Stuff => 2.34, - }, - build_requires => { - 'ExtUtils::MakeMaker' => 0, - }, - - requires => { - Foo => 2.34, - Bar => 4.56, + prereqs => { + @REQ20, + configure => { requires => { Stuff => 2.34, }, }, + runtime => { requires => { Foo => 2.34, Bar => 4.56, }, }, }, - no_index => { directory => [qw(t inc)], - package => 'Thing', + package => ['Thing'], }, - - generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION", - 'meta-spec' => { - url => 'http://module-build.sourceforge.net/META-spec-v1.4.html', - version => 1.4 - }, - - wibble => 23, - wobble => 42, - }; + x_wibble => 23, + x_wobble => 42, + }, '_add vs _merge'; } - # Test MIN_PERL_VERSION meta-spec 1.4 { my $mm = $new_mm->( - DISTNAME => 'Foo-Bar', - VERSION => 1.23, - PM => { - "Foo::Bar" => 'lib/Foo/Bar.pm', - }, + @GENERIC_IN, MIN_PERL_VERSION => 5.006, ); - - is_deeply {$mm->metafile_data}, { - name => 'Foo-Bar', - version => 1.23, - abstract => 'unknown', - author => [], - license => 'unknown', - dynamic_config => 1, - distribution_type => 'module', - - configure_requires => { - 'ExtUtils::MakeMaker' => 0, - }, - build_requires => { - 'ExtUtils::MakeMaker' => 0, - }, - - requires => { - perl => '5.006', - }, - - no_index => { - directory => [qw(t inc)], - }, - - generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION", - 'meta-spec' => { - url => 'http://module-build.sourceforge.net/META-spec-v1.4.html', - version => 1.4 + is_deeply $mm->metafile_data( {}, { @METASPEC14 }, ), { + @GENERIC_OUT, + prereqs => { + @REQ20, + runtime => { requires => { perl => 5.006, }, }, }, }, 'MIN_PERL_VERSION meta-spec 1.4'; } @@ -230,104 +137,35 @@ my $new_mm = sub { # Test MIN_PERL_VERSION meta-spec 2.0 { my $mm = $new_mm->( - DISTNAME => 'Foo-Bar', - VERSION => 1.23, - PM => { - "Foo::Bar" => 'lib/Foo/Bar.pm', - }, + @GENERIC_IN, MIN_PERL_VERSION => 5.006, ); - - is_deeply { - $mm->metafile_data( - {}, { - 'meta-spec' => { - url => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec', - version => 2 - } } ) - }, { - name => 'Foo-Bar', - version => 1.23, - abstract => 'unknown', - author => [], - license => 'unknown', - dynamic_config => 1, - distribution_type => 'module', - + is_deeply $mm->metafile_data, { prereqs => { - configure => { - requires => { - 'ExtUtils::MakeMaker' => 0, - }, - }, - build => { - requires => { - 'ExtUtils::MakeMaker' => 0, - }, - }, - runtime => { - requires => { - 'perl' => '5.006', - }, - }, - }, - - no_index => { - directory => [qw(t inc)], - }, - - generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION", - 'meta-spec' => { - - url => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec', - version => 2 + @REQ20, + runtime => { requires => { 'perl' => '5.006', }, }, }, + @GENERIC_OUT, }, 'MIN_PERL_VERSION meta-spec 2.0'; } # Test MIN_PERL_VERSION meta-spec 1.4 { my $mm = $new_mm->( - DISTNAME => 'Foo-Bar', - VERSION => 1.23, - PM => { - "Foo::Bar" => 'lib/Foo/Bar.pm', - }, + @GENERIC_IN, MIN_PERL_VERSION => 5.006, - PREREQ_PM => { - 'Foo::Bar' => 1.23, - }, + PREREQ_PM => { 'Foo::Bar' => 1.23, }, ); - - is_deeply {$mm->metafile_data}, { - name => 'Foo-Bar', - version => 1.23, - abstract => 'unknown', - author => [], - license => 'unknown', - dynamic_config => 1, - distribution_type => 'module', - - configure_requires => { - 'ExtUtils::MakeMaker' => 0, - }, - build_requires => { - 'ExtUtils::MakeMaker' => 0, - }, - - requires => { - perl => '5.006', - 'Foo::Bar' => 1.23, - }, - - no_index => { - directory => [qw(t inc)], - }, - - generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION", - 'meta-spec' => { - url => 'http://module-build.sourceforge.net/META-spec-v1.4.html', - version => 1.4 + is_deeply $mm->metafile_data, { + @GENERIC_OUT, + prereqs => { + @REQ20, + runtime => { + requires => { + 'Foo::Bar' => 1.23, + 'perl' => '5.006', + }, + }, }, }, 'MIN_PERL_VERSION and PREREQ_PM meta-spec 1.4'; } @@ -335,339 +173,111 @@ my $new_mm = sub { # Test CONFIGURE_REQUIRES meta-spec 1.4 { my $mm = $new_mm->( - DISTNAME => 'Foo-Bar', - VERSION => 1.23, - CONFIGURE_REQUIRES => { - "Fake::Module1" => 1.01, - }, - PM => { - "Foo::Bar" => 'lib/Foo/Bar.pm', - }, + @GENERIC_IN, + CONFIGURE_REQUIRES => { "Fake::Module1" => 1.01, }, ); - - is_deeply {$mm->metafile_data}, { - name => 'Foo-Bar', - version => 1.23, - abstract => 'unknown', - author => [], - license => 'unknown', - dynamic_config => 1, - distribution_type => 'module', - - configure_requires => { - 'Fake::Module1' => 1.01, - }, - build_requires => { - 'ExtUtils::MakeMaker' => 0, - }, - - no_index => { - directory => [qw(t inc)], - }, - - generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION", - 'meta-spec' => { - url => 'http://module-build.sourceforge.net/META-spec-v1.4.html', - version => 1.4 + is_deeply $mm->metafile_data( {}, { @METASPEC14 }, ), { + prereqs => { + @REQ20, + configure => { requires => { 'Fake::Module1' => 1.01, }, }, }, + @GENERIC_OUT, },'CONFIGURE_REQUIRES meta-spec 1.4'; } # Test CONFIGURE_REQUIRES meta-spec 2.0 { my $mm = $new_mm->( - DISTNAME => 'Foo-Bar', - VERSION => 1.23, - CONFIGURE_REQUIRES => { - "Fake::Module1" => 1.01, - }, - PM => { - "Foo::Bar" => 'lib/Foo/Bar.pm', - }, + @GENERIC_IN, + CONFIGURE_REQUIRES => { "Fake::Module1" => 1.01, }, ); - - is_deeply { - $mm->metafile_data( - {}, { - 'meta-spec' => { - url => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec', - version => 2 - } } ) - }, { - name => 'Foo-Bar', - version => 1.23, - abstract => 'unknown', - author => [], - license => 'unknown', - dynamic_config => 1, - distribution_type => 'module', - + is_deeply $mm->metafile_data, { prereqs => { - configure => { - requires => { - 'Fake::Module1' => 1.01, - }, - }, - build => { - requires => { - 'ExtUtils::MakeMaker' => 0, - }, - }, - }, - - no_index => { - directory => [qw(t inc)], - }, - - generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION", - 'meta-spec' => { - url => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec', - version => 2 + @REQ20, + configure => { requires => { 'Fake::Module1' => 1.01, }, }, }, + @GENERIC_OUT, },'CONFIGURE_REQUIRES meta-spec 2.0'; } - # Test BUILD_REQUIRES meta-spec 1.4 { my $mm = $new_mm->( - DISTNAME => 'Foo-Bar', - VERSION => 1.23, - BUILD_REQUIRES => { - "Fake::Module1" => 1.01, - }, - PM => { - "Foo::Bar" => 'lib/Foo/Bar.pm', - }, + @GENERIC_IN, + BUILD_REQUIRES => { "Fake::Module1" => 1.01, }, + META_MERGE => { "meta-spec" => { version => 1.4 }}, ); - - is_deeply {$mm->metafile_data}, { - name => 'Foo-Bar', - version => 1.23, - abstract => 'unknown', - author => [], - license => 'unknown', - dynamic_config => 1, - distribution_type => 'module', - - configure_requires => { - 'ExtUtils::MakeMaker' => 0, - }, - build_requires => { - 'Fake::Module1' => 1.01, - }, - - no_index => { - directory => [qw(t inc)], - }, - - generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION", - 'meta-spec' => { - url => 'http://module-build.sourceforge.net/META-spec-v1.4.html', - version => 1.4 + is_deeply $mm->metafile_data( {}, { @METASPEC14 }, ), { + prereqs => { + @REQ20, + build => { requires => { 'Fake::Module1' => 1.01, }, }, }, + @GENERIC_OUT, },'BUILD_REQUIRES meta-spec 1.4'; } # Test BUILD_REQUIRES meta-spec 2.0 { my $mm = $new_mm->( - DISTNAME => 'Foo-Bar', - VERSION => 1.23, - BUILD_REQUIRES => { - "Fake::Module1" => 1.01, - }, - PM => { - "Foo::Bar" => 'lib/Foo/Bar.pm', - }, - META_MERGE => { "meta-spec" => { version => 2 }}, + @GENERIC_IN, + BUILD_REQUIRES => { "Fake::Module1" => 1.01, }, ); - - is_deeply { - $mm->metafile_data( - {}, { - 'meta-spec' => { - url => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec', - version => 2 - } } ) - }, { - name => 'Foo-Bar', - version => 1.23, - abstract => 'unknown', - author => [], - license => 'unknown', - dynamic_config => 1, - distribution_type => 'module', - + is_deeply $mm->metafile_data, { prereqs => { - configure => { - requires => { - 'ExtUtils::MakeMaker' => 0, - }, - }, - build => { - requires => { - 'Fake::Module1' => 1.01, - }, - }, - }, - - no_index => { - directory => [qw(t inc)], - }, - - generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION", - 'meta-spec' => { - url => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec', - version => 2 + @REQ20, + build => { requires => { 'Fake::Module1' => 1.01, }, }, }, + @GENERIC_OUT, },'BUILD_REQUIRES meta-spec 2.0'; } # Test TEST_REQUIRES meta-spec 1.4 { my $mm = $new_mm->( - DISTNAME => 'Foo-Bar', - VERSION => 1.23, - TEST_REQUIRES => { - "Fake::Module1" => 1.01, - }, - PM => { - "Foo::Bar" => 'lib/Foo/Bar.pm', - }, + @GENERIC_IN, + TEST_REQUIRES => { "Fake::Module1" => 1.01, }, + META_MERGE => { "meta-spec" => { version => 1.4 }}, ); - - is_deeply {$mm->metafile_data}, { - name => 'Foo-Bar', - version => 1.23, - abstract => 'unknown', - author => [], - license => 'unknown', - dynamic_config => 1, - distribution_type => 'module', - - configure_requires => { - 'ExtUtils::MakeMaker' => 0, - }, - build_requires => { - 'ExtUtils::MakeMaker' => 0, - 'Fake::Module1' => 1.01, - }, - - no_index => { - directory => [qw(t inc)], - }, - - generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION", - 'meta-spec' => { - url => 'http://module-build.sourceforge.net/META-spec-v1.4.html', - version => 1.4 + is_deeply $mm->metafile_data( {}, { @METASPEC14 }, ), { + prereqs => { + @REQ20, + test => { requires => { "Fake::Module1" => 1.01, }, }, }, + @GENERIC_OUT, },'TEST_REQUIRES meta-spec 1.4'; } # Test TEST_REQUIRES meta-spec 2.0 { my $mm = $new_mm->( - DISTNAME => 'Foo-Bar', - VERSION => 1.23, - TEST_REQUIRES => { - "Fake::Module1" => 1.01, - }, - PM => { - "Foo::Bar" => 'lib/Foo/Bar.pm', - }, - META_MERGE => { "meta-spec" => { version => 2 }}, + @GENERIC_IN, + TEST_REQUIRES => { "Fake::Module1" => 1.01, }, ); - - is_deeply { - $mm->metafile_data( - {}, { - 'meta-spec' => { - url => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec', - version => 2 - } } ) - }, { - name => 'Foo-Bar', - version => 1.23, - abstract => 'unknown', - author => [], - license => 'unknown', - dynamic_config => 1, - distribution_type => 'module', - + is_deeply $mm->metafile_data, { prereqs => { - configure => { - requires => { - 'ExtUtils::MakeMaker' => 0, - }, - }, - build => { - requires => { - 'ExtUtils::MakeMaker' => 0, - }, - }, - test => { - requires => { - "Fake::Module1" => 1.01, - }, - }, - }, - - no_index => { - directory => [qw(t inc)], - }, - - generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION", - 'meta-spec' => { - url => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec', - version => 2 + @REQ20, + test => { requires => { "Fake::Module1" => 1.01, }, }, }, + @GENERIC_OUT, },'TEST_REQUIRES meta-spec 2.0'; } - # Test _REQUIRES key priority over META_ADD - { my $mm = $new_mm->( - DISTNAME => 'Foo-Bar', - VERSION => 1.23, - BUILD_REQUIRES => { - "Fake::Module1" => 1.01, - }, + @GENERIC_IN, + BUILD_REQUIRES => { "Fake::Module1" => 1.01, }, META_ADD => (my $meta_add = { build_requires => {}, configure_requires => {} }), - PM => { - "Foo::Bar" => 'lib/Foo/Bar.pm', - }, ); - - is_deeply {$mm->metafile_data($meta_add)}, { - name => 'Foo-Bar', - version => 1.23, - abstract => 'unknown', - author => [], - license => 'unknown', - dynamic_config => 1, - distribution_type => 'module', - - configure_requires => { }, - build_requires => { }, - - no_index => { - directory => [qw(t inc)], - }, - - generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION", - 'meta-spec' => { - url => 'http://module-build.sourceforge.net/META-spec-v1.4.html', - version => 1.4 + is_deeply $mm->metafile_data($meta_add), { + prereqs => { + configure => { requires => { }, }, + build => { requires => { }, }, }, + @GENERIC_OUT, },'META.yml data (META_ADD wins)'; - - # Yes, this is all hard coded. - require CPAN::Meta; + my $want_mymeta = { name => 'ExtUtils-MakeMaker', version => '6.57_07', @@ -675,7 +285,6 @@ my $new_mm = sub { author => ['Michael G Schwern '], license => ['perl_5'], dynamic_config => 0, - prereqs => { runtime => { requires => { @@ -686,18 +295,9 @@ my $new_mm = sub { "perl" => "5.006", }, }, - configure => { - requires => { - 'ExtUtils::MakeMaker' => 0, - }, - }, - build => { - requires => { - 'Fake::Module1' => 1.01, - }, - }, + @REQ20, + build => { requires => { 'Fake::Module1' => 1.01, }, }, }, - release_status => 'testing', resources => { license => [ 'http://dev.perl.org/licenses/' ], @@ -706,23 +306,16 @@ my $new_mm = sub { repository => { url => 'http://github.com/Perl-Toolchain-Gang/ExtUtils-MakeMaker' }, x_MailingList => 'makemaker@perl.org', }, - no_index => { directory => [qw(t inc)], package => ["DynaLoader", "in"], }, - generated_by => "ExtUtils::MakeMaker version 6.5707, CPAN::Meta::Converter version 2.110580", - 'meta-spec' => { - url => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec', - version => 2, - }, + @METASPEC20, }; - mymeta_ok $mm->mymeta("t/META_for_testing.json"), $want_mymeta, 'MYMETA JSON data (BUILD_REQUIRES wins)'; - mymeta_ok $mm->mymeta("t/META_for_testing.yml"), $want_mymeta, 'MYMETA YAML data (BUILD_REQUIRES wins)'; @@ -730,13 +323,11 @@ my $new_mm = sub { { my $mm = $new_mm->( - DISTNAME => 'Foo-Bar', - VERSION => 1.23, + @GENERIC_IN, CONFIGURE_REQUIRES => { "Fake::Module0" => 0.99 }, BUILD_REQUIRES => { "Fake::Module1" => 1.01 }, TEST_REQUIRES => { "Fake::Module2" => 1.23 }, ); - my $meta = $mm->mymeta('t/META_for_testing.json'); is($meta->{configure_requires}, undef, "no configure_requires in v2 META"); is($meta->{build_requires}, undef, "no build_requires in v2 META"); @@ -745,13 +336,11 @@ my $new_mm = sub { { "Fake::Module0" => 0.99 }, "configure requires are one thing in META v2...", ); - is_deeply( $meta->{prereqs}{build}{requires}, { "Fake::Module1" => 1.01 }, "build requires are one thing in META v2...", ); - is_deeply( $meta->{prereqs}{test}{requires}, { "Fake::Module2" => 1.23 }, @@ -759,7 +348,8 @@ my $new_mm = sub { ); } -note "CPAN::Meta bug using the module version instead of the meta spec version"; { +note "CPAN::Meta bug using the module version instead of the meta spec version"; +{ my $mm = $new_mm->( NAME => 'GD::Barcode::Code93', AUTHOR => 'Chris DiMartino', @@ -770,38 +360,33 @@ note "CPAN::Meta bug using the module version instead of the meta spec version"; }, VERSION => '1.4', ); - my $meta = $mm->mymeta("t/META_for_testing_tricky_version.yml"); is $meta->{'meta-spec'}{version}, 2, "internally, our MYMETA struct is v2"; - in_dir { $mm->write_mymeta($meta); ok -e "MYMETA.yml"; ok -e "MYMETA.json"; - my $meta_yml = Parse::CPAN::Meta->load_file("MYMETA.yml"); is $meta_yml->{'meta-spec'}{version}, 1.4, "MYMETA.yml correctly downgraded to 1.4"; - my $meta_json = Parse::CPAN::Meta->load_file("MYMETA.json"); cmp_ok $meta_json->{'meta-spec'}{version}, ">=", 2, "MYMETA.json at 2 or better"; }; } - -note "A bad license string"; { +note "A bad license string"; +{ my $mm = $new_mm->( - DISTNAME => 'Foo::Bar', - VERSION => '1.4', + @GENERIC_IN, LICENSE => 'death and retribution', ); - in_dir { my $meta = $mm->mymeta; - $mm->write_mymeta($meta); - + { + local $SIG{__WARN__} = sub {}; # suppress "Invalid" warning + $mm->write_mymeta($meta); + } my $meta_yml = Parse::CPAN::Meta->load_file("MYMETA.yml"); is $meta_yml->{license}, "unknown", "in yaml"; - my $meta_json = Parse::CPAN::Meta->load_file("MYMETA.json"); is_deeply $meta_json->{license}, ["unknown"], "in json"; }; diff --git a/cpan/ExtUtils-MakeMaker/t/min_perl_version.t b/cpan/ExtUtils-MakeMaker/t/min_perl_version.t index c5d78d6..6bff1bf 100644 --- a/cpan/ExtUtils-MakeMaker/t/min_perl_version.t +++ b/cpan/ExtUtils-MakeMaker/t/min_perl_version.t @@ -8,22 +8,51 @@ BEGIN { } use strict; +use warnings; use TieOut; use MakeMaker::Test::Utils; -use MakeMaker::Test::Setup::MPV; use Config; -use Test::More; use ExtUtils::MM; -plan !MM->can_run(make()) && $ENV{PERL_CORE} && $Config{'usecrosscompile'} +use Test::More + !MM->can_run(make()) && $ENV{PERL_CORE} && $Config{'usecrosscompile'} ? (skip_all => "cross-compiling and make not available") - : (tests => 36); + : (tests => 35); use File::Path; use ExtUtils::MakeMaker; +my $CM = eval { require CPAN::Meta; }; + +my $DIRNAME = 'Min-PerlVers'; +my %FILES = ( + 'Makefile.PL' => <<'END', +use ExtUtils::MakeMaker; +WriteMakefile( + NAME => 'Min::PerlVers', + AUTHOR => 'John Doe ', + VERSION_FROM => 'lib/Min/PerlVers.pm', + PREREQ_PM => { strict => 0 }, + MIN_PERL_VERSION => '5.005', +); +END + + 'lib/Min/PerlVers.pm' => <<'END', +package Min::PerlVers; +$VERSION = 0.05; + +=head1 NAME + +Min::PerlVers - being picky about perl versions + +=cut + +1; +END + +); # avoid environment variables interfering with our make runs -delete @ENV{qw(LIB MAKEFLAGS)}; +delete @ENV{qw(LIB MAKEFLAGS PERL_CORE)}; my $perl = which_perl(); my $make = make_run(); @@ -33,10 +62,10 @@ chdir 't'; perl_lib(); -ok( setup_recurs(), 'setup' ); +hash2files($DIRNAME, \%FILES); END { ok( chdir(File::Spec->updir), 'leaving dir' ); - ok( teardown_recurs(), 'teardown' ); + ok( rmtree($DIRNAME), 'teardown' ); } ok( chdir 'Min-PerlVers', 'entering dir Min-PerlVers' ) || @@ -138,6 +167,7 @@ END note "PREREQ_PRINT output"; { my $prereq_out = run(qq{$perl Makefile.PL "PREREQ_PRINT=1"}); is( $?, 0, 'PREREQ_PRINT exiting normally' ); + $prereq_out =~ s/.*(\$PREREQ_PM\s*=)/$1/s; # strip off errors eg from chcp my $prereq_out_sane = $prereq_out =~ /^\s*\$PREREQ_PM\s*=/; ok( $prereq_out_sane, ' and talking like we expect' ) || diag($prereq_out); @@ -147,6 +177,7 @@ note "PREREQ_PRINT output"; { package _Prereq::Print::WithMPV; ## no critic our($PREREQ_PM, $BUILD_REQUIRES, $MIN_PERL_VERSION, $ERR); + $BUILD_REQUIRES = undef; # suppress "used only once" $ERR = ''; eval { eval $prereq_out; ## no critic @@ -164,7 +195,7 @@ note "PRINT_PREREQ output"; { is( $?, 0, 'PRINT_PREREQ exiting normally' ); ok( $prereq_out !~ /^warning/i, ' and not complaining loudly' ); like( $prereq_out, - qr/^perl\(perl\) \s* >= 5\.005 \s+ perl\(strict\) \s* >= \s* 0 \s*$/x, + qr/^perl\(perl\) \s* >= 5\.005 \s+ perl\(strict\) \s* >= \s* 0 \s*$/mx, 'dump has prereqs and perl version' ); } @@ -194,14 +225,15 @@ note "ppd output"; { } -note "META.yml output"; { +note "META.yml output"; SKIP: { + skip 'Failed to load CPAN::Meta', 4 unless $CM; my $distdir = 'Min-PerlVers-0.05'; $distdir =~ s{\.}{_}g if $Is_VMS; my $meta_yml = "$distdir/META.yml"; my $meta_json = "$distdir/META.json"; my @make_out = run(qq{$make metafile}); - END { rmtree $distdir } + END { rmtree $distdir if defined $distdir } for my $case ( ['META.yml', $meta_yml], @@ -219,4 +251,3 @@ note "META.yml output"; { ); } } - diff --git a/cpan/ExtUtils-MakeMaker/t/parse_abstract.t b/cpan/ExtUtils-MakeMaker/t/parse_abstract.t index d9c9b3c..18a4519 100644 --- a/cpan/ExtUtils-MakeMaker/t/parse_abstract.t +++ b/cpan/ExtUtils-MakeMaker/t/parse_abstract.t @@ -13,16 +13,17 @@ sub test_abstract { local $Test::Builder::Level = $Test::Builder::Level + 1; - my ($fh,$file) = tempfile( DIR => 't', UNLINK => 1 ); - print $fh $code; - close $fh; - - # Hack up a minimal MakeMaker object. - my $mm = bless { DISTNAME => $package }, "MM"; - my $have = $mm->parse_abstract($file); - - my $ok = is( $have, $want, $name ); - + my $ok = 0; + for my $crlf (0, 1) { + my ($fh,$file) = tempfile( DIR => 't', UNLINK => 1 ); + binmode $fh, $crlf ? ':crlf' : ':raw'; + print $fh $code; + close $fh; + # Hack up a minimal MakeMaker object. + my $mm = bless { DISTNAME => $package }, "MM"; + my $have = $mm->parse_abstract($file); + $ok += is( $have, $want, "$name :crlf=$crlf" ) ? 1 : 0; + } return $ok; } diff --git a/cpan/ExtUtils-MakeMaker/t/parse_version.t b/cpan/ExtUtils-MakeMaker/t/parse_version.t index 5f5f120..0e6a842 100644 --- a/cpan/ExtUtils-MakeMaker/t/parse_version.t +++ b/cpan/ExtUtils-MakeMaker/t/parse_version.t @@ -81,6 +81,35 @@ our $VERSION = 2.34; END } +if( $] >= 5.014 ) { + $versions{'package Foo 1.23 { }' } = '1.23'; + $versions{'package Foo::Bar 1.23 { }' } = '1.23'; + $versions{'package Foo v1.2.3 { }' } = 'v1.2.3'; + $versions{'package Foo::Bar v1.2.3 { }' } = 'v1.2.3'; + $versions{' package Foo::Bar 1.23 { }' } = '1.23'; + $versions{"package Foo'Bar 1.23 { }" } = '1.23'; + $versions{"package Foo::Bar 1.2.3 { }" } = '1.2.3'; + $versions{'package Foo 1.230 { }' } = '1.230'; + $versions{'package Foo 1.23_01 { }' } = '1.23_01'; + $versions{'package Foo v1.23_01 { }' } = 'v1.23_01'; + $versions{<<'END'} = '1.23'; +package Foo 1.23 { +our $VERSION = 2.34; +} +END + + $versions{<<'END'} = '2.34'; +our $VERSION = 2.34; +package Foo 1.23 { } +END + + $versions{<<'END'} = '2.34'; +package Foo::100 { +our $VERSION = 2.34; +} +END +} + if ( $] > 5.009 && $] < 5.012 ) { delete $versions{'$VERSION = -1.0'}; } diff --git a/cpan/ExtUtils-MakeMaker/t/pm_to_blib.t b/cpan/ExtUtils-MakeMaker/t/pm_to_blib.t index 849393c..ebf5f94 100644 --- a/cpan/ExtUtils-MakeMaker/t/pm_to_blib.t +++ b/cpan/ExtUtils-MakeMaker/t/pm_to_blib.t @@ -12,9 +12,9 @@ use ExtUtils::MakeMaker; use MakeMaker::Test::Utils; use MakeMaker::Test::Setup::BFD; use Config; -use Test::More; use ExtUtils::MM; -plan !MM->can_run(make()) && $ENV{PERL_CORE} && $Config{'usecrosscompile'} +use Test::More + !MM->can_run(make()) && $ENV{PERL_CORE} && $Config{'usecrosscompile'} ? (skip_all => "cross-compiling and make not available") : 'no_plan'; @@ -26,10 +26,12 @@ local $ENV{PERL_INSTALL_QUIET}; # Setup our test environment { - my $tmpdir = tempdir( DIR => 't', CLEANUP => 1 ); - chdir $tmpdir; + chdir 't'; + perl_lib; # sets $ENV{PERL5LIB} relative to t/ - perl_lib; + my $tmpdir = tempdir( DIR => '../t', CLEANUP => 1 ); + use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup + chdir $tmpdir; ok( setup_recurs(), 'setup' ); END { diff --git a/cpan/ExtUtils-MakeMaker/t/postamble.t b/cpan/ExtUtils-MakeMaker/t/postamble.t index dbdea95..a20df13 100644 --- a/cpan/ExtUtils-MakeMaker/t/postamble.t +++ b/cpan/ExtUtils-MakeMaker/t/postamble.t @@ -14,10 +14,13 @@ use MakeMaker::Test::Setup::BFD; use ExtUtils::MakeMaker; use TieOut; +chdir 't'; +perl_lib; # sets $ENV{PERL5LIB} relative to t/ + use File::Temp qw[tempdir]; -my $tmpdir = tempdir( DIR => 't', CLEANUP => 1 ); +my $tmpdir = tempdir( DIR => '../t', CLEANUP => 1 ); +use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup chdir $tmpdir; -perl_lib; $| = 1; my $Makefile = makefile_name; diff --git a/cpan/ExtUtils-MakeMaker/t/prereq.t b/cpan/ExtUtils-MakeMaker/t/prereq.t index 1a25e98..a01ff2b 100644 --- a/cpan/ExtUtils-MakeMaker/t/prereq.t +++ b/cpan/ExtUtils-MakeMaker/t/prereq.t @@ -9,7 +9,7 @@ BEGIN { use strict; use Config; -use Test::More tests => 16; +use Test::More tests => 21; use File::Temp qw[tempdir]; use TieOut; @@ -18,14 +18,16 @@ use MakeMaker::Test::Setup::BFD; use ExtUtils::MakeMaker; -my $tmpdir = tempdir( DIR => 't', CLEANUP => 1 ); -chdir $tmpdir; +chdir 't'; +perl_lib; # sets $ENV{PERL5LIB} relative to t/ -perl_lib(); +my $tmpdir = tempdir( DIR => '../t', CLEANUP => 1 ); +use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup +chdir $tmpdir; ok( setup_recurs(), 'setup' ); END { - ok( chdir File::Spec->updir ); + ok( chdir File::Spec->updir, 'chdir updir' ); ok( teardown_recurs(), 'teardown' ); } @@ -33,7 +35,7 @@ ok( chdir 'Big-Dummy', "chdir'd to Big-Dummy" ) || diag("chdir failed: $!"); { - ok( my $stdout = tie *STDOUT, 'TieOut' ); + ok my $stdout = tie(*STDOUT, 'TieOut'), 'tie STDOUT'; my $warnings = ''; local $SIG{__WARN__} = sub { if ( $Config{usecrosscompile} ) { @@ -52,7 +54,20 @@ ok( chdir 'Big-Dummy', "chdir'd to Big-Dummy" ) || strict => 0 } ); - is $warnings, ''; + is $warnings, '', 'basic prereq'; + + SKIP: { + skip 'No CMR, no version ranges', 1 + unless ExtUtils::MakeMaker::_has_cpan_meta_requirements; + $warnings = ''; + WriteMakefile( + NAME => 'Big::Dummy', + PREREQ_PM => { + strict => '>= 0, <= 99999', + } + ); + is $warnings, '', 'version range'; + } $warnings = ''; WriteMakefile( @@ -63,7 +78,7 @@ ok( chdir 'Big-Dummy', "chdir'd to Big-Dummy" ) || ); is $warnings, sprintf("Warning: prerequisite strict 99999 not found. We have %s.\n", - $strict::VERSION); + $strict::VERSION), 'strict 99999'; $warnings = ''; WriteMakefile( @@ -73,7 +88,27 @@ ok( chdir 'Big-Dummy', "chdir'd to Big-Dummy" ) || } ); is $warnings, - "Warning: prerequisite I::Do::Not::Exist 0 not found.\n"; + "Warning: prerequisite I::Do::Not::Exist 0 not found.\n", 'non-exist prereq'; + + $warnings = ''; + WriteMakefile( + NAME => 'Big::Dummy', + CONFIGURE_REQUIRES => { + "I::Do::Not::Configure" => 0, + } + ); + is $warnings, + "Warning: prerequisite I::Do::Not::Configure 0 not found.\n", 'non-exist prereq'; + + $warnings = ''; + WriteMakefile( + NAME => 'Big::Dummy', + TEST_REQUIRES => { + "I::Do::Not::Test" => 0, + } + ); + is $warnings, + "Warning: prerequisite I::Do::Not::Test 0 not found.\n", 'non-exist prereq'; $warnings = ''; @@ -84,9 +119,9 @@ ok( chdir 'Big-Dummy', "chdir'd to Big-Dummy" ) || } ); my @warnings = split /\n/, $warnings; - is @warnings, 2; - like $warnings[0], qr{^Unparsable version '' for prerequisite I::Do::Not::Exist\b}; - is $warnings[1], "Warning: prerequisite I::Do::Not::Exist 0 not found."; + is @warnings, 2, '2 warnings'; + like $warnings[0], qr{^Undefined requirement for I::Do::Not::Exist\b}, 'undef version warning'; + is $warnings[1], "Warning: prerequisite I::Do::Not::Exist 0 not found.", 'not found warning'; $warnings = ''; @@ -100,7 +135,7 @@ ok( chdir 'Big-Dummy', "chdir'd to Big-Dummy" ) || is $warnings, "Warning: prerequisite I::Do::Not::Exist 0 not found.\n". sprintf("Warning: prerequisite strict 99999 not found. We have %s.\n", - $strict::VERSION); + $strict::VERSION), '2 bad prereq warnings'; $warnings = ''; eval { @@ -115,7 +150,7 @@ ok( chdir 'Big-Dummy', "chdir'd to Big-Dummy" ) || ); }; - is $warnings, ''; + is $warnings, '', 'no warnings on PREREQ_FATAL'; is $@, <<'END', "PREREQ_FATAL"; MakeMaker FATAL: prerequisites not found. I::Do::Not::Exist not installed @@ -140,7 +175,7 @@ END ); }; - is $warnings, ''; + is $warnings, '', 'CONFIGURE sub non-exist req no warn'; is $@, <<'END', "PREREQ_FATAL happens before CONFIGURE"; MakeMaker FATAL: prerequisites not found. I::Do::Not::Exist not installed @@ -148,4 +183,17 @@ MakeMaker FATAL: prerequisites not found. Please install these modules first and rerun 'perl Makefile.PL'. END + + $warnings = ''; + @ARGV = 'PREREQ_FATAL=1'; + eval { + WriteMakefile( + NAME => 'Big::Dummy', + PREREQ_PM => { "I::Do::Not::Exist" => 0, }, + ); + }; + is $warnings, "Warning: prerequisite I::Do::Not::Exist 0 not found.\n", + 'CLI PREREQ_FATAL warns'; + isnt $@, '', "CLI PREREQ_FATAL works"; + } diff --git a/cpan/ExtUtils-MakeMaker/t/prereq_print.t b/cpan/ExtUtils-MakeMaker/t/prereq_print.t index b6e12ef..c6135e4 100644 --- a/cpan/ExtUtils-MakeMaker/t/prereq_print.t +++ b/cpan/ExtUtils-MakeMaker/t/prereq_print.t @@ -28,10 +28,12 @@ my $Perl = which_perl(); my $Makefile = makefile_name(); my $Is_VMS = $^O eq 'VMS'; -my $tmpdir = tempdir( DIR => 't', CLEANUP => 1 ); -chdir $tmpdir; +chdir 't'; +perl_lib; # sets $ENV{PERL5LIB} relative to t/ -perl_lib; +my $tmpdir = tempdir( DIR => '../t', CLEANUP => 1 ); +use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup +chdir $tmpdir; $| = 1; @@ -48,6 +50,7 @@ unlink $Makefile; my $prereq_out = run(qq{$Perl Makefile.PL "PREREQ_PRINT=1"}); ok( !-r $Makefile, "PREREQ_PRINT produces no $Makefile" ); is( $?, 0, ' exited normally' ); +$prereq_out =~ s/^'chcp' is not recognized.*batch file\.//s; # remove errors { package _Prereq::Print; no strict; @@ -61,7 +64,7 @@ is( $?, 0, ' exited normally' ); $prereq_out = run(qq{$Perl Makefile.PL "PRINT_PREREQ=1"}); ok( !-r $Makefile, "PRINT_PREREQ produces no $Makefile" ); is( $?, 0, ' exited normally' ); -::like( $prereq_out, qr/^perl\(strict\) \s* >= \s* 0 \s*$/x, +::like( $prereq_out, qr/^perl\(strict\) \s* >= \s* 0 \s*$/mx, 'prereqs dumped' ); diff --git a/cpan/ExtUtils-MakeMaker/t/problems.t b/cpan/ExtUtils-MakeMaker/t/problems.t index 3aeba70..ffe3f05 100644 --- a/cpan/ExtUtils-MakeMaker/t/problems.t +++ b/cpan/ExtUtils-MakeMaker/t/problems.t @@ -6,20 +6,35 @@ BEGIN { chdir 't'; use strict; -use Test::More tests => 6; +use Test::More tests => 5; use ExtUtils::MM; -use MakeMaker::Test::Setup::Problem; +use MakeMaker::Test::Utils; +use File::Path; use TieOut; my $MM = bless { DIR => ['subdir'] }, 'MM'; - -ok( setup_recurs(), 'setup' ); +my $DIRNAME = 'Problem-Module'; +my %FILES = ( + 'Makefile.PL' => <<'END', +use ExtUtils::MakeMaker; +WriteMakefile(NAME => 'Problem::Module'); +END + + 'subdir/Makefile.PL' => <<'END', +printf "\@INC %s .\n", (grep { $_ eq '.' } @INC) ? "has" : "doesn't have"; +warn "I think I'm going to be sick\n"; +die "YYYAaaaakkk\n"; +END + +); + +hash2files($DIRNAME, \%FILES); END { - ok( chdir File::Spec->updir ); - ok( teardown_recurs(), 'teardown' ); + ok( chdir File::Spec->updir, 'chdir ..' ); + ok( rmtree($DIRNAME), 'teardown' ); } -ok( chdir 'Problem-Module', "chdir'd to Problem-Module" ) || +ok( chdir $DIRNAME, "chdir'd to Problem-Module" ) || diag("chdir failed: $!"); diff --git a/cpan/ExtUtils-MakeMaker/t/prompt.t b/cpan/ExtUtils-MakeMaker/t/prompt.t index d6f343e..453a695 100644 --- a/cpan/ExtUtils-MakeMaker/t/prompt.t +++ b/cpan/ExtUtils-MakeMaker/t/prompt.t @@ -35,16 +35,11 @@ like( $stdout->read, qr/^Foo\?\s*\n$/, ' question' ); is( prompt("Foo?", 'Bar!'), 'Bar!', 'default' ); like( $stdout->read, qr/^Foo\? \[Bar!\]\s+Bar!\n$/, ' question' ); - -SKIP: { - skip "eof() doesn't honor ties in 5.5.3", 3 if $] < 5.006; - - $ENV{PERL_MM_USE_DEFAULT} = 0; - close STDIN; - my $stdin = tie *STDIN, 'TieIn' or die; - $stdin->write("From STDIN"); - ok( !-t STDIN, 'STDIN not a tty' ); - - is( prompt("Foo?", 'Bar!'), 'From STDIN', 'from STDIN' ); - like( $stdout->read, qr/^Foo\? \[Bar!\]\s*$/, ' question' ); -} +$ENV{PERL_MM_USE_DEFAULT} = 0; +close STDIN; +my $stdin = tie *STDIN, 'TieIn' or die; +$stdin->write("From STDIN"); +ok( !-t STDIN, 'STDIN not a tty' ); + +is( prompt("Foo?", 'Bar!'), 'From STDIN', 'from STDIN' ); +like( $stdout->read, qr/^Foo\? \[Bar!\]\s*$/, ' question' ); diff --git a/cpan/ExtUtils-MakeMaker/t/recurs.t b/cpan/ExtUtils-MakeMaker/t/recurs.t index 6f1c093..f69e6a1 100644 --- a/cpan/ExtUtils-MakeMaker/t/recurs.t +++ b/cpan/ExtUtils-MakeMaker/t/recurs.t @@ -7,42 +7,60 @@ BEGIN { } use strict; -use Config; - -use File::Temp qw[tempdir]; - +use warnings; use MakeMaker::Test::Utils; -use MakeMaker::Test::Setup::Recurs; use Config; -use Test::More; use ExtUtils::MM; -plan !MM->can_run(make()) && $ENV{PERL_CORE} && $Config{'usecrosscompile'} +use Test::More + !MM->can_run(make()) && $ENV{PERL_CORE} && $Config{'usecrosscompile'} ? (skip_all => "cross-compiling and make not available") - : (tests => 26); + : (tests => 28); +use File::Temp qw[tempdir]; +use File::Path; # 'make disttest' sets a bunch of environment variables which interfere # with our testing. delete @ENV{qw(PREFIX LIB MAKEFLAGS)}; -my $perl = which_perl(); -my $Is_VMS = $^O eq 'VMS'; +my $DIRNAME = 'Recurs'; +my $BASICMPL = <<'END'; +use ExtUtils::MakeMaker; +WriteMakefile(NAME => 'Recurs', VERSION => 1.00); +END +my %FILES = ( + 'Makefile.PL' => $BASICMPL, + + 'prj2/Makefile.PL' => <<'END', +use ExtUtils::MakeMaker; +WriteMakefile(NAME => 'Recurs::prj2', VERSION => 1.00); +END + + # Check if a test failure in a subdir causes make test to fail + 'prj2/t/fail.t' => <<'END', +#!/usr/bin/perl -w +print "1..1\n"; +print "not ok 1\n"; +END +); -my $tmpdir = tempdir( DIR => 't', CLEANUP => 1 ); -chdir $tmpdir; +my $perl = which_perl(); -perl_lib; +chdir 't'; +perl_lib; # sets $ENV{PERL5LIB} relative to t/ -my $Touch_Time = calibrate_mtime(); +my $tmpdir = tempdir( DIR => '../t', CLEANUP => 1 ); +use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup +chdir $tmpdir; $| = 1; -ok( setup_recurs(), 'setup' ); +hash2files($DIRNAME, \%FILES); END { ok( chdir File::Spec->updir ); - ok( teardown_recurs(), 'teardown' ); + ok( rmtree($DIRNAME), 'teardown' ); } -ok( chdir('Recurs'), q{chdir'd to Recurs} ) || +ok( chdir($DIRNAME), q{chdir'd to Recurs} ) || diag("chdir failed: $!"); @@ -63,9 +81,9 @@ my $make_out = run("$make"); is( $?, 0, 'recursive make exited normally' ) || diag $make_out; ok( chdir File::Spec->updir ); -ok( teardown_recurs(), 'cleaning out recurs' ); -ok( setup_recurs(), ' setting up fresh copy' ); -ok( chdir('Recurs'), q{chdir'd to Recurs} ) || +ok( rmtree($DIRNAME), 'cleaning out recurs' ); +hash2files($DIRNAME, \%FILES); +ok( chdir($DIRNAME), q{chdir'd to Recurs} ) || diag("chdir failed: $!"); @@ -87,9 +105,9 @@ is( $?, 0, 'recursive make exited normally' ); ok( chdir File::Spec->updir ); -ok( teardown_recurs(), 'cleaning out recurs' ); -ok( setup_recurs(), ' setting up fresh copy' ); -ok( chdir('Recurs'), q{chdir'd to Recurs} ) || +ok( rmtree($DIRNAME), 'cleaning out recurs' ); +hash2files($DIRNAME, \%FILES); +ok( chdir($DIRNAME), q{chdir'd to Recurs} ) || diag("chdir failed: $!"); @@ -122,3 +140,43 @@ close MAKEFILE; my $test_out = run("$make test"); isnt $?, 0, 'test failure in a subdir causes make to fail'; } + +# test override of top_targets in sub-M.PL with no pure_nolink doesn't break +ok( chdir File::Spec->updir ); +ok( rmtree($DIRNAME), 'cleaning out recurs' ); +hash2files($DIRNAME, { + 'Makefile.PL' => $BASICMPL, + + 'subdir/Makefile.PL' => <<'EOF', +use ExtUtils::MakeMaker; +WriteMakefile( + NAME => 'Recurs::subdir', + SKIP => [qw(all static static_lib dynamic dynamic_lib)], +); + +sub MY::top_targets {' +all :: static + +pure_all :: static + +static :: libfcrypt$(LIB_EXT) + +libfcrypt$(LIB_EXT) : + $(TOUCH) libfcrypt$(LIB_EXT) + +dynamic : + $(NOOP) +'; +} +EOF + +}); +ok( chdir($DIRNAME), q{chdir'd to Recurs} ) || + diag("chdir failed: $!"); +@mpl_out = run(qq{$perl Makefile.PL}); + +cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) || + diag(@mpl_out); + +$make_out = run($make); +is( $?, 0, 'recursive make exited normally' ) || diag $make_out; diff --git a/cpan/ExtUtils-MakeMaker/t/several_authors.t b/cpan/ExtUtils-MakeMaker/t/several_authors.t index 4753541..027393c 100644 --- a/cpan/ExtUtils-MakeMaker/t/several_authors.t +++ b/cpan/ExtUtils-MakeMaker/t/several_authors.t @@ -11,37 +11,67 @@ use strict; use TieOut; use MakeMaker::Test::Utils; -use MakeMaker::Test::Setup::SAS; use Config; -use Test::More; use ExtUtils::MM; -plan !MM->can_run(make()) && $ENV{PERL_CORE} && $Config{'usecrosscompile'} +use Test::More + !MM->can_run(make()) && $ENV{PERL_CORE} && $Config{'usecrosscompile'} ? (skip_all => "cross-compiling and make not available") - : (tests => 20); + : (tests => 19); use File::Path; use File::Temp qw[tempdir]; use ExtUtils::MakeMaker; +my $CM = eval { require CPAN::Meta; }; + +my $DIRNAME = 'Multiple-Authors'; +my %FILES = ( + 'Makefile.PL' => <<'END', +use ExtUtils::MakeMaker; +WriteMakefile( + NAME => 'Multiple::Authors', + AUTHOR => ['John Doe ', 'Jane Doe '], + VERSION_FROM => 'lib/Multiple/Authors.pm', + PREREQ_PM => { strict => 0 }, +); +END + + 'lib/Multiple/Authors.pm' => <<'END', +package Multiple::Authors; + +$VERSION = 0.05; + +=head1 NAME + +Multiple::Authors - several authors + +=cut + +1; +END + +); # avoid environment variables interfering with our make runs -delete @ENV{qw(LIB MAKEFLAGS)}; +delete @ENV{qw(LIB MAKEFLAGS PERL_CORE)}; my $perl = which_perl(); my $make = make_run(); my $makefile = makefile_name(); -my $tmpdir = tempdir( DIR => 't', CLEANUP => 1 ); -chdir $tmpdir; +chdir 't'; +perl_lib; # sets $ENV{PERL5LIB} relative to t/ -perl_lib(); +my $tmpdir = tempdir( DIR => '../t', CLEANUP => 1 ); +use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup +chdir $tmpdir; -ok( setup_recurs(), 'setup' ); +hash2files($DIRNAME, \%FILES); END { ok( chdir(File::Spec->updir), 'leaving dir' ); - ok( teardown_recurs(), 'teardown' ); + ok( rmtree($DIRNAME), 'teardown' ); } -ok( chdir $MakeMaker::Test::Setup::SAS::dirname, "entering dir $MakeMaker::Test::Setup::SAS::dirname" ) || +ok( chdir $DIRNAME, "entering dir $DIRNAME" ) || diag("chdir failed: $!"); note "argument verification"; { @@ -111,14 +141,15 @@ note "ppd output"; { } -note "META.yml output"; { +note "META.yml output"; SKIP: { + skip 'Failed to load CPAN::Meta', 5 unless $CM; my $distdir = 'Multiple-Authors-0.05'; $distdir =~ s{\.}{_}g if $Is_VMS; my $meta_yml = "$distdir/META.yml"; my $meta_json = "$distdir/META.json"; my @make_out = run(qq{$make metafile}); - END { rmtree $distdir } + END { rmtree $distdir if defined $distdir } cmp_ok( $?, '==', 0, 'Make metafile exiting normally' ) || diag(@make_out); diff --git a/cpan/ExtUtils-MakeMaker/t/test_boilerplate.t b/cpan/ExtUtils-MakeMaker/t/test_boilerplate.t index f48324f..fa82631 100644 --- a/cpan/ExtUtils-MakeMaker/t/test_boilerplate.t +++ b/cpan/ExtUtils-MakeMaker/t/test_boilerplate.t @@ -14,8 +14,6 @@ use lib './lib'; use strict; use ExtUtils::MakeMaker; -use Test::More; +use Test::More tests => 1; -pass("Your test code goes here"); - -done_testing(); +ok(1, "Your test code goes here"); diff --git a/cpan/ExtUtils-MakeMaker/t/unicode.t b/cpan/ExtUtils-MakeMaker/t/unicode.t index 2bb56aa..557ac77 100644 --- a/cpan/ExtUtils-MakeMaker/t/unicode.t +++ b/cpan/ExtUtils-MakeMaker/t/unicode.t @@ -6,27 +6,74 @@ BEGIN { chdir 't'; use strict; +use ExtUtils::MM; +use MakeMaker::Test::Utils qw(makefile_name make make_run run hash2files); use Test::More; use Config; +use File::Path; +use utf8; BEGIN { plan skip_all => 'Need perlio and perl 5.8+.' if $] < 5.008 or !$Config{useperlio}; - plan tests => 9; + plan skip_all => 'cross-compiling and make not available' + if !MM->can_run(make()) && $ENV{PERL_CORE} && $Config{'usecrosscompile'}; + + plan tests => 8; } -use ExtUtils::MM; -use MakeMaker::Test::Setup::Unicode; -use MakeMaker::Test::Utils qw(makefile_name make_run run); use TieOut; my $MM = bless { DIR => ['.'] }, 'MM'; -ok( setup_recurs(), 'setup' ); +my $DIRNAME = 'Problem-Module'; +my %FILES = ( + 'Makefile.PL' => <<'PL_END', +use ExtUtils::MakeMaker; +use utf8; +WriteMakefile( + NAME => 'Problem::Module', + ABSTRACT_FROM => 'lib/Problem/Module.pm', + AUTHOR => q{Danijel TaÅ¡ov}, + EXE_FILES => [ qw(bin/probscript) ], + INSTALLMAN1DIR => "some", # even if disabled in $Config{man1dir} + MAN1EXT => 1, # set to 0 if man pages disabled +); +PL_END + + 'lib/Problem/Module.pm' => <<'pm_END', +use utf8; + +=pod + +=encoding utf8 + +=head1 NAME + +Problem::Module - Danijel TaÅ¡ov's great new module + +=cut + +1; +pm_END + + 'bin/probscript' => <<'pl_END', +#!/usr/bin/perl +use utf8; + +=encoding utf8 + +=head1 NAME + +文档 - Problem script +pl_END +); + +hash2files($DIRNAME, \%FILES); END { ok( chdir File::Spec->updir, 'chdir updir' ); - ok( teardown_recurs(), 'teardown' ); + ok( rmtree($DIRNAME), 'teardown' ); } -ok( chdir 'Problem-Module', "chdir'd to Problem-Module" ) || +ok( chdir $DIRNAME, "chdir'd to $DIRNAME" ) || diag("chdir failed: $!"); if ($] >= 5.008) { @@ -52,6 +99,7 @@ if ($] >= 5.008) { my $json = do { local $/; <$json_fh> }; close $json_fh; + no utf8; # leave the data below as bytes and let Encode sort it out require Encode; my $str = Encode::decode( 'utf8', "Danijel TaÅ¡ov's" ); like( $json, qr/$str/, 'utf8 abstract' ); @@ -60,8 +108,8 @@ if ($] >= 5.008) { } my $make = make_run(); -my $make_out = run("$make"); -is $? >> 8, 0, 'Exit code of make == 0'; +my $make_out = run($make); +diag $make_out unless is $? >> 8, 0, 'Exit code of make == 0'; my $manfile = File::Spec->catfile(qw(blib man1 probscript.1)); SKIP: { @@ -73,13 +121,14 @@ SKIP: { my $man = do { local $/; <$man_fh> }; close $man_fh; + no utf8; # leave the data below as bytes and let Encode sort it out require Encode; my $str = Encode::decode( 'utf8', "文档" ); like( $man, qr/$str/, 'utf8 man-snippet' ); } $make_out = run("$make realclean"); -is $? >> 8, 0, 'Exit code of make == 0'; +diag $make_out unless is $? >> 8, 0, 'Exit code of make == 0'; sub makefile_content { open my $fh, '<', makefile_name or die; diff --git a/cpan/ExtUtils-MakeMaker/t/vstrings.t b/cpan/ExtUtils-MakeMaker/t/vstrings.t index 1020f55..9f88399 100644 --- a/cpan/ExtUtils-MakeMaker/t/vstrings.t +++ b/cpan/ExtUtils-MakeMaker/t/vstrings.t @@ -15,13 +15,55 @@ use warnings; use TieOut; use MakeMaker::Test::Utils qw(makefile_name); use File::Temp qw[tempdir]; +use Test::More; use ExtUtils::MakeMaker; -use Test::More; my $tmpdir = tempdir( DIR => '.', CLEANUP => 1 ); +use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup chdir $tmpdir; +my $UNDEFRE = qr/Undefined requirement .* treated as '0'/; +my $UNPARSABLERE = qr/Unparsable\s+version/; +# [ pkg, version, okwarningRE, descrip, nocmrRE ] +# only supply nocmrRE if want to treat differently when no CMR +my @DATA = ( + [ Undef => undef, $UNDEFRE, 'Undef' ], + [ ZeroLength => '', $UNDEFRE, 'Zero-length' ], + [ SemiColon => '0;', $UNPARSABLERE, 'Semi-colon after 0' ], + [ BrokenString => 'nan', $UNPARSABLERE, 'random string' ], + [ Decimal2 => 1.2, qr/^$/, '2-part Decimal' ], + [ Decimal2String => '1.2', qr/^$/, '2-part Decimal String' ], + [ Decimal2Underscore => '1.02_03', qr/^$/, '2-part Underscore String' ], + [ Decimal3String => '1.2.3', qr/^$/, '3-part Decimal String', $UNPARSABLERE ], + [ BareV2String => v1.2, qr/^$/, '2-part bare v-string', $UNPARSABLERE ], + [ BareV3String => v1.2.3, qr/^$/, '3-part bare V-string', $UNPARSABLERE ], + [ V2DecimalString => 'v1.2', qr/^$/, '2-part v-decimal string', $UNPARSABLERE ], + [ V3DecimalString => 'v1.2.3', qr/^$/, '3-part v-Decimal String', $UNPARSABLERE ], + [ RangeString => '>= 5.0, <= 6.0', qr/^$/, 'Version range', $UNPARSABLERE ], + [ Scientific => 0.000005, qr/^$/, 'Scientific Notation' ], +); + +plan tests => (1 + (@DATA * 4)); + +ok my $stdout = tie(*STDOUT, 'TieOut'), 'tie STDOUT'; + +# fake CMR to test fallback if CMR not present +my $CMR = 'CPAN/Meta/Requirements.pm'; +my $CM = 'CPAN/Meta.pm'; +$INC{$CMR} = undef; +$INC{$CM} = undef; +run_test(0, @$_) for @DATA; + +# now try to load real CMR +delete $INC{$CMR}; +delete $INC{$CM}; +SKIP: { + skip 'No actual CMR found', 2 * @DATA + unless ExtUtils::MakeMaker::_has_cpan_meta_requirements; + run_test(1, @$_) for @DATA; +} + sub capture_make { my ($package, $version) = @_ ; @@ -41,33 +83,23 @@ sub capture_make { } sub makefile_content { - open my $fh, '<', makefile_name or die; - return <$fh>; + my $file = makefile_name; + open my $fh, '<', $file or return "$file: $!\n"; + join q{}, grep { $_ =~ /Fake/i } <$fh>; } -# [ pkg, version, pattern, descrip, invertre ] -my @DATA = ( - [ DecimalString => '1.2.3', qr/isn't\s+numeric/, '3-part Decimal String' ], - [ VDecimalString => 'v1.2.3', qr/Unparsable\s+version/, '3-part V-Decimal String' ], - [ BareVString => v1.2.3, qr/Unparsable\s+version/, '3-part bare V-string' ], - [ VDecimalString => 'v1.2', qr/Unparsable\s+version/, '2-part v-decimal string' ], - [ BareVString => v1.2, qr/Unparsable\s+version/, '2-part bare v-string' ], - [ BrokenString => 'nan', qr/Unparsable\s+version/, 'random string', 1 ], -); - -ok(my $stdout = tie *STDOUT, 'TieOut'); -for my $tuple (@DATA) { - my ($pkg, $version, $pattern, $descrip, $invertre) = @$tuple; - next if $] < 5.008 && $pkg eq 'BareVString' && $descrip =~ m!^2-part!; - my $out; - eval { $out = capture_make("Fake::$pkg" => $version); }; - is($@, '', "$descrip not fatal"); - if ($invertre) { - like ( $out , qr/$pattern/i, "$descrip parses"); - } else { - unlike ( $out , qr/$pattern/i , "$descrip parses"); +sub run_test { + my ($gotrealcmr, $pkg, $version, $okwarningRE, $descrip, $nocmrRE) = @_; + local $_; + SKIP: { + skip "No vstring test <5.8", 2 + if $] < 5.008 && $pkg eq 'BareV2String' && $descrip =~ m!^2-part!; + my $warnings; + eval { $warnings = capture_make("Fake::$pkg" => $version); }; + is($@, '', "$descrip not fatal") or skip "$descrip WM failed", 1; + $warnings =~ s#^Warning: prerequisite Fake::$pkg.* not found\.\n##m; + my $re = (!$gotrealcmr && $nocmrRE) ? $nocmrRE : $okwarningRE; + like $warnings, $re, "$descrip handled right"; } -# note(join q{}, grep { $_ =~ /Fake/i } makefile_content); +# diag makefile_content(); } - -done_testing(); diff --git a/cpan/ExtUtils-MakeMaker/t/writemakefile_args.t b/cpan/ExtUtils-MakeMaker/t/writemakefile_args.t index d1b4d41..460a8a2 100644 --- a/cpan/ExtUtils-MakeMaker/t/writemakefile_args.t +++ b/cpan/ExtUtils-MakeMaker/t/writemakefile_args.t @@ -17,12 +17,14 @@ use MakeMaker::Test::Setup::BFD; use ExtUtils::MakeMaker; +chdir 't'; +perl_lib; # sets $ENV{PERL5LIB} relative to t/ + use File::Temp qw[tempdir]; -my $tmpdir = tempdir( DIR => 't', CLEANUP => 1 ); +my $tmpdir = tempdir( DIR => '../t', CLEANUP => 1 ); +use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup chdir $tmpdir; -perl_lib(); - ok( setup_recurs(), 'setup' ); END { ok( chdir File::Spec->updir ); diff --git a/cpan/ExtUtils-MakeMaker/t/xs.t b/cpan/ExtUtils-MakeMaker/t/xs.t deleted file mode 100644 index cdeb6dd..0000000 --- a/cpan/ExtUtils-MakeMaker/t/xs.t +++ /dev/null @@ -1,53 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - unshift @INC, 't/lib/'; -} -chdir 't'; - -use strict; - -use MakeMaker::Test::Utils; -use MakeMaker::Test::Setup::XS; -use Test::More - have_compiler() - ? (tests => 5) - : (skip_all => "ExtUtils::CBuilder not installed or couldn't find a compiler"); -use File::Spec; - -my $Is_VMS = $^O eq 'VMS'; -my $perl = which_perl(); - -chdir 't'; - -perl_lib; - -$| = 1; - -ok( setup_xs(), 'setup' ); -END { - chdir File::Spec->updir or die; - teardown_xs(), 'teardown' or die; -} - -ok( chdir('XS-Test'), "chdir'd to XS-Test" ) || - diag("chdir failed: $!"); - -my @mpl_out = run(qq{$perl Makefile.PL}); -SKIP: { - unless (cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' )) { - diag(@mpl_out); - skip 'perl Makefile.PL failed', 2; - } - - my $make = make_run(); - my $make_out = run("$make"); - unless (is( $?, 0, ' make exited normally' )) { - diag $make_out; - skip 'Make failed - skipping test', 1; - } - - my $test_out = run("$make test"); - is( $?, 0, ' make test exited normally' ) || - diag $test_out; -} diff --git a/cpan/Getopt-Long/lib/Getopt/Long.pm b/cpan/Getopt-Long/lib/Getopt/Long.pm index fdc96bd..5e1834f 100644 --- a/cpan/Getopt-Long/lib/Getopt/Long.pm +++ b/cpan/Getopt-Long/lib/Getopt/Long.pm @@ -4,8 +4,8 @@ # Author : Johan Vromans # Created On : Tue Sep 11 15:00:12 1990 # Last Modified By: Johan Vromans -# Last Modified On: Thu Oct 8 14:57:49 2015 -# Update Count : 1697 +# Last Modified On: Thu Jun 9 14:50:37 2016 +# Update Count : 1699 # Status : Released ################ Module Preamble ################ @@ -17,10 +17,10 @@ use 5.004; use strict; use vars qw($VERSION); -$VERSION = 2.48; +$VERSION = 2.49; # For testing versions only. use vars qw($VERSION_STRING); -$VERSION_STRING = "2.48"; +$VERSION_STRING = "2.49"; use Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK); @@ -1112,7 +1112,7 @@ sub FindOption ($$$$$) { if ( $gnu_compat ) { my $optargtype = 0; # 0 = none, 1 = empty, 2 = nonempty $optargtype = ( !defined($optarg) ? 0 : ( (length($optarg) == 0) ? 1 : 2 ) ); - return (1, $opt, $ctl, undef) + return (1, $opt, $ctl, defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : undef) if (($optargtype == 0) && !$mand); return (1, $opt, $ctl, $type eq 's' ? '' : 0) if $optargtype == 1; # --foo= -> return nothing @@ -1451,7 +1451,7 @@ sub VersionMessage(@) { my $v = $main::VERSION; my $fh = $pa->{-output} || - ($pa->{-exitval} eq "NOEXIT" || $pa->{-exitval} < 2) ? \*STDOUT : \*STDERR; + ( ($pa->{-exitval} eq "NOEXIT" || $pa->{-exitval} < 2) ? \*STDOUT : \*STDERR ); print $fh (defined($pa->{-message}) ? $pa->{-message} : (), $0, defined $v ? " version $v" : (), diff --git a/cpan/HTTP-Tiny/corpus/get-02.txt b/cpan/HTTP-Tiny/corpus/get-02.txt index 4b540f4..3d359d5 100644 --- a/cpan/HTTP-Tiny/corpus/get-02.txt +++ b/cpan/HTTP-Tiny/corpus/get-02.txt @@ -5,13 +5,17 @@ expected headers Accept: */* X-Custom: This is a custom header + x-lower: This is a lower-case custom header + authorization: fake auth data ---------- GET /index.html HTTP/1.1 Host: example.com Accept: */* +Authorization: fake auth data Connection: close User-Agent: HTTP-Tiny/VERSION X-Custom: This is a custom header +x-lower: This is a lower-case custom header ---------- HTTP/1.1 200 OK diff --git a/cpan/HTTP-Tiny/corpus/get-22.txt b/cpan/HTTP-Tiny/corpus/get-22.txt new file mode 100644 index 0000000..d6f20c0 --- /dev/null +++ b/cpan/HTTP-Tiny/corpus/get-22.txt @@ -0,0 +1,10 @@ +url + http://example.com/index.html +expected_rc + 599 +expected_like + Invalid HTTP header field +headers + trailing-space : foo +---------- +---------- diff --git a/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm b/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm index 52887d1..42653e0 100644 --- a/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm +++ b/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm @@ -4,7 +4,7 @@ use strict; use warnings; # ABSTRACT: A small, simple, correct HTTP/1.1 client -our $VERSION = '0.056'; +our $VERSION = '0.058'; use Carp (); @@ -15,35 +15,34 @@ use Carp (); #pod This constructor returns a new HTTP::Tiny object. Valid attributes include: #pod #pod =for :list -#pod * C — -#pod A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C — ends in a space character, the default user-agent string is appended. -#pod * C — -#pod An instance of L — or equivalent class that supports the C and C methods -#pod * C — -#pod A hashref of default headers to apply to requests -#pod * C — -#pod The local IP address to bind to -#pod * C — -#pod Whether to reuse the last connection (if for the same scheme, host and port) (defaults to 1) -#pod * C — -#pod Maximum number of redirects allowed (defaults to 5) -#pod * C — -#pod Maximum response size in bytes (only when not using a data callback). If defined, responses larger than this will return an exception. -#pod * C — -#pod URL of a proxy server to use for HTTP connections (default is C<$ENV{http_proxy}> — if set) -#pod * C — -#pod URL of a proxy server to use for HTTPS connections (default is C<$ENV{https_proxy}> — if set) -#pod * C — -#pod URL of a generic proxy server for both HTTP and HTTPS connections (default is C<$ENV{all_proxy}> — if set) -#pod * C — -#pod List of domain suffixes that should not be proxied. Must be a comma-separated string or an array reference. (default is C<$ENV{no_proxy}> —) -#pod * C — -#pod Request timeout in seconds (default is 60) -#pod * C — -#pod A boolean that indicates whether to validate the SSL certificate of an C — -#pod connection (default is false) -#pod * C — -#pod A hashref of C — options to pass through to L +#pod * C — A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If +#pod C — ends in a space character, the default user-agent string is +#pod appended. +#pod * C — An instance of L — or equivalent class +#pod that supports the C and C methods +#pod * C — A hashref of default headers to apply to requests +#pod * C — The local IP address to bind to +#pod * C — Whether to reuse the last connection (if for the same +#pod scheme, host and port) (defaults to 1) +#pod * C — Maximum number of redirects allowed (defaults to 5) +#pod * C — Maximum response size in bytes (only when not using a data +#pod callback). If defined, responses larger than this will return an +#pod exception. +#pod * C — URL of a proxy server to use for HTTP connections +#pod (default is C<$ENV{http_proxy}> — if set) +#pod * C — URL of a proxy server to use for HTTPS connections +#pod (default is C<$ENV{https_proxy}> — if set) +#pod * C — URL of a generic proxy server for both HTTP and HTTPS +#pod connections (default is C<$ENV{all_proxy}> — if set) +#pod * C — List of domain suffixes that should not be proxied. Must +#pod be a comma-separated string or an array reference. (default is +#pod C<$ENV{no_proxy}> —) +#pod * C — Request timeout in seconds (default is 60) If a socket open, +#pod read or write takes longer than the timeout, an exception is thrown. +#pod * C — A boolean that indicates whether to validate the SSL +#pod certificate of an C — connection (default is false) +#pod * C — A hashref of C — options to pass through to +#pod L #pod #pod Passing an explicit C for C, C or C will #pod prevent getting the corresponding proxies from the environment. @@ -66,7 +65,7 @@ my @attributes; BEGIN { @attributes = qw( cookie_jar default_headers http_proxy https_proxy keep_alive - local_address max_redirect max_size proxy no_proxy timeout + local_address max_redirect max_size proxy no_proxy SSL_options verify_SSL ); my %persist_ok = map {; $_ => 1 } qw( @@ -95,6 +94,17 @@ sub agent { return $self->{agent}; } +sub timeout { + my ($self, $timeout) = @_; + if ( @_ > 1 ) { + $self->{timeout} = $timeout; + if ($self->{handle}) { + $self->{handle}->timeout($timeout); + } + } + return $self->{timeout}; +} + sub new { my($class, %args) = @_; @@ -337,6 +347,11 @@ sub mirror { #pod * C — #pod A code reference that will be called for each chunks of the response #pod body received. +#pod * C — +#pod Override host resolution and force all connections to go only to a +#pod specific peer address, regardless of the URL of the request. This will +#pod include any redirections! This options should be used with extreme +#pod caution (e.g. debugging or very special circumstances). #pod #pod The C header is generated from the URL in accordance with RFC 2616. It #pod is a fatal error to specify C in the C option. Other headers @@ -378,6 +393,10 @@ sub mirror { #pod A hashref of header fields. All header field names will be normalized #pod to be lower case. If a header is repeated, the value will be an arrayref; #pod it will otherwise be a scalar string containing the value +#pod * C +#pod If this field exists, it is an arrayref of response hash references from +#pod redirects in the same order that redirections occurred. If it does +#pod not exist, then no redirections occurred. #pod #pod On an exception during the execution of the request, the C field will #pod contain 599, and the C field will contain the text of the exception. @@ -511,6 +530,41 @@ sub can_ssl { wantarray ? ($ok, $reason) : $ok; } +#pod =method connected +#pod +#pod $host = $http->connected; +#pod ($host, $port) = $http->connected; +#pod +#pod Indicates if a connection to a peer is being kept alive, per the C +#pod option. +#pod +#pod In scalar context, returns the peer host and port, joined with a colon, or +#pod C (if no peer is connected). +#pod In list context, returns the peer host and port or an empty list (if no peer +#pod is connected). +#pod +#pod B: This method cannot reliably be used to discover whether the remote +#pod host has closed its end of the socket. +#pod +#pod =cut + +sub connected { + my ($self) = @_; + + # If a socket exists... + if ($self->{handle} && $self->{handle}{fh}) { + my $socket = $self->{handle}{fh}; + + # ...and is connected, return the peer host and port. + if ($socket->connected) { + return wantarray + ? ($socket->peerhost, $socket->peerport) + : join(':', $socket->peerhost, $socket->peerport); + } + } + return; +} + #--------------------------------------------------------------------------# # private methods #--------------------------------------------------------------------------# @@ -541,17 +595,19 @@ sub _request { headers => {}, }; + my $peer = $args->{peer} || $host; + # We remove the cached handle so it is not reused in the case of redirect. # If all is well, it will be recached at the end of _request. We only # reuse for the same scheme, host and port my $handle = delete $self->{handle}; if ( $handle ) { - unless ( $handle->can_reuse( $scheme, $host, $port ) ) { + unless ( $handle->can_reuse( $scheme, $host, $port, $peer ) ) { $handle->close; undef $handle; } } - $handle ||= $self->_open_handle( $request, $scheme, $host, $port ); + $handle ||= $self->_open_handle( $request, $scheme, $host, $port, $peer ); $self->_prepare_headers_and_cb($request, $args, $url, $auth); $handle->write_request($request); @@ -561,11 +617,7 @@ sub _request { until (substr($response->{status},0,1) ne '1'); $self->_update_cookie_jar( $url, $response ) if $self->{cookie_jar}; - - if ( my @redir_args = $self->_maybe_redirect($request, $response, $args) ) { - $handle->close; - return $self->_request(@redir_args, $args); - } + my @redir_args = $self->_maybe_redirect($request, $response, $args); my $known_message_length; if ($method eq 'HEAD' || $response->{status} =~ /^[23]04/) { @@ -573,7 +625,9 @@ sub _request { $known_message_length = 1; } else { - my $data_cb = $self->_prepare_data_cb($response, $args); + # Ignore any data callbacks during redirection. + my $cb_args = @redir_args ? +{} : $args; + my $data_cb = $self->_prepare_data_cb($response, $cb_args); $known_message_length = $handle->read_body($data_cb, $response); } @@ -590,11 +644,21 @@ sub _request { $response->{success} = substr( $response->{status}, 0, 1 ) eq '2'; $response->{url} = $url; + + # Push the current response onto the stack of redirects if redirecting. + if (@redir_args) { + push @{$args->{_redirects}}, $response; + return $self->_request(@redir_args, $args); + } + + # Copy the stack of redirects into the response before returning. + $response->{redirects} = delete $args->{_redirects} + if @{$args->{_redirects}}; return $response; } sub _open_handle { - my ($self, $request, $scheme, $host, $port) = @_; + my ($self, $request, $scheme, $host, $port, $peer) = @_; my $handle = HTTP::Tiny::Handle->new( timeout => $self->{timeout}, @@ -608,7 +672,7 @@ sub _open_handle { return $self->_proxy_connect( $request, $handle ); } else { - return $handle->connect($scheme, $host, $port); + return $handle->connect($scheme, $host, $port, $peer); } } @@ -634,7 +698,7 @@ sub _proxy_connect { $self->_add_basic_auth_header( $request, 'proxy-authorization' => $p_auth ); } - $handle->connect($p_scheme, $p_host, $p_port); + $handle->connect($p_scheme, $p_host, $p_port, $p_host); if ($request->{scheme} eq 'https') { $self->_create_proxy_tunnel( $request, $handle ); @@ -708,6 +772,7 @@ sub _prepare_headers_and_cb { next unless defined; while (my ($k, $v) = each %$_) { $request->{headers}{lc $k} = $v; + $request->{header_case}{lc $k} = $k; } } @@ -815,9 +880,11 @@ sub _maybe_redirect { my ($self, $request, $response, $args) = @_; my $headers = $response->{headers}; my ($status, $method) = ($response->{status}, $request->{method}); + $args->{_redirects} ||= []; + if (($status eq '303' or ($status =~ /^30[1278]/ && $method =~ /^GET|HEAD$/)) and $headers->{location} - and ++$args->{redirects} <= $self->{max_redirect} + and @{$args->{_redirects}} < $self->{max_redirect} ) { my $location = ($headers->{location} =~ /^\//) ? "$request->{scheme}://$request->{host_port}$headers->{location}" @@ -913,6 +980,7 @@ use warnings; use Errno qw[EINTR EPIPE]; use IO::Socket qw[SOCK_STREAM]; +use Socket qw[SOL_SOCKET SO_KEEPALIVE]; # PERL_HTTP_TINY_IPV4_ONLY is a private environment variable to force old # behavior if someone is unable to boostrap CPAN from a new perl install; it is @@ -934,6 +1002,7 @@ my $Printable = sub { }; my $Token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/; +my $Field_Content = qr/[[:print:]]+ (?: [\x20\x09]+ [[:print:]]+ )*/x; sub new { my ($class, %args) = @_; @@ -948,9 +1017,20 @@ sub new { }, $class; } +sub timeout { + my ($self, $timeout) = @_; + if ( @_ > 1 ) { + $self->{timeout} = $timeout; + if ( $self->{fh} && $self->{fh}->can('timeout') ) { + $self->{fh}->timeout($timeout); + } + } + return $self->{timeout}; +} + sub connect { - @_ == 4 || die(q/Usage: $handle->connect(scheme, host, port)/ . "\n"); - my ($self, $scheme, $host, $port) = @_; + @_ == 5 || die(q/Usage: $handle->connect(scheme, host, port, peer)/ . "\n"); + my ($self, $scheme, $host, $port, $peer) = @_; if ( $scheme eq 'https' ) { $self->_assert_ssl; @@ -959,23 +1039,30 @@ sub connect { die(qq/Unsupported URL scheme '$scheme'\n/); } $self->{fh} = $SOCKET_CLASS->new( - PeerHost => $host, + PeerHost => $peer, PeerPort => $port, $self->{local_address} ? ( LocalAddr => $self->{local_address} ) : (), Proto => 'tcp', Type => SOCK_STREAM, Timeout => $self->{timeout}, - KeepAlive => !!$self->{keep_alive} ) or die(qq/Could not connect to '$host:$port': $@\n/); binmode($self->{fh}) or die(qq/Could not binmode() socket: '$!'\n/); + if ( $self->{keep_alive} ) { + unless ( defined( $self->{fh}->setsockopt( SOL_SOCKET, SO_KEEPALIVE, 1 ) ) ) { + CORE::close($self->{fh}); + die(qq/Could not set SO_KEEPALIVE on socket: '$!'\n/); + } + } + $self->start_ssl($host) if $scheme eq 'https'; $self->{scheme} = $scheme; $self->{host} = $host; + $self->{peer} = $peer; $self->{port} = $port; $self->{pid} = $$; $self->{tid} = _get_tid(); @@ -1172,38 +1259,72 @@ sub read_header_lines { sub write_request { @_ == 2 || die(q/Usage: $handle->write_request(request)/ . "\n"); my($self, $request) = @_; - $self->write_request_header(@{$request}{qw/method uri headers/}); + $self->write_request_header(@{$request}{qw/method uri headers header_case/}); $self->write_body($request) if $request->{cb}; return; } -my %HeaderCase = ( - 'content-md5' => 'Content-MD5', - 'etag' => 'ETag', - 'te' => 'TE', - 'www-authenticate' => 'WWW-Authenticate', - 'x-xss-protection' => 'X-XSS-Protection', +# Standard request header names/case from HTTP/1.1 RFCs +my @rfc_request_headers = qw( + Accept Accept-Charset Accept-Encoding Accept-Language Authorization + Cache-Control Connection Content-Length Expect From Host + If-Match If-Modified-Since If-None-Match If-Range If-Unmodified-Since + Max-Forwards Pragma Proxy-Authorization Range Referer TE Trailer + Transfer-Encoding Upgrade User-Agent Via +); + +my @other_request_headers = qw( + Content-Encoding Content-MD5 Content-Type Cookie DNT Date Origin + X-XSS-Protection ); +my %HeaderCase = map { lc($_) => $_ } @rfc_request_headers, @other_request_headers; + # to avoid multiple small writes and hence nagle, you can pass the method line or anything else to # combine writes. sub write_header_lines { - (@_ == 2 || @_ == 3 && ref $_[1] eq 'HASH') || die(q/Usage: $handle->write_header_lines(headers[,prefix])/ . "\n"); - my($self, $headers, $prefix_data) = @_; + (@_ >= 2 && @_ <= 4 && ref $_[1] eq 'HASH') || die(q/Usage: $handle->write_header_lines(headers, [header_case, prefix])/ . "\n"); + my($self, $headers, $header_case, $prefix_data) = @_; + $header_case ||= {}; my $buf = (defined $prefix_data ? $prefix_data : ''); + + # Per RFC, control fields should be listed first + my %seen; + for my $k ( qw/host cache-control expect max-forwards pragma range te/ ) { + next unless exists $headers->{$k}; + $seen{$k}++; + my $field_name = $HeaderCase{$k}; + my $v = $headers->{$k}; + for (ref $v eq 'ARRAY' ? @$v : $v) { + $_ = '' unless defined $_; + $buf .= "$field_name: $_\x0D\x0A"; + } + } + + # Other headers sent in arbitrary order while (my ($k, $v) = each %$headers) { my $field_name = lc $k; + next if $seen{$field_name}; if (exists $HeaderCase{$field_name}) { $field_name = $HeaderCase{$field_name}; } else { + if (exists $header_case->{$field_name}) { + $field_name = $header_case->{$field_name}; + } + else { + $field_name =~ s/\b(\w)/\u$1/g; + } $field_name =~ /\A $Token+ \z/xo or die(q/Invalid HTTP header field name: / . $Printable->($field_name) . "\n"); - $field_name =~ s/\b(\w)/\u$1/g; $HeaderCase{lc $field_name} = $field_name; } for (ref $v eq 'ARRAY' ? @$v : $v) { + # unwrap a field value if pre-wrapped by user + s/\x0D?\x0A\s+/ /g; + die(qq/Invalid HTTP header field value ($field_name): / . $Printable->($_). "\n") + unless $_ eq '' || /\A $Field_Content \z/xo; $_ = '' unless defined $_; $buf .= "$field_name: $_\x0D\x0A"; } @@ -1358,10 +1479,10 @@ sub read_response_header { } sub write_request_header { - @_ == 4 || die(q/Usage: $handle->write_request_header(method, request_uri, headers)/ . "\n"); - my ($self, $method, $request_uri, $headers) = @_; + @_ == 5 || die(q/Usage: $handle->write_request_header(method, request_uri, headers, header_case)/ . "\n"); + my ($self, $method, $request_uri, $headers, $header_case) = @_; - return $self->write_header_lines($headers, "$method $request_uri HTTP/1.1\x0D\x0A"); + return $self->write_header_lines($headers, $header_case, "$method $request_uri HTTP/1.1\x0D\x0A"); } sub _do_timeout { @@ -1416,7 +1537,7 @@ sub _assert_ssl { } sub can_reuse { - my ($self,$scheme,$host,$port) = @_; + my ($self,$scheme,$host,$port,$peer) = @_; return 0 if $self->{pid} != $$ || $self->{tid} != _get_tid() @@ -1424,6 +1545,7 @@ sub can_reuse { || $scheme ne $self->{scheme} || $host ne $self->{host} || $port ne $self->{port} + || $peer ne $self->{peer} || eval { $self->can_read(0) } || $@ ; return 1; @@ -1434,11 +1556,16 @@ sub can_reuse { sub _find_CA_file { my $self = shift(); - if ( $self->{SSL_options}->{SSL_ca_file} ) { - unless ( -r $self->{SSL_options}->{SSL_ca_file} ) { - die qq/SSL_ca_file '$self->{SSL_options}->{SSL_ca_file}' not found or not readable\n/; + my $ca_file = + defined( $self->{SSL_options}->{SSL_ca_file} ) + ? $self->{SSL_options}->{SSL_ca_file} + : $ENV{SSL_CERT_FILE}; + + if ( defined $ca_file ) { + unless ( -r $ca_file ) { + die qq/SSL_ca_file '$ca_file' not found or not readable\n/; } - return $self->{SSL_options}->{SSL_ca_file}; + return $ca_file; } return Mozilla::CA::SSL_ca_file() @@ -1512,7 +1639,7 @@ HTTP::Tiny - A small, simple, correct HTTP/1.1 client =head1 VERSION -version 0.056 +version 0.058 =head1 SYNOPSIS @@ -1601,7 +1728,7 @@ C — List of domain suffixes that should not be proxied. Must be a c =item * -C — Request timeout in seconds (default is 60) +C — Request timeout in seconds (default is 60) If a socket open, read or write takes longer than the timeout, an exception is thrown. =item * @@ -1721,6 +1848,10 @@ C — A code reference that will be called if it exists to pro C — A code reference that will be called for each chunks of the response body received. +=item * + +C — Override host resolution and force all connections to go only to a specific peer address, regardless of the URL of the request. This will include any redirections! This options should be used with extreme caution (e.g. debugging or very special circumstances). + =back The C header is generated from the URL in accordance with RFC 2616. It @@ -1770,6 +1901,10 @@ C — The body of the response. If the response does not have any cont C — A hashref of header fields. All header field names will be normalized to be lower case. If a header is repeated, the value will be an arrayref; it will otherwise be a scalar string containing the value +=item * + +C If this field exists, it is an arrayref of response hash references from redirects in the same order that redirections occurred. If it does not exist, then no redirections occurred. + =back On an exception during the execution of the request, the C field will @@ -1802,6 +1937,22 @@ In scalar context, returns a boolean indicating if SSL is available. In list context, returns the boolean and a (possibly multi-line) string of errors indicating why SSL isn't available. +=head2 connected + + $host = $http->connected; + ($host, $port) = $http->connected; + +Indicates if a connection to a peer is being kept alive, per the C +option. + +In scalar context, returns the peer host and port, joined with a colon, or +C (if no peer is connected). +In list context, returns the peer host and port or an empty list (if no peer +is connected). + +B: This method cannot reliably be used to discover whether the remote +host has closed its end of the socket. + =for Pod::Coverage SSL_options agent cookie_jar @@ -1863,6 +2014,10 @@ attack|http://en.wikipedia.org/wiki/Man-in-the-middle_attack>. If you are concerned about security, you should enable this option. Certificate verification requires a file containing trusted CA certificates. + +If the environment variable C is present, HTTP::Tiny +will try to find a CA certificate file in that location. + If the L module is installed, HTTP::Tiny will use the CA file included with it as a source of trusted CA's. (This means you trust Mozilla, the author of Mozilla::CA, the CPAN mirror where you got Mozilla::CA, the @@ -2021,6 +2176,13 @@ Only 'chunked' C is supported. There is no support for a Request-URI of '*' for the 'OPTIONS' request. +=item * + +Headers mentioned in the RFCs and some other, well-known headers are +generated with their canonical case. Other headers are sent in the +case provided by the user. Except for control headers (which are sent first), +headers are sent in arbitrary order. + =back Despite the limitations listed above, HTTP::Tiny is considered @@ -2100,7 +2262,7 @@ David Golden =head1 CONTRIBUTORS -=for stopwords Alan Gardner Alessandro Ghedini Brad Gilbert Chris Nehren Weyl Claes Jakobsson Clinton Gormley Dean Pearce Edward Zborowski James Raspass Jeremy Mates Jess Robinson Lukas Eklund Martin J. Evans Martin-Louis Bright Mike Doherty Olaf Alders Olivier Mengué Petr Písař Sören Kornetzki Syohei YOSHIDA Tatsuhiko Miyagawa Tom Hukins Tony Cook +=for stopwords Alan Gardner Alessandro Ghedini A. Sinan Unur Brad Gilbert brian m. carlson Chris Nehren Weyl Claes Jakobsson Clinton Gormley David Golden Dean Pearce Edward Zborowski James Raspass Jeremy Mates Jess Robinson Lukas Eklund Martin J. Evans Martin-Louis Bright Mike Doherty Olaf Alders Olivier Mengué Petr Písař SkyMarshal Sören Kornetzki Syohei YOSHIDA Tatsuhiko Miyagawa Tom Hukins Tony Cook =over 4 @@ -2114,10 +2276,18 @@ Alessandro Ghedini =item * +A. Sinan Unur + +=item * + Brad Gilbert =item * +brian m. carlson + +=item * + Chris Nehren =item * @@ -2134,6 +2304,10 @@ Clinton Gormley =item * +David Golden + +=item * + Dean Pearce =item * @@ -2182,6 +2356,10 @@ Petr Písař =item * +SkyMarshal + +=item * + Sören Kornetzki =item * @@ -2204,7 +2382,7 @@ Tony Cook =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2015 by Christian Hansen. +This software is copyright (c) 2016 by Christian Hansen. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/cpan/HTTP-Tiny/t/001_api.t b/cpan/HTTP-Tiny/t/001_api.t index 879a225..3e6864e 100644 --- a/cpan/HTTP-Tiny/t/001_api.t +++ b/cpan/HTTP-Tiny/t/001_api.t @@ -12,6 +12,7 @@ my @accessors = qw( ); my @methods = qw( new get head put post delete post_form request mirror www_form_urlencode can_ssl + connected ); my %api; diff --git a/cpan/HTTP-Tiny/t/100_get.t b/cpan/HTTP-Tiny/t/100_get.t index 401fa7d..43cf52e 100644 --- a/cpan/HTTP-Tiny/t/100_get.t +++ b/cpan/HTTP-Tiny/t/100_get.t @@ -104,6 +104,9 @@ for my $file ( dir_list("corpus", qr/^get/ ) ) { else { $check_expected->( $response->{content}, "$label content" ); } + + ok ( ! exists $response->{redirects}, "$label redirects array doesn't exist") + or diag explain $response->{redirects}; } done_testing; diff --git a/cpan/HTTP-Tiny/t/110_mirror.t b/cpan/HTTP-Tiny/t/110_mirror.t index e31b747..1fb400f 100644 --- a/cpan/HTTP-Tiny/t/110_mirror.t +++ b/cpan/HTTP-Tiny/t/110_mirror.t @@ -51,6 +51,11 @@ for my $file ( dir_list("corpus", qr/^mirror/ ) ) { open my $fh, ">", $tempfile; close $fh; utime $mtime, $mtime, $tempfile; + if ($^O eq 'MSWin32') { + # Deal with stat and daylight savings issues on Windows + # by reading back mtime + $timestamp{$url_basename} = (stat $tempfile)[9]; + } } # setup mocking and test diff --git a/cpan/HTTP-Tiny/t/130_redirect.t b/cpan/HTTP-Tiny/t/130_redirect.t index 5de1d17..0f8f98d 100644 --- a/cpan/HTTP-Tiny/t/130_redirect.t +++ b/cpan/HTTP-Tiny/t/130_redirect.t @@ -17,6 +17,7 @@ for my $file ( dir_list("corpus", qr/^redirect/ ) ) { my $data = do { local (@ARGV,$/) = $file; <> }; my ($params, @case_pairs) = split /--+\n/, $data; my $case = parse_case($params); + my $number_of_requests = @case_pairs / 2; my $url = $case->{url}[0]; my $method = $case->{method}[0] || 'GET'; @@ -49,9 +50,8 @@ for my $file ( dir_list("corpus", qr/^redirect/ ) ) { my $http = HTTP::Tiny->new(keep_alive => 0, %new_args); my $response = $http->request(@$call_args); - - my $calls = 0 - + (defined($new_args{max_redirect}) ? $new_args{max_redirect} : 5); + my $max_redirects = defined($new_args{max_redirect}) ? $new_args{max_redirect} : 5; + my $calls = 0 + $max_redirects; for my $i ( 0 .. $calls ) { last unless @socket_pairs; @@ -66,6 +66,12 @@ for my $file ( dir_list("corpus", qr/^redirect/ ) ) { is ( $response->{content}, $exp_content, "$label content" ); + my $number_of_redirects = + $max_redirects < $number_of_requests ? $max_redirects : $number_of_requests - 1; + is ( @{ $response->{redirects} || [] }, $number_of_redirects, + "$label redirects array size" + ) or diag explain $response->{redirects}; + if ( $case->{expected_url} ) { is ( $response->{url}, $case->{expected_url}[0], "$label response URL" ); } diff --git a/cpan/HTTP-Tiny/t/Util.pm b/cpan/HTTP-Tiny/t/Util.pm index 448c031..f75ca55 100644 --- a/cpan/HTTP-Tiny/t/Util.pm +++ b/cpan/HTTP-Tiny/t/Util.pm @@ -151,9 +151,10 @@ sub sort_headers { *HTTP::Tiny::Handle::can_read = sub {1}; *HTTP::Tiny::Handle::can_write = sub {1}; *HTTP::Tiny::Handle::connect = sub { - my ($self, $scheme, $host, $port) = @_; + my ($self, $scheme, $host, $port, $peer) = @_; $self->{host} = $monkey_host = $host; $self->{port} = $monkey_port = $port; + $self->{peer} = $peer; $self->{scheme} = $scheme; $self->{fh} = shift @req_fh; $self->{pid} = $$; diff --git a/cpan/JSON-PP/bin/json_pp b/cpan/JSON-PP/bin/json_pp index df9d243..3362dec 100644 --- a/cpan/JSON-PP/bin/json_pp +++ b/cpan/JSON-PP/bin/json_pp @@ -32,7 +32,7 @@ if ( $version ) { $json_opt = '' if $json_opt eq '-'; -my @json_opt = grep { $allow_json_opt{ $_ } or die "'$_' is invalid json opttion" } split/,/, $json_opt; +my @json_opt = grep { $allow_json_opt{ $_ } or die "'$_' is not a valid json option" } split/,/, $json_opt; my %F = ( 'json' => sub { diff --git a/cpan/JSON-PP/lib/JSON/PP.pm b/cpan/JSON-PP/lib/JSON/PP.pm index 7a011a4..28ea2d7 100644 --- a/cpan/JSON-PP/lib/JSON/PP.pm +++ b/cpan/JSON-PP/lib/JSON/PP.pm @@ -11,7 +11,7 @@ use Carp (); use B (); #use Devel::Peek; -$JSON::PP::VERSION = '2.27300'; +$JSON::PP::VERSION = '2.27400'; @JSON::PP::EXPORT = qw(encode_json decode_json from_json to_json); @@ -52,7 +52,7 @@ BEGIN { allow_barekey escape_slash as_nonblessed ); - # Perl version check, Unicode handling is enable? + # Perl version check, Unicode handling is enabled? # Helper module sets @JSON::PP::_properties. if ($] < 5.008 ) { my $helper = $] >= 5.006 ? 'JSON::PP::Compat5006' : 'JSON::PP::Compat5005'; @@ -608,7 +608,7 @@ BEGIN { my $text; # json data my $at; # offset - my $ch; # 1chracter + my $ch; # first character my $len; # text length (changed according to UTF8 or NON UTF8) # INTERNAL my $depth; # nest counter @@ -617,7 +617,7 @@ BEGIN { my $utf8_len; # utf8 byte length # FLAGS my $utf8; # must be utf8 - my $max_depth; # max nest nubmer of objects and arrays + my $max_depth; # max nest number of objects and arrays my $max_size; my $relaxed; my $cb_object; @@ -1045,8 +1045,9 @@ BEGIN { sub number { my $n = ''; my $v; + my $is_dec; - # According to RFC4627, hex or oct digts are invalid. + # According to RFC4627, hex or oct digits are invalid. if($ch eq '0'){ my $peek = substr($text,$at,1); my $hex = $peek =~ /[xX]/; # 0 or 1 @@ -1087,6 +1088,7 @@ BEGIN { if(defined $ch and $ch eq '.'){ $n .= '.'; + $is_dec = 1; next_chr; if (!defined $ch or $ch !~ /\d/) { @@ -1142,7 +1144,7 @@ BEGIN { return Math::BigFloat->new($v); } - return 0+$v; + return $is_dec ? $v/1.0 : 0+$v; } @@ -1316,7 +1318,7 @@ BEGIN { $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new; if ( $_[0]->{_incr_parser}->{incr_parsing} ) { - Carp::croak("incr_text can not be called when the incremental parser already started parsing"); + Carp::croak("incr_text cannot be called when the incremental parser already started parsing"); } $_[0]->{_incr_parser}->{incr_text}; } @@ -1385,7 +1387,7 @@ BEGIN { } -# shamely copied and modified from JSON::XS code. +# shamelessly copied and modified from JSON::XS code. $JSON::PP::true = do { bless \(my $dummy = 1), "JSON::PP::Boolean" }; $JSON::PP::false = do { bless \(my $dummy = 0), "JSON::PP::Boolean" }; @@ -1566,7 +1568,7 @@ sub _incr_parse { sub incr_text { if ( $_[0]->{incr_parsing} ) { - Carp::croak("incr_text can not be called when the incremental parser already started parsing"); + Carp::croak("incr_text cannot be called when the incremental parser already started parsing"); } $_[0]->{incr_text}; } @@ -1626,13 +1628,13 @@ JSON::PP - JSON::XS compatible pure-Perl module. =head1 VERSION - 2.27300 + 2.27400 L 2.27 (~2.30) compatible. =head1 NOTE -JSON::PP had been inculded in JSON distribution (CPAN module). +JSON::PP had been included in JSON distribution (CPAN module). It was a perl core module in Perl 5.14. =head1 DESCRIPTION @@ -1671,7 +1673,7 @@ MAPPING section below to learn about those. There is no guessing, no generating of illegal JSON texts by default, and only JSON is accepted as input by default (the latter is a security feature). -But when some options are set, loose chcking features are available. +But when some options are set, loose checking features are available. =back @@ -1729,11 +1731,11 @@ Perl. =head1 HOW DO I DECODE A DATA FROM OUTER AND ENCODE TO OUTER -This section supposes that your perl vresion is 5.8 or later. +This section supposes that your perl version is 5.8 or later. If you know a JSON text from an outer world - a network, a file content, and so on, is encoded in UTF-8, you should use C or C module object -with C enable. And the decoded result will contain UNICODE characters. +with C enabled. And the decoded result will contain UNICODE characters. # from network my $json = JSON::PP->new->utf8; @@ -1760,7 +1762,7 @@ If an outer data is not encoded in UTF-8, firstly you should C it. # $unicode_json_text = <$fh>; In this case, C<$unicode_json_text> is of course UNICODE string. -So you B use C nor C module object with C enable. +So you B use C nor C module object with C enabled. Instead of them, you use C module object with C disable. $perl_scalar = $json->utf8(0)->decode( $unicode_json_text ); @@ -1774,7 +1776,7 @@ And now, you want to convert your C<$perl_scalar> into JSON data and send it to an outer world - a network or a file content, and so on. Your data usually contains UNICODE strings and you want the converted data to be encoded -in UTF-8, you should use C or C module object with C enable. +in UTF-8, you should use C or C module object with C enabled. print encode_json( $perl_scalar ); # to a network? file? or display? # or @@ -1783,7 +1785,7 @@ in UTF-8, you should use C or C module object with C en If C<$perl_scalar> does not contain UNICODE but C<$encoding>-encoded strings for some reason, then its characters are regarded as B for perl (because it does not concern with your $encoding). -You B use C nor C module object with C enable. +You B use C nor C module object with C enabled. Instead of them, you use C module object with C disable. Note that the resulted text is a UNICODE string but no problem to print it. @@ -1811,7 +1813,7 @@ Basically, check to L or L. $json = JSON::PP->new -Rturns a new JSON::PP object that can be used to de/encode JSON +Returns a new JSON::PP object that can be used to de/encode JSON strings. All boolean flags described below are by default I. @@ -2019,7 +2021,7 @@ as key-value pairs have no inherent ordering in Perl. This setting has no effect when decoding JSON texts. -If you want your own sorting routine, you can give a code referece +If you want your own sorting routine, you can give a code reference or a subroutine name to C. See to C. =head2 allow_nonref @@ -2217,10 +2219,10 @@ given character in a string. If no argument is given, the highest possible setting will be used, which is rarely useful. -See L for more info on why this is useful. +See L for more info on why this is useful. When a large value (100 or more) was set and it de/encodes a deep nested object/text, -it may raise a warning 'Deep recursion on subroutin' at the perl runtime phase. +it may raise a warning 'Deep recursion on subroutine' at the perl runtime phase. =head2 max_size @@ -2237,7 +2239,7 @@ effect on C (yet). If no argument is given, the limit check will be deactivated (same as when C<0> is specified). -See L for more info on why this is useful. +See L for more info on why this is useful. =head2 encode @@ -2288,7 +2290,7 @@ to see if a full JSON object is available, but is much more efficient This module will only attempt to parse the JSON text once it is sure it has enough text to get a decisive result, using a very simple but truly incremental parser. This means that it sometimes won't stop as -early as the full parser, for example, it doesn't detect parenthese +early as the full parser, for example, it doesn't detect parentheses mismatches. The only thing it guarantees is that it starts decoding as soon as a syntactically valid JSON text has been seen. This means you need to set resource limits (e.g. C) to ensure the parser will stop @@ -2319,7 +2321,7 @@ If the method is called in scalar context, then it will try to extract exactly I JSON object. If that is successful, it will return this object, otherwise it will return C. If there is a parse error, this method will croak just as C would do (one can then use -C to skip the errornous part). This is the most common way of +C to skip the erroneous part). This is the most common way of using the method. And finally, in list context, it will try to extract as many objects @@ -2375,7 +2377,7 @@ unchanged, to skip the text parsed so far and to reset the parse state. This completely resets the incremental parser, that is, after this call, it will be as if the parser had never parsed anything. -This is useful if you want ot repeatedly parse JSON objects and want to +This is useful if you want to repeatedly parse JSON objects and want to ignore any trailing data, which means you have to reset the parser after each successful decode. @@ -2420,29 +2422,29 @@ If C<$enable> is true (or missing), then C will convert the big integer Perl cannot handle as integer into a L object and convert a floating number (any) into a L. -On the contary, C converts C objects and C -objects into JSON numbers with C enable. +On the contrary, C converts C objects and C +objects into JSON numbers with C enabled. $json->allow_nonref->allow_blessed->allow_bignum; $bigfloat = $json->decode('2.000000000000000000000000001'); print $json->encode($bigfloat); # => 2.000000000000000000000000001 -See to L aboout the normal conversion of JSON number. +See to L about the normal conversion of JSON number. =head2 loose $json = $json->loose([$enable]) The unescaped [\x00-\x1f\x22\x2f\x5c] strings are invalid in JSON strings -and the module doesn't allow to C to these (except for \x2f). +and the module doesn't allow you to C to these (except for \x2f). If C<$enable> is true (or missing), then C will accept these unescaped strings. $json->loose->decode(qq|["abc def"]|); -See L. +See L. =head2 escape_slash @@ -2554,7 +2556,7 @@ it as an integer value. If that fails, it will try to represent it as a numeric (floating point) value if that is possible without loss of precision. Otherwise it will preserve the number as a string value (in which case you lose roundtripping ability, as the JSON number will be -re-encoded toa JSON string). +re-encoded to a JSON string). Numbers containing a fractional or exponential part will always be represented as numeric (floating point) values, possibly at a loss of @@ -2564,9 +2566,9 @@ the JSON number will still be re-encoded as a JSON number). Note that precision is not accuracy - binary floating point values cannot represent most decimal fractions exactly, and when converting from and to floating point, C only guarantees precision up to but not including -the leats significant bit. +the least significant bit. -When C is enable, the big integers +When C is enabled, the big integers and the numeric can be optionally converted into L and L objects. @@ -2574,7 +2576,7 @@ L objects. These JSON atoms become C and C, respectively. They are overloaded to act almost exactly like the numbers -C<1> and C<0>. You can check wether a scalar is a JSON boolean by using +C<1> and C<0>. You can check whether a scalar is a JSON boolean by using the C function. print JSON::PP::true . "\n"; @@ -2592,7 +2594,7 @@ C will install these missing overloading features to the backend modules. A JSON null atom becomes C in Perl. -C returns C. +C returns C. =back @@ -2678,9 +2680,9 @@ You can force the type to be a number by numifying it: my $x = "3"; # some variable containing a string $x += 0; # numify it, ensuring it will be dumped as a number - $x *= 1; # same thing, the choise is yours. + $x *= 1; # same thing, the choice is yours. -You can not currently force the type in other, less obscure, ways. +You cannot currently force the type in other, less obscure, ways. Note that numerical precision has the same meaning as under Perl (so binary to decimal conversion follows the same rules as in Perl, which @@ -2691,7 +2693,7 @@ error to pass those in. =item Big Number -When C is enable, +When C is enabled, C converts C objects and C objects into JSON numbers. @@ -2710,7 +2712,7 @@ Perl can handle Unicode and the JSON::PP de/encode methods also work properly. $json->allow_nonref->encode(chr hex 3042); $json->allow_nonref->encode(chr hex 12345); -Reuturns C<"\u3042"> and C<"\ud808\udf45"> respectively. +Returns C<"\u3042"> and C<"\ud808\udf45"> respectively. $json->allow_nonref->decode('"\u3042"'); $json->allow_nonref->decode('"\ud808\udf45"'); @@ -2727,7 +2729,7 @@ Perl can handle Unicode and the JSON::PP de/encode methods also work. =head2 Perl 5.005 -Perl 5.005 is a byte sementics world -- all strings are sequences of bytes. +Perl 5.005 is a byte semantics world -- all strings are sequences of bytes. That means the unicode handling is not available. In encoding, @@ -2746,7 +2748,7 @@ In decoding, $json->decode('"\u00e3\u0081\u0082"'); The returned is a byte sequence C<0xE3 0x81 0x82> for UTF-8 encoded -japanese character (C). +Japanese character (C). And if it is represented in Unicode code point, C. Next, @@ -2787,7 +2789,7 @@ Makamaka Hannyaharamitu, Emakamaka[at]cpan.orgE =head1 COPYRIGHT AND LICENSE -Copyright 2007-2014 by Makamaka Hannyaharamitu +Copyright 2007-2016 by Makamaka Hannyaharamitu This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/cpan/JSON-PP/t/018_json_checker.t b/cpan/JSON-PP/t/018_json_checker.t index c157813..ff1f174 100644 --- a/cpan/JSON-PP/t/018_json_checker.t +++ b/cpan/JSON-PP/t/018_json_checker.t @@ -1,6 +1,6 @@ #! perl -# use the testsuite from http://www.json.org/JSON::PP_checker/ +# use the testsuite from http://www.json.org/JSON_checker/ # except for fail18.json, as we do not support a depth of 20 (but 16 and 32). # copied over from JSON::PP::XS and modified to use JSON::PP diff --git a/cpan/JSON-PP/t/021_evans_bugrep.t b/cpan/JSON-PP/t/021_evans_bugrep.t index e7d6dc5..93da0f0 100644 --- a/cpan/JSON-PP/t/021_evans_bugrep.t +++ b/cpan/JSON-PP/t/021_evans_bugrep.t @@ -32,7 +32,7 @@ eval { $j->incr_text; }; -like( $@, qr/incr_text can not be called when the incremental parser already started parsing/ ); +like( $@, qr/incr_text cannot be called when the incremental parser already started parsing/ ); $object = $j->incr_parse($parts[1]); diff --git a/cpan/JSON-PP/t/108_decode.t b/cpan/JSON-PP/t/108_decode.t index 71c2ff5..ae645e9 100644 --- a/cpan/JSON-PP/t/108_decode.t +++ b/cpan/JSON-PP/t/108_decode.t @@ -35,7 +35,7 @@ is($json->decode(q|"\u3042"|), $str); my $utf8 = $json->decode(q|"\ud808\udf45"|); # chr 12345 -utf8::encode($utf8); # UTf-8 flaged off +utf8::encode($utf8); # UTF-8 flagged off is($utf8, "\xf0\x92\x8d\x85"); diff --git a/cpan/Locale-Codes/lib/Locale/Codes.pm b/cpan/Locale-Codes/lib/Locale/Codes.pm index 8f74374..7996a5c 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes.pm @@ -31,7 +31,7 @@ our($VERSION,%Data,%Retired); # $Retired{ TYPE }{ CODESET }{ code }{ CODE } = NAME # { name }{ NAME } = [CODE,NAME] (the key is lowercase) -$VERSION='3.38'; +$VERSION='3.39'; #======================================================================= # diff --git a/cpan/Locale-Codes/lib/Locale/Codes/Changes.pod b/cpan/Locale-Codes/lib/Locale/Codes/Changes.pod index c47a00b..b777333 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/Changes.pod +++ b/cpan/Locale-Codes/lib/Locale/Codes/Changes.pod @@ -26,7 +26,24 @@ codes, I will add them to the module and release a new version. =head1 VERSION 3.40 (planned 2016-09-01; sbeck) -=head1 VERSION 3.39 (planned 2016-06-01; sbeck) +=head1 VERSION 3.39 (2016-05-31; sbeck) + +No new codes (for the existing codesets). + +=over 4 + +=item B + +The UN codes have been added back in as their own list of codes. +Jarkko Hietaniemi + +=item B + +The GENC codes have been added. These are the new US Government codes +that replace the FIPS-10 codes. They are based on, but not identical to +the ISO 3166 codes. + +=back =head1 VERSION 3.38 (2016-03-02; sbeck) diff --git a/cpan/Locale-Codes/lib/Locale/Codes/Constants.pm b/cpan/Locale-Codes/lib/Locale/Codes/Constants.pm index 89b83cd..5c9b031 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/Constants.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes/Constants.pm @@ -17,12 +17,17 @@ require Exporter; our($VERSION,@ISA,@EXPORT); our(%ALL_CODESETS); -$VERSION='3.38'; +$VERSION='3.39'; @ISA = qw(Exporter); @EXPORT = qw(LOCALE_CODE_ALPHA_2 LOCALE_CODE_ALPHA_3 LOCALE_CODE_NUMERIC LOCALE_CODE_DOM + LOCALE_CODE_UN_NUMERIC + LOCALE_CODE_UN_ALPHA_3 + LOCALE_CODE_GENC_ALPHA_2 + LOCALE_CODE_GENC_ALPHA_3 + LOCALE_CODE_GENC_NUMERIC LOCALE_LANG_ALPHA_2 LOCALE_LANG_ALPHA_3 @@ -47,17 +52,27 @@ $VERSION='3.38'; # Constants #----------------------------------------------------------------------- -use constant LOCALE_CODE_ALPHA_2 => 'alpha-2'; -use constant LOCALE_CODE_ALPHA_3 => 'alpha-3'; -use constant LOCALE_CODE_NUMERIC => 'numeric'; -use constant LOCALE_CODE_DOM => 'dom'; +use constant LOCALE_CODE_ALPHA_2 => 'alpha-2'; +use constant LOCALE_CODE_ALPHA_3 => 'alpha-3'; +use constant LOCALE_CODE_NUMERIC => 'numeric'; +use constant LOCALE_CODE_DOM => 'dom'; +use constant LOCALE_CODE_UN_ALPHA_3 => 'un-alpha-3'; +use constant LOCALE_CODE_UN_NUMERIC => 'un-numeric'; +use constant LOCALE_CODE_GENC_ALPHA_2 => 'genc-alpha-2'; +use constant LOCALE_CODE_GENC_ALPHA_3 => 'genc-alpha-3'; +use constant LOCALE_CODE_GENC_NUMERIC => 'genc-numeric'; $ALL_CODESETS{'country'} = { 'default' => 'alpha-2', - 'codesets' => { 'alpha-2' => ['lc'], - 'alpha-3' => ['lc'], - 'numeric' => ['numeric',3], - 'dom' => ['lc'], + 'codesets' => { 'alpha-2' => ['lc'], + 'alpha-3' => ['lc'], + 'numeric' => ['numeric',3], + 'dom' => ['lc'], + 'un-alpha-3' => ['uc'], + 'un-numeric' => ['numeric',3], + 'genc-alpha-2' => ['uc'], + 'genc-alpha-3' => ['uc'], + 'genc-numeric' => ['numeric',3], } }; diff --git a/cpan/Locale-Codes/lib/Locale/Codes/Country.pm b/cpan/Locale-Codes/lib/Locale/Codes/Country.pm index 9455d86..dea7b9c 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/Country.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes/Country.pm @@ -22,7 +22,7 @@ use Locale::Codes::Country_Retired; our($VERSION,@ISA,@EXPORT,@EXPORT_OK); -$VERSION='3.38'; +$VERSION='3.39'; @ISA = qw(Exporter); @EXPORT = qw(code2country country2code diff --git a/cpan/Locale-Codes/lib/Locale/Codes/Country.pod b/cpan/Locale-Codes/lib/Locale/Codes/Country.pod index 56f78a9..e4aee72 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/Country.pod +++ b/cpan/Locale-Codes/lib/Locale/Codes/Country.pod @@ -70,6 +70,23 @@ The IANA is responsible for delegating management of the top level country domains. The country domains are the two-letter (lowercase) codes from ISO 3166 with a few other additions. +=item B + +=item B + +The UN maintains a list of codes that is similar, but not identical, to the +standard ISO 3166 lists. They maintain a 3-letter code (similar to alpha-3) +and a numeric code (similar to numeric). + +=item B + +=item B + +=item B + +The GENC codes are the US Government codes that replace the FIPS-11 codes. +They are based on, but not identical to the standard ISO 3166 lists. + =back NOTE: As of version 3.27, the FIPS code set is no longer supported. See the @@ -143,12 +160,15 @@ Official source of the top-level domain names. =item L -The source of the official ISO 3166-1 three-letter codes and -three-digit codes. +The source of the UN codes. + +Previously, this table was treated as a source of the ISO 3166 data, +but I found that the table was incomplete, so I stopped using it. +Later, it was added back in as it's own list of codes. + +=item L -For some reason, this table is incomplete! Several countries are -missing from it, and I cannot find them anywhere on the UN site. I -no longer use this as a source of data. +The source of the GENC codes. =item L diff --git a/cpan/Locale-Codes/lib/Locale/Codes/Country_Codes.pm b/cpan/Locale-Codes/lib/Locale/Codes/Country_Codes.pm index 6b515f1..37bc8c4 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/Country_Codes.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes/Country_Codes.pm @@ -3,7 +3,7 @@ Locale::Codes::Country_Codes; # This file was automatically generated. Any changes to this file will # be lost the next time 'harvest_data' is run. -# Generated on: Wed Mar 2 08:57:53 EST 2016 +# Generated on: Wed May 25 11:27:17 EDT 2016 use strict; require 5.006; @@ -11,9 +11,9 @@ use warnings; use utf8; our($VERSION); -$VERSION='3.38'; +$VERSION='3.39'; -$Locale::Codes::Data{'country'}{'id'} = '0250'; +$Locale::Codes::Data{'country'}{'id'} = '0283'; $Locale::Codes::Data{'country'}{'id2names'} = { q(0001) => [ @@ -105,6 +105,7 @@ $Locale::Codes::Data{'country'}{'id2names'} = { ], q(0028) => [ q(Bonaire, Sint Eustatius and Saba), + q(Bonaire, Sint Eustatius, and Saba), ], q(0029) => [ q(Bosnia and Herzegovina), @@ -456,6 +457,7 @@ $Locale::Codes::Data{'country'}{'id2names'} = { q(The Democratic People's Republic of Korea), q(Democratic People's Republic of Korea), q(North Korea), + q(Korea, North), ], q(0119) => [ q(Korea, The Republic of), @@ -465,6 +467,7 @@ $Locale::Codes::Data{'country'}{'id2names'} = { q(The Republic of Korea), q(Republic of Korea), q(South Korea), + q(Korea, South), ], q(0120) => [ q(Kuwait), @@ -477,6 +480,7 @@ $Locale::Codes::Data{'country'}{'id2names'} = { q(The Lao People's Democratic Republic), q(Lao People's Democratic Republic, The), q(Lao People's Democratic Republic (The)), + q(Laos), ], q(0123) => [ q(Latvia), @@ -573,6 +577,7 @@ $Locale::Codes::Data{'country'}{'id2names'} = { q(Moldova (Republic of)), q(The Republic of Moldova), q(Republic of Moldova), + q(Moldova), ], q(0147) => [ q(Monaco), @@ -706,6 +711,7 @@ $Locale::Codes::Data{'country'}{'id2names'} = { q(The Russian Federation), q(Russian Federation, The), q(Russian Federation (The)), + q(Russia), ], q(0184) => [ q(Rwanda), @@ -717,6 +723,7 @@ $Locale::Codes::Data{'country'}{'id2names'} = { q(0186) => [ q(Saint Helena, Ascension and Tristan da Cunha), q(Saint Helena), + q(Saint Helena, Ascension, and Tristan Da Cunha), ], q(0187) => [ q(Saint Kitts and Nevis), @@ -765,6 +772,7 @@ $Locale::Codes::Data{'country'}{'id2names'} = { ], q(0201) => [ q(Sint Maarten (Dutch part)), + q(Sint Maarten), ], q(0202) => [ q(Slovakia), @@ -787,6 +795,7 @@ $Locale::Codes::Data{'country'}{'id2names'} = { q(0207) => [ q(South Georgia and the South Sandwich Islands), q(South Georgia and the Islands), + q(South Georgia and South Sandwich Islands), ], q(0208) => [ q(South Sudan), @@ -838,6 +847,7 @@ $Locale::Codes::Data{'country'}{'id2names'} = { q(Tanzania, United Republic of), q(Tanzania (United Republic of)), q(United Republic of Tanzania), + q(Tanzania), ], q(0221) => [ q(Thailand), @@ -986,6 +996,109 @@ $Locale::Codes::Data{'country'}{'id2names'} = { q(Republic of Zimbabwe, The), q(Republic of Zimbabwe (The)), ], + q(0250) => [ + q(Channel Islands), + ], + q(0251) => [ + q(Sark), + ], + q(0252) => [ + q(Akrotiri), + ], + q(0253) => [ + q(Ashmore and Cartier Islands), + ], + q(0254) => [ + q(Baker Island), + ], + q(0255) => [ + q(Bassas Da India), + ], + q(0256) => [ + q(Clipperton Island), + ], + q(0257) => [ + q(Coral Sea Islands), + ], + q(0258) => [ + q(Dhekelia), + ], + q(0259) => [ + q(Diego Garcia), + ], + q(0260) => [ + q(Entity 1), + q(Entity 2), + q(Entity 3), + q(Entity 4), + q(Entity 5), + ], + q(0261) => [ + q(Entity 6), + ], + q(0262) => [ + q(Europa Island), + ], + q(0263) => [ + q(Gaza Strip), + ], + q(0264) => [ + q(Glorioso Islands), + ], + q(0265) => [ + q(Guantanamo Bay Naval Base), + ], + q(0266) => [ + q(Howland Island), + ], + q(0267) => [ + q(Jan Mayen), + ], + q(0268) => [ + q(Jarvis Island), + ], + q(0269) => [ + q(Johnston Atoll), + ], + q(0270) => [ + q(Juan de Nova Island), + ], + q(0271) => [ + q(Kingman Reef), + ], + q(0272) => [ + q(Kosovo), + ], + q(0273) => [ + q(Midway Islands), + ], + q(0274) => [ + q(Navassa Island), + ], + q(0275) => [ + q(Palmyra Atoll), + ], + q(0276) => [ + q(Paracel Islands), + ], + q(0277) => [ + q(Spratly Islands), + ], + q(0278) => [ + q(Svalbard), + ], + q(0279) => [ + q(Tromelin Island), + ], + q(0280) => [ + q(Unknown), + ], + q(0281) => [ + q(Wake Island), + ], + q(0282) => [ + q(West Bank), + ], }; $Locale::Codes::Data{'country'}{'alias2id'} = { @@ -993,6 +1106,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0001), q(0), ], + q(akrotiri) => [ + q(0252), + q(0), + ], q(aland islands) => [ q(0002), q(0), @@ -1041,6 +1158,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0013), q(0), ], + q(ashmore and cartier islands) => [ + q(0253), + q(0), + ], q(australia) => [ q(0014), q(0), @@ -1069,6 +1190,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0018), q(0), ], + q(baker island) => [ + q(0254), + q(0), + ], q(bangladesh) => [ q(0019), q(0), @@ -1077,6 +1202,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0020), q(0), ], + q(bassas da india) => [ + q(0255), + q(0), + ], q(belarus) => [ q(0021), q(0), @@ -1117,6 +1246,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0028), q(0), ], + q(bonaire, sint eustatius, and saba) => [ + q(0028), + q(1), + ], q(bosnia and herzegovina) => [ q(0029), q(0), @@ -1217,6 +1350,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0044), q(0), ], + q(channel islands) => [ + q(0250), + q(0), + ], q(chile) => [ q(0045), q(0), @@ -1237,6 +1374,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0047), q(0), ], + q(clipperton island) => [ + q(0256), + q(0), + ], q(cocos (keeling) islands) => [ q(0048), q(0), @@ -1329,6 +1470,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0053), q(2), ], + q(coral sea islands) => [ + q(0257), + q(0), + ], q(costa rica) => [ q(0054), q(0), @@ -1381,6 +1526,14 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0061), q(0), ], + q(dhekelia) => [ + q(0258), + q(0), + ], + q(diego garcia) => [ + q(0259), + q(0), + ], q(djibouti) => [ q(0062), q(0), @@ -1417,6 +1570,30 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0067), q(0), ], + q(entity 1) => [ + q(0260), + q(0), + ], + q(entity 2) => [ + q(0260), + q(1), + ], + q(entity 3) => [ + q(0260), + q(2), + ], + q(entity 4) => [ + q(0260), + q(3), + ], + q(entity 5) => [ + q(0260), + q(4), + ], + q(entity 6) => [ + q(0261), + q(0), + ], q(equatorial guinea) => [ q(0068), q(0), @@ -1433,6 +1610,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0071), q(0), ], + q(europa island) => [ + q(0262), + q(0), + ], q(faeroe islands) => [ q(0073), q(4), @@ -1521,6 +1702,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0081), q(2), ], + q(gaza strip) => [ + q(0263), + q(0), + ], q(georgia) => [ q(0082), q(0), @@ -1537,6 +1722,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0085), q(0), ], + q(glorioso islands) => [ + q(0264), + q(0), + ], q(great britain) => [ q(0235), q(4), @@ -1561,6 +1750,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0090), q(0), ], + q(guantanamo bay naval base) => [ + q(0265), + q(0), + ], q(guatemala) => [ q(0091), q(0), @@ -1629,6 +1822,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0100), q(3), ], + q(howland island) => [ + q(0266), + q(0), + ], q(hungary) => [ q(0101), q(0), @@ -1693,18 +1890,34 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0111), q(0), ], + q(jan mayen) => [ + q(0267), + q(0), + ], q(japan) => [ q(0112), q(0), ], + q(jarvis island) => [ + q(0268), + q(0), + ], q(jersey) => [ q(0113), q(0), ], + q(johnston atoll) => [ + q(0269), + q(0), + ], q(jordan) => [ q(0114), q(0), ], + q(juan de nova island) => [ + q(0270), + q(0), + ], q(kazakhstan) => [ q(0115), q(0), @@ -1721,6 +1934,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0116), q(0), ], + q(kingman reef) => [ + q(0271), + q(0), + ], q(kiribati) => [ q(0117), q(0), @@ -1745,10 +1962,18 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0118), q(2), ], + q(korea, north) => [ + q(0118), + q(7), + ], q(korea, republic of) => [ q(0119), q(2), ], + q(korea, south) => [ + q(0119), + q(7), + ], q(korea, the democratic people's republic of) => [ q(0118), q(0), @@ -1757,6 +1982,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0119), q(0), ], + q(kosovo) => [ + q(0272), + q(0), + ], q(kuwait) => [ q(0120), q(0), @@ -1777,6 +2006,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0122), q(2), ], + q(laos) => [ + q(0122), + q(4), + ], q(latvia) => [ q(0123), q(0), @@ -1921,6 +2154,14 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0145), q(4), ], + q(midway islands) => [ + q(0273), + q(0), + ], + q(moldova) => [ + q(0146), + q(6), + ], q(moldova (republic of)) => [ q(0146), q(3), @@ -1973,6 +2214,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0155), q(0), ], + q(navassa island) => [ + q(0274), + q(0), + ], q(nepal) => [ q(0156), q(0), @@ -2065,6 +2310,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0170), q(0), ], + q(palmyra atoll) => [ + q(0275), + q(0), + ], q(panama) => [ q(0171), q(0), @@ -2073,6 +2322,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0172), q(0), ], + q(paracel islands) => [ + q(0276), + q(0), + ], q(paraguay) => [ q(0173), q(0), @@ -2173,6 +2426,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0182), q(0), ], + q(russia) => [ + q(0183), + q(4), + ], q(russian federation) => [ q(0183), q(0), @@ -2201,6 +2458,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0186), q(0), ], + q(saint helena, ascension, and tristan da cunha) => [ + q(0186), + q(2), + ], q(saint kitts and nevis) => [ q(0187), q(0), @@ -2249,6 +2510,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0194), q(0), ], + q(sark) => [ + q(0251), + q(0), + ], q(saudi arabia) => [ q(0195), q(0), @@ -2273,6 +2538,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0200), q(0), ], + q(sint maarten) => [ + q(0201), + q(1), + ], q(sint maarten (dutch part)) => [ q(0201), q(0), @@ -2305,6 +2574,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0206), q(0), ], + q(south georgia and south sandwich islands) => [ + q(0207), + q(2), + ], q(south georgia and the islands) => [ q(0207), q(1), @@ -2325,6 +2598,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0209), q(0), ], + q(spratly islands) => [ + q(0277), + q(0), + ], q(sri lanka) => [ q(0210), q(0), @@ -2349,6 +2626,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0212), q(0), ], + q(svalbard) => [ + q(0278), + q(0), + ], q(svalbard and jan mayen) => [ q(0213), q(0), @@ -2401,6 +2682,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0219), q(0), ], + q(tanzania) => [ + q(0220), + q(3), + ], q(tanzania (united republic of)) => [ q(0220), q(1), @@ -2645,6 +2930,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0226), q(0), ], + q(tromelin island) => [ + q(0279), + q(0), + ], q(tunisia) => [ q(0227), q(0), @@ -2765,6 +3054,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0237), q(6), ], + q(unknown) => [ + q(0280), + q(0), + ], q(uruguay) => [ q(0238), q(0), @@ -2841,6 +3134,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0244), q(3), ], + q(wake island) => [ + q(0281), + q(0), + ], q(wallis and futuna) => [ q(0245), q(0), @@ -2849,6 +3146,10 @@ $Locale::Codes::Data{'country'}{'alias2id'} = { q(0245), q(1), ], + q(west bank) => [ + q(0282), + q(0), + ], q(western sahara) => [ q(0246), q(0), @@ -5874,168 +6175,5314 @@ $Locale::Codes::Data{'country'}{'code2id'} = { q(0), ], }, - q(numeric) => { - q(004) => [ - q(0001), + q(genc-alpha-2) => { + q(A1) => [ + q(0280), q(0), ], - q(008) => [ - q(0003), + q(A2) => [ + q(0265), q(0), ], - q(010) => [ - q(0009), + q(A3) => [ + q(0261), q(0), ], - q(012) => [ - q(0004), + q(AD) => [ + q(0006), q(0), ], - q(016) => [ - q(0005), + q(AE) => [ + q(0234), q(0), ], - q(020) => [ - q(0006), + q(AF) => [ + q(0001), q(0), ], - q(024) => [ - q(0007), + q(AG) => [ + q(0010), q(0), ], - q(028) => [ - q(0010), + q(AI) => [ + q(0008), q(0), ], - q(031) => [ - q(0016), + q(AL) => [ + q(0003), q(0), ], - q(032) => [ + q(AM) => [ + q(0012), + q(0), + ], + q(AO) => [ + q(0007), + q(0), + ], + q(AQ) => [ + q(0009), + q(0), + ], + q(AR) => [ q(0011), q(0), ], - q(036) => [ - q(0014), + q(AS) => [ + q(0005), q(0), ], - q(040) => [ + q(AT) => [ q(0015), q(0), ], - q(044) => [ - q(0017), + q(AU) => [ + q(0014), q(0), ], - q(048) => [ - q(0018), + q(AW) => [ + q(0013), q(0), ], - q(050) => [ - q(0019), + q(AZ) => [ + q(0016), q(0), ], - q(051) => [ - q(0012), + q(BA) => [ + q(0029), q(0), ], - q(052) => [ + q(BB) => [ q(0020), q(0), ], - q(056) => [ - q(0022), + q(BD) => [ + q(0019), q(0), ], - q(060) => [ - q(0025), + q(BE) => [ + q(0022), q(0), ], - q(064) => [ - q(0026), + q(BF) => [ + q(0036), q(0), ], - q(068) => [ - q(0027), + q(BG) => [ + q(0035), q(0), ], - q(070) => [ - q(0029), + q(BH) => [ + q(0018), q(0), ], - q(072) => [ - q(0030), + q(BI) => [ + q(0037), q(0), ], - q(074) => [ - q(0031), + q(BJ) => [ + q(0024), q(0), ], - q(076) => [ - q(0032), + q(BL) => [ + q(0185), q(0), ], - q(084) => [ - q(0023), + q(BM) => [ + q(0025), q(0), ], - q(086) => [ - q(0033), + q(BN) => [ + q(0034), q(0), ], - q(090) => [ - q(0204), + q(BO) => [ + q(0027), q(0), ], - q(092) => [ - q(0243), - q(0), + q(BQ) => [ + q(0028), + q(1), ], - q(096) => [ - q(0034), + q(BR) => [ + q(0032), q(0), ], - q(100) => [ - q(0035), + q(BS) => [ + q(0017), q(0), ], - q(104) => [ - q(0153), + q(BT) => [ + q(0026), q(0), ], - q(108) => [ - q(0037), + q(BV) => [ + q(0031), q(0), ], - q(112) => [ - q(0021), + q(BW) => [ + q(0030), q(0), ], - q(116) => [ - q(0039), + q(BY) => [ + q(0021), q(0), ], - q(120) => [ - q(0040), + q(BZ) => [ + q(0023), q(0), ], - q(124) => [ + q(CA) => [ q(0041), q(0), ], - q(132) => [ - q(0038), + q(CC) => [ + q(0048), q(0), ], - q(136) => [ - q(0042), + q(CD) => [ + q(0051), q(0), ], - q(140) => [ + q(CF) => [ q(0043), q(0), ], - q(144) => [ + q(CG) => [ + q(0052), + q(0), + ], + q(CH) => [ + q(0216), + q(0), + ], + q(CI) => [ + q(0055), + q(0), + ], + q(CK) => [ + q(0053), + q(0), + ], + q(CL) => [ + q(0045), + q(0), + ], + q(CM) => [ + q(0040), + q(0), + ], + q(CN) => [ + q(0046), + q(0), + ], + q(CO) => [ + q(0049), + q(0), + ], + q(CP) => [ + q(0256), + q(0), + ], + q(CR) => [ + q(0054), + q(0), + ], + q(CU) => [ + q(0057), + q(0), + ], + q(CV) => [ + q(0038), + q(0), + ], + q(CW) => [ + q(0058), + q(0), + ], + q(CX) => [ + q(0047), + q(0), + ], + q(CY) => [ + q(0059), + q(0), + ], + q(CZ) => [ + q(0060), + q(0), + ], + q(DE) => [ + q(0083), + q(0), + ], + q(DG) => [ + q(0259), + q(0), + ], + q(DJ) => [ + q(0062), + q(0), + ], + q(DK) => [ + q(0061), + q(0), + ], + q(DM) => [ + q(0063), + q(0), + ], + q(DO) => [ + q(0064), + q(0), + ], + q(DZ) => [ + q(0004), + q(0), + ], + q(EC) => [ + q(0065), + q(0), + ], + q(EE) => [ + q(0070), + q(0), + ], + q(EG) => [ + q(0066), + q(0), + ], + q(EH) => [ + q(0246), + q(0), + ], + q(ER) => [ + q(0069), + q(0), + ], + q(ES) => [ + q(0209), + q(0), + ], + q(ET) => [ + q(0071), + q(0), + ], + q(FI) => [ + q(0075), + q(0), + ], + q(FJ) => [ + q(0074), + q(0), + ], + q(FK) => [ + q(0072), + q(0), + ], + q(FM) => [ + q(0145), + q(0), + ], + q(FO) => [ + q(0073), + q(0), + ], + q(FR) => [ + q(0076), + q(0), + ], + q(GA) => [ + q(0080), + q(0), + ], + q(GB) => [ + q(0235), + q(0), + ], + q(GD) => [ + q(0088), + q(0), + ], + q(GE) => [ + q(0082), + q(0), + ], + q(GF) => [ + q(0077), + q(0), + ], + q(GG) => [ + q(0092), + q(0), + ], + q(GH) => [ + q(0084), + q(0), + ], + q(GI) => [ + q(0085), + q(0), + ], + q(GL) => [ + q(0087), + q(0), + ], + q(GM) => [ + q(0081), + q(0), + ], + q(GN) => [ + q(0093), + q(0), + ], + q(GP) => [ + q(0089), + q(0), + ], + q(GQ) => [ + q(0068), + q(0), + ], + q(GR) => [ + q(0086), + q(0), + ], + q(GS) => [ + q(0207), + q(2), + ], + q(GT) => [ + q(0091), + q(0), + ], + q(GU) => [ + q(0090), + q(0), + ], + q(GW) => [ + q(0094), + q(0), + ], + q(GY) => [ + q(0095), + q(0), + ], + q(HK) => [ + q(0100), + q(0), + ], + q(HM) => [ + q(0097), + q(0), + ], + q(HN) => [ + q(0099), + q(0), + ], + q(HR) => [ + q(0056), + q(0), + ], + q(HT) => [ + q(0096), + q(0), + ], + q(HU) => [ + q(0101), + q(0), + ], + q(ID) => [ + q(0104), + q(0), + ], + q(IE) => [ + q(0107), + q(0), + ], + q(IL) => [ + q(0109), + q(0), + ], + q(IM) => [ + q(0108), + q(0), + ], + q(IN) => [ + q(0103), + q(0), + ], + q(IO) => [ + q(0033), + q(0), + ], + q(IQ) => [ + q(0106), + q(0), + ], + q(IR) => [ + q(0105), + q(0), + ], + q(IS) => [ + q(0102), + q(0), + ], + q(IT) => [ + q(0110), + q(0), + ], + q(JE) => [ + q(0113), + q(0), + ], + q(JM) => [ + q(0111), + q(0), + ], + q(JO) => [ + q(0114), + q(0), + ], + q(JP) => [ + q(0112), + q(0), + ], + q(KE) => [ + q(0116), + q(0), + ], + q(KG) => [ + q(0121), + q(0), + ], + q(KH) => [ + q(0039), + q(0), + ], + q(KI) => [ + q(0117), + q(0), + ], + q(KM) => [ + q(0050), + q(0), + ], + q(KN) => [ + q(0187), + q(0), + ], + q(KP) => [ + q(0118), + q(7), + ], + q(KR) => [ + q(0119), + q(7), + ], + q(KW) => [ + q(0120), + q(0), + ], + q(KY) => [ + q(0042), + q(0), + ], + q(KZ) => [ + q(0115), + q(0), + ], + q(LA) => [ + q(0122), + q(4), + ], + q(LB) => [ + q(0124), + q(0), + ], + q(LC) => [ + q(0188), + q(0), + ], + q(LI) => [ + q(0128), + q(0), + ], + q(LK) => [ + q(0210), + q(0), + ], + q(LR) => [ + q(0126), + q(0), + ], + q(LS) => [ + q(0125), + q(0), + ], + q(LT) => [ + q(0129), + q(0), + ], + q(LU) => [ + q(0130), + q(0), + ], + q(LV) => [ + q(0123), + q(0), + ], + q(LY) => [ + q(0127), + q(0), + ], + q(MA) => [ + q(0151), + q(0), + ], + q(MC) => [ + q(0147), + q(0), + ], + q(MD) => [ + q(0146), + q(6), + ], + q(ME) => [ + q(0149), + q(0), + ], + q(MF) => [ + q(0189), + q(0), + ], + q(MG) => [ + q(0133), + q(0), + ], + q(MH) => [ + q(0139), + q(0), + ], + q(MK) => [ + q(0132), + q(0), + ], + q(ML) => [ + q(0137), + q(0), + ], + q(MM) => [ + q(0153), + q(0), + ], + q(MN) => [ + q(0148), + q(0), + ], + q(MO) => [ + q(0131), + q(0), + ], + q(MP) => [ + q(0165), + q(0), + ], + q(MQ) => [ + q(0140), + q(0), + ], + q(MR) => [ + q(0141), + q(0), + ], + q(MS) => [ + q(0150), + q(0), + ], + q(MT) => [ + q(0138), + q(0), + ], + q(MU) => [ + q(0142), + q(0), + ], + q(MV) => [ + q(0136), + q(0), + ], + q(MW) => [ + q(0134), + q(0), + ], + q(MX) => [ + q(0144), + q(0), + ], + q(MY) => [ + q(0135), + q(0), + ], + q(MZ) => [ + q(0152), + q(0), + ], + q(NA) => [ + q(0154), + q(0), + ], + q(NC) => [ + q(0158), + q(0), + ], + q(NE) => [ + q(0161), + q(0), + ], + q(NF) => [ + q(0164), + q(0), + ], + q(NG) => [ + q(0162), + q(0), + ], + q(NI) => [ + q(0160), + q(0), + ], + q(NL) => [ + q(0157), + q(0), + ], + q(NO) => [ + q(0166), + q(0), + ], + q(NP) => [ + q(0156), + q(0), + ], + q(NR) => [ + q(0155), + q(0), + ], + q(NU) => [ + q(0163), + q(0), + ], + q(NZ) => [ + q(0159), + q(0), + ], + q(OM) => [ + q(0167), + q(0), + ], + q(PA) => [ + q(0171), + q(0), + ], + q(PE) => [ + q(0174), + q(0), + ], + q(PF) => [ + q(0078), + q(0), + ], + q(PG) => [ + q(0172), + q(0), + ], + q(PH) => [ + q(0175), + q(0), + ], + q(PK) => [ + q(0168), + q(0), + ], + q(PL) => [ + q(0177), + q(0), + ], + q(PM) => [ + q(0190), + q(0), + ], + q(PN) => [ + q(0176), + q(0), + ], + q(PR) => [ + q(0179), + q(0), + ], + q(PT) => [ + q(0178), + q(0), + ], + q(PW) => [ + q(0169), + q(0), + ], + q(PY) => [ + q(0173), + q(0), + ], + q(QA) => [ + q(0180), + q(0), + ], + q(QM) => [ + q(0273), + q(0), + ], + q(QS) => [ + q(0255), + q(0), + ], + q(QU) => [ + q(0270), + q(0), + ], + q(QW) => [ + q(0281), + q(0), + ], + q(QX) => [ + q(0264), + q(0), + ], + q(QZ) => [ + q(0252), + q(0), + ], + q(RE) => [ + q(0181), + q(0), + ], + q(RO) => [ + q(0182), + q(0), + ], + q(RS) => [ + q(0197), + q(0), + ], + q(RU) => [ + q(0183), + q(4), + ], + q(RW) => [ + q(0184), + q(0), + ], + q(SA) => [ + q(0195), + q(0), + ], + q(SB) => [ + q(0204), + q(0), + ], + q(SC) => [ + q(0198), + q(0), + ], + q(SD) => [ + q(0211), + q(0), + ], + q(SE) => [ + q(0215), + q(0), + ], + q(SG) => [ + q(0200), + q(0), + ], + q(SH) => [ + q(0186), + q(2), + ], + q(SI) => [ + q(0203), + q(0), + ], + q(SK) => [ + q(0202), + q(0), + ], + q(SL) => [ + q(0199), + q(0), + ], + q(SM) => [ + q(0193), + q(0), + ], + q(SN) => [ + q(0196), + q(0), + ], + q(SO) => [ + q(0205), + q(0), + ], + q(SR) => [ + q(0212), + q(0), + ], + q(SS) => [ + q(0208), + q(0), + ], + q(ST) => [ + q(0194), + q(0), + ], + q(SV) => [ + q(0067), + q(0), + ], + q(SX) => [ + q(0201), + q(1), + ], + q(SY) => [ + q(0217), + q(0), + ], + q(SZ) => [ + q(0214), + q(0), + ], + q(TC) => [ + q(0230), + q(0), + ], + q(TD) => [ + q(0044), + q(0), + ], + q(TF) => [ + q(0079), + q(0), + ], + q(TG) => [ + q(0223), + q(0), + ], + q(TH) => [ + q(0221), + q(0), + ], + q(TJ) => [ + q(0219), + q(0), + ], + q(TK) => [ + q(0224), + q(0), + ], + q(TL) => [ + q(0222), + q(0), + ], + q(TM) => [ + q(0229), + q(0), + ], + q(TN) => [ + q(0227), + q(0), + ], + q(TO) => [ + q(0225), + q(0), + ], + q(TR) => [ + q(0228), + q(0), + ], + q(TT) => [ + q(0226), + q(0), + ], + q(TV) => [ + q(0231), + q(0), + ], + q(TW) => [ + q(0218), + q(0), + ], + q(TZ) => [ + q(0220), + q(3), + ], + q(UA) => [ + q(0233), + q(0), + ], + q(UG) => [ + q(0232), + q(0), + ], + q(US) => [ + q(0237), + q(0), + ], + q(UY) => [ + q(0238), + q(0), + ], + q(UZ) => [ + q(0239), + q(0), + ], + q(VA) => [ + q(0098), + q(0), + ], + q(VC) => [ + q(0191), + q(0), + ], + q(VE) => [ + q(0241), + q(0), + ], + q(VG) => [ + q(0243), + q(0), + ], + q(VI) => [ + q(0244), + q(0), + ], + q(VN) => [ + q(0242), + q(0), + ], + q(VU) => [ + q(0240), + q(0), + ], + q(WF) => [ + q(0245), + q(0), + ], + q(WS) => [ + q(0192), + q(0), + ], + q(XA) => [ + q(0253), + q(0), + ], + q(XB) => [ + q(0254), + q(0), + ], + q(XC) => [ + q(0257), + q(0), + ], + q(XD) => [ + q(0258), + q(0), + ], + q(XE) => [ + q(0262), + q(0), + ], + q(XG) => [ + q(0263), + q(0), + ], + q(XH) => [ + q(0266), + q(0), + ], + q(XJ) => [ + q(0267), + q(0), + ], + q(XK) => [ + q(0272), + q(0), + ], + q(XL) => [ + q(0275), + q(0), + ], + q(XM) => [ + q(0271), + q(0), + ], + q(XP) => [ + q(0276), + q(0), + ], + q(XQ) => [ + q(0268), + q(0), + ], + q(XR) => [ + q(0278), + q(0), + ], + q(XS) => [ + q(0277), + q(0), + ], + q(XT) => [ + q(0279), + q(0), + ], + q(XU) => [ + q(0269), + q(0), + ], + q(XV) => [ + q(0274), + q(0), + ], + q(XW) => [ + q(0282), + q(0), + ], + q(YE) => [ + q(0247), + q(0), + ], + q(YT) => [ + q(0143), + q(0), + ], + q(ZA) => [ + q(0206), + q(0), + ], + q(ZM) => [ + q(0248), + q(0), + ], + q(ZW) => [ + q(0249), + q(0), + ], + q([None Assigned]) => [ + q(0260), + q(4), + ], + }, + q(genc-alpha-3) => { + q(ABW) => [ + q(0013), + q(0), + ], + q(AFG) => [ + q(0001), + q(0), + ], + q(AGO) => [ + q(0007), + q(0), + ], + q(AIA) => [ + q(0008), + q(0), + ], + q(ALB) => [ + q(0003), + q(0), + ], + q(AND) => [ + q(0006), + q(0), + ], + q(ARE) => [ + q(0234), + q(0), + ], + q(ARG) => [ + q(0011), + q(0), + ], + q(ARM) => [ + q(0012), + q(0), + ], + q(ASM) => [ + q(0005), + q(0), + ], + q(ATA) => [ + q(0009), + q(0), + ], + q(ATF) => [ + q(0079), + q(0), + ], + q(ATG) => [ + q(0010), + q(0), + ], + q(AUS) => [ + q(0014), + q(0), + ], + q(AUT) => [ + q(0015), + q(0), + ], + q(AX1) => [ + q(0280), + q(0), + ], + q(AX2) => [ + q(0265), + q(0), + ], + q(AX3) => [ + q(0261), + q(0), + ], + q(AZE) => [ + q(0016), + q(0), + ], + q(BDI) => [ + q(0037), + q(0), + ], + q(BEL) => [ + q(0022), + q(0), + ], + q(BEN) => [ + q(0024), + q(0), + ], + q(BES) => [ + q(0028), + q(1), + ], + q(BFA) => [ + q(0036), + q(0), + ], + q(BGD) => [ + q(0019), + q(0), + ], + q(BGR) => [ + q(0035), + q(0), + ], + q(BHR) => [ + q(0018), + q(0), + ], + q(BHS) => [ + q(0017), + q(0), + ], + q(BIH) => [ + q(0029), + q(0), + ], + q(BLM) => [ + q(0185), + q(0), + ], + q(BLR) => [ + q(0021), + q(0), + ], + q(BLZ) => [ + q(0023), + q(0), + ], + q(BMU) => [ + q(0025), + q(0), + ], + q(BOL) => [ + q(0027), + q(0), + ], + q(BRA) => [ + q(0032), + q(0), + ], + q(BRB) => [ + q(0020), + q(0), + ], + q(BRN) => [ + q(0034), + q(0), + ], + q(BTN) => [ + q(0026), + q(0), + ], + q(BVT) => [ + q(0031), + q(0), + ], + q(BWA) => [ + q(0030), + q(0), + ], + q(CAF) => [ + q(0043), + q(0), + ], + q(CAN) => [ + q(0041), + q(0), + ], + q(CCK) => [ + q(0048), + q(0), + ], + q(CHE) => [ + q(0216), + q(0), + ], + q(CHL) => [ + q(0045), + q(0), + ], + q(CHN) => [ + q(0046), + q(0), + ], + q(CIV) => [ + q(0055), + q(0), + ], + q(CMR) => [ + q(0040), + q(0), + ], + q(COD) => [ + q(0051), + q(0), + ], + q(COG) => [ + q(0052), + q(0), + ], + q(COK) => [ + q(0053), + q(0), + ], + q(COL) => [ + q(0049), + q(0), + ], + q(COM) => [ + q(0050), + q(0), + ], + q(CPT) => [ + q(0256), + q(0), + ], + q(CPV) => [ + q(0038), + q(0), + ], + q(CRI) => [ + q(0054), + q(0), + ], + q(CUB) => [ + q(0057), + q(0), + ], + q(CUW) => [ + q(0058), + q(0), + ], + q(CXR) => [ + q(0047), + q(0), + ], + q(CYM) => [ + q(0042), + q(0), + ], + q(CYP) => [ + q(0059), + q(0), + ], + q(CZE) => [ + q(0060), + q(0), + ], + q(DEU) => [ + q(0083), + q(0), + ], + q(DGA) => [ + q(0259), + q(0), + ], + q(DJI) => [ + q(0062), + q(0), + ], + q(DMA) => [ + q(0063), + q(0), + ], + q(DNK) => [ + q(0061), + q(0), + ], + q(DOM) => [ + q(0064), + q(0), + ], + q(DZA) => [ + q(0004), + q(0), + ], + q(ECU) => [ + q(0065), + q(0), + ], + q(EGY) => [ + q(0066), + q(0), + ], + q(ERI) => [ + q(0069), + q(0), + ], + q(ESH) => [ + q(0246), + q(0), + ], + q(ESP) => [ + q(0209), + q(0), + ], + q(EST) => [ + q(0070), + q(0), + ], + q(ETH) => [ + q(0071), + q(0), + ], + q(FIN) => [ + q(0075), + q(0), + ], + q(FJI) => [ + q(0074), + q(0), + ], + q(FLK) => [ + q(0072), + q(0), + ], + q(FRA) => [ + q(0076), + q(0), + ], + q(FRO) => [ + q(0073), + q(0), + ], + q(FSM) => [ + q(0145), + q(0), + ], + q(GAB) => [ + q(0080), + q(0), + ], + q(GBR) => [ + q(0235), + q(0), + ], + q(GEO) => [ + q(0082), + q(0), + ], + q(GGY) => [ + q(0092), + q(0), + ], + q(GHA) => [ + q(0084), + q(0), + ], + q(GIB) => [ + q(0085), + q(0), + ], + q(GIN) => [ + q(0093), + q(0), + ], + q(GLP) => [ + q(0089), + q(0), + ], + q(GMB) => [ + q(0081), + q(0), + ], + q(GNB) => [ + q(0094), + q(0), + ], + q(GNQ) => [ + q(0068), + q(0), + ], + q(GRC) => [ + q(0086), + q(0), + ], + q(GRD) => [ + q(0088), + q(0), + ], + q(GRL) => [ + q(0087), + q(0), + ], + q(GTM) => [ + q(0091), + q(0), + ], + q(GUF) => [ + q(0077), + q(0), + ], + q(GUM) => [ + q(0090), + q(0), + ], + q(GUY) => [ + q(0095), + q(0), + ], + q(HKG) => [ + q(0100), + q(0), + ], + q(HMD) => [ + q(0097), + q(0), + ], + q(HND) => [ + q(0099), + q(0), + ], + q(HRV) => [ + q(0056), + q(0), + ], + q(HTI) => [ + q(0096), + q(0), + ], + q(HUN) => [ + q(0101), + q(0), + ], + q(IDN) => [ + q(0104), + q(0), + ], + q(IMN) => [ + q(0108), + q(0), + ], + q(IND) => [ + q(0103), + q(0), + ], + q(IOT) => [ + q(0033), + q(0), + ], + q(IRL) => [ + q(0107), + q(0), + ], + q(IRN) => [ + q(0105), + q(0), + ], + q(IRQ) => [ + q(0106), + q(0), + ], + q(ISL) => [ + q(0102), + q(0), + ], + q(ISR) => [ + q(0109), + q(0), + ], + q(ITA) => [ + q(0110), + q(0), + ], + q(JAM) => [ + q(0111), + q(0), + ], + q(JEY) => [ + q(0113), + q(0), + ], + q(JOR) => [ + q(0114), + q(0), + ], + q(JPN) => [ + q(0112), + q(0), + ], + q(KAZ) => [ + q(0115), + q(0), + ], + q(KEN) => [ + q(0116), + q(0), + ], + q(KGZ) => [ + q(0121), + q(0), + ], + q(KHM) => [ + q(0039), + q(0), + ], + q(KIR) => [ + q(0117), + q(0), + ], + q(KNA) => [ + q(0187), + q(0), + ], + q(KOR) => [ + q(0119), + q(7), + ], + q(KWT) => [ + q(0120), + q(0), + ], + q(LAO) => [ + q(0122), + q(4), + ], + q(LBN) => [ + q(0124), + q(0), + ], + q(LBR) => [ + q(0126), + q(0), + ], + q(LBY) => [ + q(0127), + q(0), + ], + q(LCA) => [ + q(0188), + q(0), + ], + q(LIE) => [ + q(0128), + q(0), + ], + q(LKA) => [ + q(0210), + q(0), + ], + q(LSO) => [ + q(0125), + q(0), + ], + q(LTU) => [ + q(0129), + q(0), + ], + q(LUX) => [ + q(0130), + q(0), + ], + q(LVA) => [ + q(0123), + q(0), + ], + q(MAC) => [ + q(0131), + q(0), + ], + q(MAF) => [ + q(0189), + q(0), + ], + q(MAR) => [ + q(0151), + q(0), + ], + q(MCO) => [ + q(0147), + q(0), + ], + q(MDA) => [ + q(0146), + q(6), + ], + q(MDG) => [ + q(0133), + q(0), + ], + q(MDV) => [ + q(0136), + q(0), + ], + q(MEX) => [ + q(0144), + q(0), + ], + q(MHL) => [ + q(0139), + q(0), + ], + q(MKD) => [ + q(0132), + q(0), + ], + q(MLI) => [ + q(0137), + q(0), + ], + q(MLT) => [ + q(0138), + q(0), + ], + q(MMR) => [ + q(0153), + q(0), + ], + q(MNE) => [ + q(0149), + q(0), + ], + q(MNG) => [ + q(0148), + q(0), + ], + q(MNP) => [ + q(0165), + q(0), + ], + q(MOZ) => [ + q(0152), + q(0), + ], + q(MRT) => [ + q(0141), + q(0), + ], + q(MSR) => [ + q(0150), + q(0), + ], + q(MTQ) => [ + q(0140), + q(0), + ], + q(MUS) => [ + q(0142), + q(0), + ], + q(MWI) => [ + q(0134), + q(0), + ], + q(MYS) => [ + q(0135), + q(0), + ], + q(MYT) => [ + q(0143), + q(0), + ], + q(NAM) => [ + q(0154), + q(0), + ], + q(NCL) => [ + q(0158), + q(0), + ], + q(NER) => [ + q(0161), + q(0), + ], + q(NFK) => [ + q(0164), + q(0), + ], + q(NGA) => [ + q(0162), + q(0), + ], + q(NIC) => [ + q(0160), + q(0), + ], + q(NIU) => [ + q(0163), + q(0), + ], + q(NLD) => [ + q(0157), + q(0), + ], + q(NOR) => [ + q(0166), + q(0), + ], + q(NPL) => [ + q(0156), + q(0), + ], + q(NRU) => [ + q(0155), + q(0), + ], + q(NZL) => [ + q(0159), + q(0), + ], + q(OMN) => [ + q(0167), + q(0), + ], + q(PAK) => [ + q(0168), + q(0), + ], + q(PAN) => [ + q(0171), + q(0), + ], + q(PCN) => [ + q(0176), + q(0), + ], + q(PER) => [ + q(0174), + q(0), + ], + q(PHL) => [ + q(0175), + q(0), + ], + q(PLW) => [ + q(0169), + q(0), + ], + q(PNG) => [ + q(0172), + q(0), + ], + q(POL) => [ + q(0177), + q(0), + ], + q(PRI) => [ + q(0179), + q(0), + ], + q(PRK) => [ + q(0118), + q(7), + ], + q(PRT) => [ + q(0178), + q(0), + ], + q(PRY) => [ + q(0173), + q(0), + ], + q(PYF) => [ + q(0078), + q(0), + ], + q(QAT) => [ + q(0180), + q(0), + ], + q(REU) => [ + q(0181), + q(0), + ], + q(ROU) => [ + q(0182), + q(0), + ], + q(RUS) => [ + q(0183), + q(4), + ], + q(RWA) => [ + q(0184), + q(0), + ], + q(SAU) => [ + q(0195), + q(0), + ], + q(SDN) => [ + q(0211), + q(0), + ], + q(SEN) => [ + q(0196), + q(0), + ], + q(SGP) => [ + q(0200), + q(0), + ], + q(SGS) => [ + q(0207), + q(2), + ], + q(SHN) => [ + q(0186), + q(2), + ], + q(SLB) => [ + q(0204), + q(0), + ], + q(SLE) => [ + q(0199), + q(0), + ], + q(SLV) => [ + q(0067), + q(0), + ], + q(SMR) => [ + q(0193), + q(0), + ], + q(SOM) => [ + q(0205), + q(0), + ], + q(SPM) => [ + q(0190), + q(0), + ], + q(SRB) => [ + q(0197), + q(0), + ], + q(SSD) => [ + q(0208), + q(0), + ], + q(STP) => [ + q(0194), + q(0), + ], + q(SUR) => [ + q(0212), + q(0), + ], + q(SVK) => [ + q(0202), + q(0), + ], + q(SVN) => [ + q(0203), + q(0), + ], + q(SWE) => [ + q(0215), + q(0), + ], + q(SWZ) => [ + q(0214), + q(0), + ], + q(SXM) => [ + q(0201), + q(1), + ], + q(SYC) => [ + q(0198), + q(0), + ], + q(SYR) => [ + q(0217), + q(0), + ], + q(TCA) => [ + q(0230), + q(0), + ], + q(TCD) => [ + q(0044), + q(0), + ], + q(TGO) => [ + q(0223), + q(0), + ], + q(THA) => [ + q(0221), + q(0), + ], + q(TJK) => [ + q(0219), + q(0), + ], + q(TKL) => [ + q(0224), + q(0), + ], + q(TKM) => [ + q(0229), + q(0), + ], + q(TLS) => [ + q(0222), + q(0), + ], + q(TON) => [ + q(0225), + q(0), + ], + q(TTO) => [ + q(0226), + q(0), + ], + q(TUN) => [ + q(0227), + q(0), + ], + q(TUR) => [ + q(0228), + q(0), + ], + q(TUV) => [ + q(0231), + q(0), + ], + q(TWN) => [ + q(0218), + q(0), + ], + q(TZA) => [ + q(0220), + q(3), + ], + q(UGA) => [ + q(0232), + q(0), + ], + q(UKR) => [ + q(0233), + q(0), + ], + q(URY) => [ + q(0238), + q(0), + ], + q(USA) => [ + q(0237), + q(0), + ], + q(UZB) => [ + q(0239), + q(0), + ], + q(VAT) => [ + q(0098), + q(0), + ], + q(VCT) => [ + q(0191), + q(0), + ], + q(VEN) => [ + q(0241), + q(0), + ], + q(VGB) => [ + q(0243), + q(0), + ], + q(VIR) => [ + q(0244), + q(0), + ], + q(VNM) => [ + q(0242), + q(0), + ], + q(VUT) => [ + q(0240), + q(0), + ], + q(WLF) => [ + q(0245), + q(0), + ], + q(WSM) => [ + q(0192), + q(0), + ], + q(XAC) => [ + q(0253), + q(0), + ], + q(XAZ) => [ + q(0260), + q(0), + ], + q(XBI) => [ + q(0255), + q(0), + ], + q(XBK) => [ + q(0254), + q(0), + ], + q(XCR) => [ + q(0260), + q(1), + ], + q(XCS) => [ + q(0257), + q(0), + ], + q(XCY) => [ + q(0260), + q(2), + ], + q(XEU) => [ + q(0262), + q(0), + ], + q(XGL) => [ + q(0264), + q(0), + ], + q(XGZ) => [ + q(0263), + q(0), + ], + q(XHO) => [ + q(0266), + q(0), + ], + q(XJA) => [ + q(0269), + q(0), + ], + q(XJM) => [ + q(0267), + q(0), + ], + q(XJN) => [ + q(0270), + q(0), + ], + q(XJV) => [ + q(0268), + q(0), + ], + q(XKM) => [ + q(0260), + q(3), + ], + q(XKN) => [ + q(0260), + q(4), + ], + q(XKR) => [ + q(0271), + q(0), + ], + q(XKS) => [ + q(0272), + q(0), + ], + q(XMW) => [ + q(0273), + q(0), + ], + q(XNV) => [ + q(0274), + q(0), + ], + q(XPL) => [ + q(0275), + q(0), + ], + q(XPR) => [ + q(0276), + q(0), + ], + q(XQZ) => [ + q(0252), + q(0), + ], + q(XSP) => [ + q(0277), + q(0), + ], + q(XSV) => [ + q(0278), + q(0), + ], + q(XTR) => [ + q(0279), + q(0), + ], + q(XWB) => [ + q(0282), + q(0), + ], + q(XWK) => [ + q(0281), + q(0), + ], + q(XXD) => [ + q(0258), + q(0), + ], + q(YEM) => [ + q(0247), + q(0), + ], + q(ZAF) => [ + q(0206), + q(0), + ], + q(ZMB) => [ + q(0248), + q(0), + ], + q(ZWE) => [ + q(0249), + q(0), + ], + }, + q(genc-numeric) => { + q(004) => [ + q(0001), + q(0), + ], + q(008) => [ + q(0003), + q(0), + ], + q(010) => [ + q(0009), + q(0), + ], + q(012) => [ + q(0004), + q(0), + ], + q(016) => [ + q(0005), + q(0), + ], + q(020) => [ + q(0006), + q(0), + ], + q(024) => [ + q(0007), + q(0), + ], + q(028) => [ + q(0010), + q(0), + ], + q(031) => [ + q(0016), + q(0), + ], + q(032) => [ + q(0011), + q(0), + ], + q(036) => [ + q(0014), + q(0), + ], + q(040) => [ + q(0015), + q(0), + ], + q(044) => [ + q(0017), + q(0), + ], + q(048) => [ + q(0018), + q(0), + ], + q(050) => [ + q(0019), + q(0), + ], + q(051) => [ + q(0012), + q(0), + ], + q(052) => [ + q(0020), + q(0), + ], + q(056) => [ + q(0022), + q(0), + ], + q(060) => [ + q(0025), + q(0), + ], + q(064) => [ + q(0026), + q(0), + ], + q(068) => [ + q(0027), + q(0), + ], + q(070) => [ + q(0029), + q(0), + ], + q(072) => [ + q(0030), + q(0), + ], + q(074) => [ + q(0031), + q(0), + ], + q(076) => [ + q(0032), + q(0), + ], + q(084) => [ + q(0023), + q(0), + ], + q(086) => [ + q(0033), + q(0), + ], + q(090) => [ + q(0204), + q(0), + ], + q(092) => [ + q(0243), + q(0), + ], + q(096) => [ + q(0034), + q(0), + ], + q(100) => [ + q(0035), + q(0), + ], + q(104) => [ + q(0153), + q(0), + ], + q(108) => [ + q(0037), + q(0), + ], + q(112) => [ + q(0021), + q(0), + ], + q(116) => [ + q(0039), + q(0), + ], + q(120) => [ + q(0040), + q(0), + ], + q(124) => [ + q(0041), + q(0), + ], + q(132) => [ + q(0038), + q(0), + ], + q(136) => [ + q(0042), + q(0), + ], + q(140) => [ + q(0043), + q(0), + ], + q(144) => [ + q(0210), + q(0), + ], + q(148) => [ + q(0044), + q(0), + ], + q(152) => [ + q(0045), + q(0), + ], + q(156) => [ + q(0046), + q(0), + ], + q(158) => [ + q(0218), + q(0), + ], + q(162) => [ + q(0047), + q(0), + ], + q(166) => [ + q(0048), + q(0), + ], + q(170) => [ + q(0049), + q(0), + ], + q(174) => [ + q(0050), + q(0), + ], + q(175) => [ + q(0143), + q(0), + ], + q(178) => [ + q(0052), + q(0), + ], + q(180) => [ + q(0051), + q(0), + ], + q(184) => [ + q(0053), + q(0), + ], + q(188) => [ + q(0054), + q(0), + ], + q(191) => [ + q(0056), + q(0), + ], + q(192) => [ + q(0057), + q(0), + ], + q(196) => [ + q(0059), + q(0), + ], + q(203) => [ + q(0060), + q(0), + ], + q(204) => [ + q(0024), + q(0), + ], + q(208) => [ + q(0061), + q(0), + ], + q(212) => [ + q(0063), + q(0), + ], + q(214) => [ + q(0064), + q(0), + ], + q(218) => [ + q(0065), + q(0), + ], + q(222) => [ + q(0067), + q(0), + ], + q(226) => [ + q(0068), + q(0), + ], + q(231) => [ + q(0071), + q(0), + ], + q(232) => [ + q(0069), + q(0), + ], + q(233) => [ + q(0070), + q(0), + ], + q(234) => [ + q(0073), + q(0), + ], + q(238) => [ + q(0072), + q(0), + ], + q(239) => [ + q(0207), + q(2), + ], + q(242) => [ + q(0074), + q(0), + ], + q(246) => [ + q(0075), + q(0), + ], + q(250) => [ + q(0076), + q(0), + ], + q(254) => [ + q(0077), + q(0), + ], + q(258) => [ + q(0078), + q(0), + ], + q(260) => [ + q(0079), + q(0), + ], + q(262) => [ + q(0062), + q(0), + ], + q(266) => [ + q(0080), + q(0), + ], + q(268) => [ + q(0082), + q(0), + ], + q(270) => [ + q(0081), + q(0), + ], + q(276) => [ + q(0083), + q(0), + ], + q(288) => [ + q(0084), + q(0), + ], + q(292) => [ + q(0085), + q(0), + ], + q(296) => [ + q(0117), + q(0), + ], + q(300) => [ + q(0086), + q(0), + ], + q(304) => [ + q(0087), + q(0), + ], + q(308) => [ + q(0088), + q(0), + ], + q(312) => [ + q(0089), + q(0), + ], + q(316) => [ + q(0090), + q(0), + ], + q(320) => [ + q(0091), + q(0), + ], + q(324) => [ + q(0093), + q(0), + ], + q(328) => [ + q(0095), + q(0), + ], + q(332) => [ + q(0096), + q(0), + ], + q(334) => [ + q(0097), + q(0), + ], + q(336) => [ + q(0098), + q(0), + ], + q(340) => [ + q(0099), + q(0), + ], + q(344) => [ + q(0100), + q(0), + ], + q(348) => [ + q(0101), + q(0), + ], + q(352) => [ + q(0102), + q(0), + ], + q(356) => [ + q(0103), + q(0), + ], + q(360) => [ + q(0104), + q(0), + ], + q(364) => [ + q(0105), + q(0), + ], + q(368) => [ + q(0106), + q(0), + ], + q(372) => [ + q(0107), + q(0), + ], + q(376) => [ + q(0109), + q(0), + ], + q(380) => [ + q(0110), + q(0), + ], + q(384) => [ + q(0055), + q(0), + ], + q(388) => [ + q(0111), + q(0), + ], + q(392) => [ + q(0112), + q(0), + ], + q(398) => [ + q(0115), + q(0), + ], + q(400) => [ + q(0114), + q(0), + ], + q(404) => [ + q(0116), + q(0), + ], + q(408) => [ + q(0118), + q(7), + ], + q(410) => [ + q(0119), + q(7), + ], + q(414) => [ + q(0120), + q(0), + ], + q(417) => [ + q(0121), + q(0), + ], + q(418) => [ + q(0122), + q(4), + ], + q(422) => [ + q(0124), + q(0), + ], + q(426) => [ + q(0125), + q(0), + ], + q(428) => [ + q(0123), + q(0), + ], + q(430) => [ + q(0126), + q(0), + ], + q(434) => [ + q(0127), + q(0), + ], + q(438) => [ + q(0128), + q(0), + ], + q(440) => [ + q(0129), + q(0), + ], + q(442) => [ + q(0130), + q(0), + ], + q(446) => [ + q(0131), + q(0), + ], + q(450) => [ + q(0133), + q(0), + ], + q(454) => [ + q(0134), + q(0), + ], + q(458) => [ + q(0135), + q(0), + ], + q(462) => [ + q(0136), + q(0), + ], + q(466) => [ + q(0137), + q(0), + ], + q(470) => [ + q(0138), + q(0), + ], + q(474) => [ + q(0140), + q(0), + ], + q(478) => [ + q(0141), + q(0), + ], + q(480) => [ + q(0142), + q(0), + ], + q(484) => [ + q(0144), + q(0), + ], + q(492) => [ + q(0147), + q(0), + ], + q(496) => [ + q(0148), + q(0), + ], + q(498) => [ + q(0146), + q(6), + ], + q(499) => [ + q(0149), + q(0), + ], + q(500) => [ + q(0150), + q(0), + ], + q(504) => [ + q(0151), + q(0), + ], + q(508) => [ + q(0152), + q(0), + ], + q(512) => [ + q(0167), + q(0), + ], + q(516) => [ + q(0154), + q(0), + ], + q(520) => [ + q(0155), + q(0), + ], + q(524) => [ + q(0156), + q(0), + ], + q(528) => [ + q(0157), + q(0), + ], + q(531) => [ + q(0058), + q(0), + ], + q(533) => [ + q(0013), + q(0), + ], + q(534) => [ + q(0201), + q(1), + ], + q(535) => [ + q(0028), + q(1), + ], + q(540) => [ + q(0158), + q(0), + ], + q(548) => [ + q(0240), + q(0), + ], + q(554) => [ + q(0159), + q(0), + ], + q(558) => [ + q(0160), + q(0), + ], + q(562) => [ + q(0161), + q(0), + ], + q(566) => [ + q(0162), + q(0), + ], + q(570) => [ + q(0163), + q(0), + ], + q(574) => [ + q(0164), + q(0), + ], + q(578) => [ + q(0166), + q(0), + ], + q(580) => [ + q(0165), + q(0), + ], + q(583) => [ + q(0145), + q(0), + ], + q(584) => [ + q(0139), + q(0), + ], + q(585) => [ + q(0169), + q(0), + ], + q(586) => [ + q(0168), + q(0), + ], + q(591) => [ + q(0171), + q(0), + ], + q(598) => [ + q(0172), + q(0), + ], + q(600) => [ + q(0173), + q(0), + ], + q(604) => [ + q(0174), + q(0), + ], + q(608) => [ + q(0175), + q(0), + ], + q(612) => [ + q(0176), + q(0), + ], + q(616) => [ + q(0177), + q(0), + ], + q(620) => [ + q(0178), + q(0), + ], + q(624) => [ + q(0094), + q(0), + ], + q(626) => [ + q(0222), + q(0), + ], + q(630) => [ + q(0179), + q(0), + ], + q(634) => [ + q(0180), + q(0), + ], + q(638) => [ + q(0181), + q(0), + ], + q(642) => [ + q(0182), + q(0), + ], + q(643) => [ + q(0183), + q(4), + ], + q(646) => [ + q(0184), + q(0), + ], + q(652) => [ + q(0185), + q(0), + ], + q(654) => [ + q(0186), + q(2), + ], + q(659) => [ + q(0187), + q(0), + ], + q(660) => [ + q(0008), + q(0), + ], + q(662) => [ + q(0188), + q(0), + ], + q(663) => [ + q(0189), + q(0), + ], + q(666) => [ + q(0190), + q(0), + ], + q(670) => [ + q(0191), + q(0), + ], + q(674) => [ + q(0193), + q(0), + ], + q(678) => [ + q(0194), + q(0), + ], + q(682) => [ + q(0195), + q(0), + ], + q(686) => [ + q(0196), + q(0), + ], + q(688) => [ + q(0197), + q(0), + ], + q(690) => [ + q(0198), + q(0), + ], + q(694) => [ + q(0199), + q(0), + ], + q(702) => [ + q(0200), + q(0), + ], + q(703) => [ + q(0202), + q(0), + ], + q(704) => [ + q(0242), + q(0), + ], + q(705) => [ + q(0203), + q(0), + ], + q(706) => [ + q(0205), + q(0), + ], + q(710) => [ + q(0206), + q(0), + ], + q(716) => [ + q(0249), + q(0), + ], + q(724) => [ + q(0209), + q(0), + ], + q(728) => [ + q(0208), + q(0), + ], + q(729) => [ + q(0211), + q(0), + ], + q(732) => [ + q(0246), + q(0), + ], + q(740) => [ + q(0212), + q(0), + ], + q(748) => [ + q(0214), + q(0), + ], + q(752) => [ + q(0215), + q(0), + ], + q(756) => [ + q(0216), + q(0), + ], + q(760) => [ + q(0217), + q(0), + ], + q(762) => [ + q(0219), + q(0), + ], + q(764) => [ + q(0221), + q(0), + ], + q(768) => [ + q(0223), + q(0), + ], + q(772) => [ + q(0224), + q(0), + ], + q(776) => [ + q(0225), + q(0), + ], + q(780) => [ + q(0226), + q(0), + ], + q(784) => [ + q(0234), + q(0), + ], + q(788) => [ + q(0227), + q(0), + ], + q(792) => [ + q(0228), + q(0), + ], + q(795) => [ + q(0229), + q(0), + ], + q(796) => [ + q(0230), + q(0), + ], + q(798) => [ + q(0231), + q(0), + ], + q(800) => [ + q(0232), + q(0), + ], + q(804) => [ + q(0233), + q(0), + ], + q(807) => [ + q(0132), + q(0), + ], + q(818) => [ + q(0066), + q(0), + ], + q(826) => [ + q(0235), + q(0), + ], + q(831) => [ + q(0092), + q(0), + ], + q(832) => [ + q(0113), + q(0), + ], + q(833) => [ + q(0108), + q(0), + ], + q(834) => [ + q(0220), + q(3), + ], + q(840) => [ + q(0237), + q(0), + ], + q(850) => [ + q(0244), + q(0), + ], + q(854) => [ + q(0036), + q(0), + ], + q(858) => [ + q(0238), + q(0), + ], + q(860) => [ + q(0239), + q(0), + ], + q(862) => [ + q(0241), + q(0), + ], + q(876) => [ + q(0245), + q(0), + ], + q(882) => [ + q(0192), + q(0), + ], + q(887) => [ + q(0247), + q(0), + ], + q(894) => [ + q(0248), + q(0), + ], + q(900) => [ + q(0252), + q(0), + ], + q(901) => [ + q(0272), + q(0), + ], + q(902) => [ + q(0253), + q(0), + ], + q(903) => [ + q(0254), + q(0), + ], + q(904) => [ + q(0255), + q(0), + ], + q(905) => [ + q(0256), + q(0), + ], + q(906) => [ + q(0257), + q(0), + ], + q(907) => [ + q(0258), + q(0), + ], + q(908) => [ + q(0259), + q(0), + ], + q(909) => [ + q(0260), + q(0), + ], + q(910) => [ + q(0260), + q(1), + ], + q(911) => [ + q(0260), + q(2), + ], + q(912) => [ + q(0260), + q(3), + ], + q(913) => [ + q(0260), + q(4), + ], + q(914) => [ + q(0261), + q(0), + ], + q(915) => [ + q(0262), + q(0), + ], + q(916) => [ + q(0263), + q(0), + ], + q(917) => [ + q(0264), + q(0), + ], + q(918) => [ + q(0265), + q(0), + ], + q(919) => [ + q(0266), + q(0), + ], + q(920) => [ + q(0267), + q(0), + ], + q(921) => [ + q(0268), + q(0), + ], + q(922) => [ + q(0269), + q(0), + ], + q(923) => [ + q(0270), + q(0), + ], + q(924) => [ + q(0271), + q(0), + ], + q(925) => [ + q(0273), + q(0), + ], + q(926) => [ + q(0274), + q(0), + ], + q(927) => [ + q(0275), + q(0), + ], + q(928) => [ + q(0276), + q(0), + ], + q(929) => [ + q(0277), + q(0), + ], + q(930) => [ + q(0278), + q(0), + ], + q(931) => [ + q(0279), + q(0), + ], + q(932) => [ + q(0280), + q(0), + ], + q(933) => [ + q(0281), + q(0), + ], + q(934) => [ + q(0282), + q(0), + ], + }, + q(numeric) => { + q(004) => [ + q(0001), + q(0), + ], + q(008) => [ + q(0003), + q(0), + ], + q(010) => [ + q(0009), + q(0), + ], + q(012) => [ + q(0004), + q(0), + ], + q(016) => [ + q(0005), + q(0), + ], + q(020) => [ + q(0006), + q(0), + ], + q(024) => [ + q(0007), + q(0), + ], + q(028) => [ + q(0010), + q(0), + ], + q(031) => [ + q(0016), + q(0), + ], + q(032) => [ + q(0011), + q(0), + ], + q(036) => [ + q(0014), + q(0), + ], + q(040) => [ + q(0015), + q(0), + ], + q(044) => [ + q(0017), + q(0), + ], + q(048) => [ + q(0018), + q(0), + ], + q(050) => [ + q(0019), + q(0), + ], + q(051) => [ + q(0012), + q(0), + ], + q(052) => [ + q(0020), + q(0), + ], + q(056) => [ + q(0022), + q(0), + ], + q(060) => [ + q(0025), + q(0), + ], + q(064) => [ + q(0026), + q(0), + ], + q(068) => [ + q(0027), + q(0), + ], + q(070) => [ + q(0029), + q(0), + ], + q(072) => [ + q(0030), + q(0), + ], + q(074) => [ + q(0031), + q(0), + ], + q(076) => [ + q(0032), + q(0), + ], + q(084) => [ + q(0023), + q(0), + ], + q(086) => [ + q(0033), + q(0), + ], + q(090) => [ + q(0204), + q(0), + ], + q(092) => [ + q(0243), + q(0), + ], + q(096) => [ + q(0034), + q(0), + ], + q(100) => [ + q(0035), + q(0), + ], + q(104) => [ + q(0153), + q(0), + ], + q(108) => [ + q(0037), + q(0), + ], + q(112) => [ + q(0021), + q(0), + ], + q(116) => [ + q(0039), + q(0), + ], + q(120) => [ + q(0040), + q(0), + ], + q(124) => [ + q(0041), + q(0), + ], + q(132) => [ + q(0038), + q(0), + ], + q(136) => [ + q(0042), + q(0), + ], + q(140) => [ + q(0043), + q(0), + ], + q(144) => [ + q(0210), + q(0), + ], + q(148) => [ + q(0044), + q(0), + ], + q(152) => [ + q(0045), + q(0), + ], + q(156) => [ + q(0046), + q(0), + ], + q(158) => [ + q(0218), + q(0), + ], + q(162) => [ + q(0047), + q(0), + ], + q(166) => [ + q(0048), + q(0), + ], + q(170) => [ + q(0049), + q(0), + ], + q(174) => [ + q(0050), + q(0), + ], + q(175) => [ + q(0143), + q(0), + ], + q(178) => [ + q(0052), + q(0), + ], + q(180) => [ + q(0051), + q(0), + ], + q(184) => [ + q(0053), + q(0), + ], + q(188) => [ + q(0054), + q(0), + ], + q(191) => [ + q(0056), + q(0), + ], + q(192) => [ + q(0057), + q(0), + ], + q(196) => [ + q(0059), + q(0), + ], + q(203) => [ + q(0060), + q(0), + ], + q(204) => [ + q(0024), + q(0), + ], + q(208) => [ + q(0061), + q(0), + ], + q(212) => [ + q(0063), + q(0), + ], + q(214) => [ + q(0064), + q(0), + ], + q(218) => [ + q(0065), + q(0), + ], + q(222) => [ + q(0067), + q(0), + ], + q(226) => [ + q(0068), + q(0), + ], + q(231) => [ + q(0071), + q(0), + ], + q(232) => [ + q(0069), + q(0), + ], + q(233) => [ + q(0070), + q(0), + ], + q(234) => [ + q(0073), + q(0), + ], + q(238) => [ + q(0072), + q(0), + ], + q(239) => [ + q(0207), + q(0), + ], + q(242) => [ + q(0074), + q(0), + ], + q(246) => [ + q(0075), + q(0), + ], + q(248) => [ + q(0002), + q(0), + ], + q(250) => [ + q(0076), + q(0), + ], + q(254) => [ + q(0077), + q(0), + ], + q(258) => [ + q(0078), + q(0), + ], + q(260) => [ + q(0079), + q(0), + ], + q(262) => [ + q(0062), + q(0), + ], + q(266) => [ + q(0080), + q(0), + ], + q(268) => [ + q(0082), + q(0), + ], + q(270) => [ + q(0081), + q(0), + ], + q(275) => [ + q(0170), + q(0), + ], + q(276) => [ + q(0083), + q(0), + ], + q(288) => [ + q(0084), + q(0), + ], + q(292) => [ + q(0085), + q(0), + ], + q(296) => [ + q(0117), + q(0), + ], + q(300) => [ + q(0086), + q(0), + ], + q(304) => [ + q(0087), + q(0), + ], + q(308) => [ + q(0088), + q(0), + ], + q(312) => [ + q(0089), + q(0), + ], + q(316) => [ + q(0090), + q(0), + ], + q(320) => [ + q(0091), + q(0), + ], + q(324) => [ + q(0093), + q(0), + ], + q(328) => [ + q(0095), + q(0), + ], + q(332) => [ + q(0096), + q(0), + ], + q(334) => [ + q(0097), + q(0), + ], + q(336) => [ + q(0098), + q(0), + ], + q(340) => [ + q(0099), + q(0), + ], + q(344) => [ + q(0100), + q(0), + ], + q(348) => [ + q(0101), + q(0), + ], + q(352) => [ + q(0102), + q(0), + ], + q(356) => [ + q(0103), + q(0), + ], + q(360) => [ + q(0104), + q(0), + ], + q(364) => [ + q(0105), + q(0), + ], + q(368) => [ + q(0106), + q(0), + ], + q(372) => [ + q(0107), + q(0), + ], + q(376) => [ + q(0109), + q(0), + ], + q(380) => [ + q(0110), + q(0), + ], + q(384) => [ + q(0055), + q(0), + ], + q(388) => [ + q(0111), + q(0), + ], + q(392) => [ + q(0112), + q(0), + ], + q(398) => [ + q(0115), + q(0), + ], + q(400) => [ + q(0114), + q(0), + ], + q(404) => [ + q(0116), + q(0), + ], + q(408) => [ + q(0118), + q(0), + ], + q(410) => [ + q(0119), + q(0), + ], + q(414) => [ + q(0120), + q(0), + ], + q(417) => [ + q(0121), + q(0), + ], + q(418) => [ + q(0122), + q(0), + ], + q(422) => [ + q(0124), + q(0), + ], + q(426) => [ + q(0125), + q(0), + ], + q(428) => [ + q(0123), + q(0), + ], + q(430) => [ + q(0126), + q(0), + ], + q(434) => [ + q(0127), + q(0), + ], + q(438) => [ + q(0128), + q(0), + ], + q(440) => [ + q(0129), + q(0), + ], + q(442) => [ + q(0130), + q(0), + ], + q(446) => [ + q(0131), + q(0), + ], + q(450) => [ + q(0133), + q(0), + ], + q(454) => [ + q(0134), + q(0), + ], + q(458) => [ + q(0135), + q(0), + ], + q(462) => [ + q(0136), + q(0), + ], + q(466) => [ + q(0137), + q(0), + ], + q(470) => [ + q(0138), + q(0), + ], + q(474) => [ + q(0140), + q(0), + ], + q(478) => [ + q(0141), + q(0), + ], + q(480) => [ + q(0142), + q(0), + ], + q(484) => [ + q(0144), + q(0), + ], + q(492) => [ + q(0147), + q(0), + ], + q(496) => [ + q(0148), + q(0), + ], + q(498) => [ + q(0146), + q(0), + ], + q(499) => [ + q(0149), + q(0), + ], + q(500) => [ + q(0150), + q(0), + ], + q(504) => [ + q(0151), + q(0), + ], + q(508) => [ + q(0152), + q(0), + ], + q(512) => [ + q(0167), + q(0), + ], + q(516) => [ + q(0154), + q(0), + ], + q(520) => [ + q(0155), + q(0), + ], + q(524) => [ + q(0156), + q(0), + ], + q(528) => [ + q(0157), + q(0), + ], + q(531) => [ + q(0058), + q(0), + ], + q(533) => [ + q(0013), + q(0), + ], + q(534) => [ + q(0201), + q(0), + ], + q(535) => [ + q(0028), + q(0), + ], + q(540) => [ + q(0158), + q(0), + ], + q(548) => [ + q(0240), + q(0), + ], + q(554) => [ + q(0159), + q(0), + ], + q(558) => [ + q(0160), + q(0), + ], + q(562) => [ + q(0161), + q(0), + ], + q(566) => [ + q(0162), + q(0), + ], + q(570) => [ + q(0163), + q(0), + ], + q(574) => [ + q(0164), + q(0), + ], + q(578) => [ + q(0166), + q(0), + ], + q(580) => [ + q(0165), + q(0), + ], + q(581) => [ + q(0236), + q(0), + ], + q(583) => [ + q(0145), + q(0), + ], + q(584) => [ + q(0139), + q(0), + ], + q(585) => [ + q(0169), + q(0), + ], + q(586) => [ + q(0168), + q(0), + ], + q(591) => [ + q(0171), + q(0), + ], + q(598) => [ + q(0172), + q(0), + ], + q(600) => [ + q(0173), + q(0), + ], + q(604) => [ + q(0174), + q(0), + ], + q(608) => [ + q(0175), + q(0), + ], + q(612) => [ + q(0176), + q(0), + ], + q(616) => [ + q(0177), + q(0), + ], + q(620) => [ + q(0178), + q(0), + ], + q(624) => [ + q(0094), + q(0), + ], + q(626) => [ + q(0222), + q(0), + ], + q(630) => [ + q(0179), + q(0), + ], + q(634) => [ + q(0180), + q(0), + ], + q(638) => [ + q(0181), + q(0), + ], + q(642) => [ + q(0182), + q(0), + ], + q(643) => [ + q(0183), + q(0), + ], + q(646) => [ + q(0184), + q(0), + ], + q(652) => [ + q(0185), + q(0), + ], + q(654) => [ + q(0186), + q(0), + ], + q(659) => [ + q(0187), + q(0), + ], + q(660) => [ + q(0008), + q(0), + ], + q(662) => [ + q(0188), + q(0), + ], + q(663) => [ + q(0189), + q(0), + ], + q(666) => [ + q(0190), + q(0), + ], + q(670) => [ + q(0191), + q(0), + ], + q(674) => [ + q(0193), + q(0), + ], + q(678) => [ + q(0194), + q(0), + ], + q(682) => [ + q(0195), + q(0), + ], + q(686) => [ + q(0196), + q(0), + ], + q(688) => [ + q(0197), + q(0), + ], + q(690) => [ + q(0198), + q(0), + ], + q(694) => [ + q(0199), + q(0), + ], + q(702) => [ + q(0200), + q(0), + ], + q(703) => [ + q(0202), + q(0), + ], + q(704) => [ + q(0242), + q(0), + ], + q(705) => [ + q(0203), + q(0), + ], + q(706) => [ + q(0205), + q(0), + ], + q(710) => [ + q(0206), + q(0), + ], + q(716) => [ + q(0249), + q(0), + ], + q(724) => [ + q(0209), + q(0), + ], + q(728) => [ + q(0208), + q(0), + ], + q(729) => [ + q(0211), + q(0), + ], + q(732) => [ + q(0246), + q(0), + ], + q(740) => [ + q(0212), + q(0), + ], + q(744) => [ + q(0213), + q(0), + ], + q(748) => [ + q(0214), + q(0), + ], + q(752) => [ + q(0215), + q(0), + ], + q(756) => [ + q(0216), + q(0), + ], + q(760) => [ + q(0217), + q(0), + ], + q(762) => [ + q(0219), + q(0), + ], + q(764) => [ + q(0221), + q(0), + ], + q(768) => [ + q(0223), + q(0), + ], + q(772) => [ + q(0224), + q(0), + ], + q(776) => [ + q(0225), + q(0), + ], + q(780) => [ + q(0226), + q(0), + ], + q(784) => [ + q(0234), + q(0), + ], + q(788) => [ + q(0227), + q(0), + ], + q(792) => [ + q(0228), + q(0), + ], + q(795) => [ + q(0229), + q(0), + ], + q(796) => [ + q(0230), + q(0), + ], + q(798) => [ + q(0231), + q(0), + ], + q(800) => [ + q(0232), + q(0), + ], + q(804) => [ + q(0233), + q(0), + ], + q(807) => [ + q(0132), + q(0), + ], + q(818) => [ + q(0066), + q(0), + ], + q(826) => [ + q(0235), + q(0), + ], + q(831) => [ + q(0092), + q(0), + ], + q(832) => [ + q(0113), + q(0), + ], + q(833) => [ + q(0108), + q(0), + ], + q(834) => [ + q(0220), + q(0), + ], + q(840) => [ + q(0237), + q(0), + ], + q(850) => [ + q(0244), + q(0), + ], + q(854) => [ + q(0036), + q(0), + ], + q(858) => [ + q(0238), + q(0), + ], + q(860) => [ + q(0239), + q(0), + ], + q(862) => [ + q(0241), + q(0), + ], + q(876) => [ + q(0245), + q(0), + ], + q(882) => [ + q(0192), + q(0), + ], + q(887) => [ + q(0247), + q(0), + ], + q(894) => [ + q(0248), + q(0), + ], + }, + q(un-alpha-3) => { + q(ABW) => [ + q(0013), + q(0), + ], + q(AFG) => [ + q(0001), + q(0), + ], + q(AGO) => [ + q(0007), + q(0), + ], + q(AIA) => [ + q(0008), + q(0), + ], + q(ALA) => [ + q(0002), + q(0), + ], + q(ALB) => [ + q(0003), + q(0), + ], + q(AND) => [ + q(0006), + q(0), + ], + q(ARG) => [ + q(0011), + q(0), + ], + q(ARM) => [ + q(0012), + q(0), + ], + q(ASM) => [ + q(0005), + q(0), + ], + q(ATG) => [ + q(0010), + q(0), + ], + q(AUS) => [ + q(0014), + q(0), + ], + q(AUT) => [ + q(0015), + q(0), + ], + q(AZE) => [ + q(0016), + q(0), + ], + q(BDI) => [ + q(0037), + q(0), + ], + q(BEL) => [ + q(0022), + q(0), + ], + q(BEN) => [ + q(0024), + q(0), + ], + q(BES) => [ + q(0028), + q(0), + ], + q(BFA) => [ + q(0036), + q(0), + ], + q(BGD) => [ + q(0019), + q(0), + ], + q(BGR) => [ + q(0035), + q(0), + ], + q(BHR) => [ + q(0018), + q(0), + ], + q(BHS) => [ + q(0017), + q(0), + ], + q(BIH) => [ + q(0029), + q(0), + ], + q(BLM) => [ + q(0185), + q(0), + ], + q(BLR) => [ + q(0021), + q(0), + ], + q(BLZ) => [ + q(0023), + q(0), + ], + q(BMU) => [ + q(0025), + q(0), + ], + q(BOL) => [ + q(0027), + q(0), + ], + q(BRA) => [ + q(0032), + q(0), + ], + q(BRB) => [ + q(0020), + q(0), + ], + q(BRN) => [ + q(0034), + q(0), + ], + q(BTN) => [ + q(0026), + q(0), + ], + q(BWA) => [ + q(0030), + q(0), + ], + q(CAF) => [ + q(0043), + q(0), + ], + q(CAN) => [ + q(0041), + q(0), + ], + q(CHL) => [ + q(0045), + q(0), + ], + q(CHN) => [ + q(0046), + q(0), + ], + q(CIV) => [ + q(0055), + q(0), + ], + q(CMR) => [ + q(0040), + q(0), + ], + q(COD) => [ + q(0051), + q(0), + ], + q(COG) => [ + q(0052), + q(0), + ], + q(COK) => [ + q(0053), + q(0), + ], + q(COL) => [ + q(0049), + q(0), + ], + q(COM) => [ + q(0050), + q(0), + ], + q(CPV) => [ + q(0038), + q(0), + ], + q(CRI) => [ + q(0054), + q(0), + ], + q(CUB) => [ + q(0057), + q(0), + ], + q(CUW) => [ + q(0058), + q(0), + ], + q(CYM) => [ + q(0042), + q(0), + ], + q(CYP) => [ + q(0059), + q(0), + ], + q(CZE) => [ + q(0060), + q(0), + ], + q(DEU) => [ + q(0083), + q(0), + ], + q(DJI) => [ + q(0062), + q(0), + ], + q(DMA) => [ + q(0063), + q(0), + ], + q(DNK) => [ + q(0061), + q(0), + ], + q(DOM) => [ + q(0064), + q(0), + ], + q(DZA) => [ + q(0004), + q(0), + ], + q(ECU) => [ + q(0065), + q(0), + ], + q(EGY) => [ + q(0066), + q(0), + ], + q(ERI) => [ + q(0069), + q(0), + ], + q(ESP) => [ + q(0209), + q(0), + ], + q(EST) => [ + q(0070), + q(0), + ], + q(ETH) => [ + q(0071), + q(0), + ], + q(FIN) => [ + q(0075), + q(0), + ], + q(FJI) => [ + q(0074), + q(0), + ], + q(FLK) => [ + q(0072), + q(0), + ], + q(FRA) => [ + q(0076), + q(0), + ], + q(FRO) => [ + q(0073), + q(0), + ], + q(FSM) => [ + q(0145), + q(0), + ], + q(GAB) => [ + q(0080), + q(0), + ], + q(GEO) => [ + q(0082), + q(0), + ], + q(GGY) => [ + q(0092), + q(0), + ], + q(GHA) => [ + q(0084), + q(0), + ], + q(GIB) => [ + q(0085), + q(0), + ], + q(GIN) => [ + q(0093), + q(0), + ], + q(GLP) => [ + q(0089), + q(0), + ], + q(GMB) => [ + q(0081), + q(0), + ], + q(GNB) => [ + q(0094), + q(0), + ], + q(GNQ) => [ + q(0068), + q(0), + ], + q(GRC) => [ + q(0086), + q(0), + ], + q(GRD) => [ + q(0088), + q(0), + ], + q(GRL) => [ + q(0087), + q(0), + ], + q(GTM) => [ + q(0091), + q(0), + ], + q(GUF) => [ + q(0077), + q(0), + ], + q(GUM) => [ + q(0090), + q(0), + ], + q(GUY) => [ + q(0095), + q(0), + ], + q(HKG) => [ + q(0100), + q(0), + ], + q(HND) => [ + q(0099), + q(0), + ], + q(HRV) => [ + q(0056), + q(0), + ], + q(HTI) => [ + q(0096), + q(0), + ], + q(HUN) => [ + q(0101), + q(0), + ], + q(IDN) => [ + q(0104), + q(0), + ], + q(IMN) => [ + q(0108), + q(0), + ], + q(IND) => [ + q(0103), + q(0), + ], + q(IRL) => [ + q(0107), + q(0), + ], + q(IRN) => [ + q(0105), + q(0), + ], + q(IRQ) => [ + q(0106), + q(0), + ], + q(ISL) => [ + q(0102), + q(0), + ], + q(ISR) => [ + q(0109), + q(0), + ], + q(ITA) => [ + q(0110), + q(0), + ], + q(JAM) => [ + q(0111), + q(0), + ], + q(JEY) => [ + q(0113), + q(0), + ], + q(JOR) => [ + q(0114), + q(0), + ], + q(JPN) => [ + q(0112), + q(0), + ], + q(KAZ) => [ + q(0115), + q(0), + ], + q(KEN) => [ + q(0116), + q(0), + ], + q(KGZ) => [ + q(0121), + q(0), + ], + q(KHM) => [ + q(0039), + q(0), + ], + q(KIR) => [ + q(0117), + q(0), + ], + q(KNA) => [ + q(0187), + q(0), + ], + q(KOR) => [ + q(0119), + q(0), + ], + q(KWT) => [ + q(0120), + q(0), + ], + q(LAO) => [ + q(0122), + q(0), + ], + q(LBN) => [ + q(0124), + q(0), + ], + q(LBR) => [ + q(0126), + q(0), + ], + q(LBY) => [ + q(0127), + q(0), + ], + q(LCA) => [ + q(0188), + q(0), + ], + q(LIE) => [ + q(0128), + q(0), + ], + q(LKA) => [ + q(0210), + q(0), + ], + q(LSO) => [ + q(0125), + q(0), + ], + q(LTU) => [ + q(0129), + q(0), + ], + q(LUX) => [ + q(0130), + q(0), + ], + q(LVA) => [ + q(0123), + q(0), + ], + q(MAC) => [ + q(0131), + q(0), + ], + q(MAF) => [ + q(0189), + q(0), + ], + q(MAR) => [ + q(0151), + q(0), + ], + q(MCO) => [ + q(0147), + q(0), + ], + q(MDA) => [ + q(0146), + q(0), + ], + q(MDG) => [ + q(0133), + q(0), + ], + q(MDV) => [ + q(0136), + q(0), + ], + q(MEX) => [ + q(0144), + q(0), + ], + q(MHL) => [ + q(0139), + q(0), + ], + q(MLI) => [ + q(0137), + q(0), + ], + q(MLT) => [ + q(0138), + q(0), + ], + q(MMR) => [ + q(0153), + q(0), + ], + q(MNE) => [ + q(0149), + q(0), + ], + q(MNG) => [ + q(0148), + q(0), + ], + q(MNP) => [ + q(0165), + q(0), + ], + q(MOZ) => [ + q(0152), + q(0), + ], + q(MRT) => [ + q(0141), + q(0), + ], + q(MSR) => [ + q(0150), + q(0), + ], + q(MTQ) => [ + q(0140), + q(0), + ], + q(MUS) => [ + q(0142), + q(0), + ], + q(MWI) => [ + q(0134), + q(0), + ], + q(MYS) => [ + q(0135), + q(0), + ], + q(MYT) => [ + q(0143), + q(0), + ], + q(NAM) => [ + q(0154), + q(0), + ], + q(NCL) => [ + q(0158), + q(0), + ], + q(NER) => [ + q(0161), + q(0), + ], + q(NFK) => [ + q(0164), + q(0), + ], + q(NGA) => [ + q(0162), + q(0), + ], + q(NIC) => [ + q(0160), + q(0), + ], + q(NIU) => [ + q(0163), + q(0), + ], + q(NLD) => [ + q(0157), + q(0), + ], + q(NOR) => [ + q(0166), + q(0), + ], + q(NPL) => [ + q(0156), + q(0), + ], + q(NRU) => [ + q(0155), + q(0), + ], + q(NZL) => [ + q(0159), + q(0), + ], + q(OMN) => [ + q(0167), + q(0), + ], + q(PAK) => [ + q(0168), + q(0), + ], + q(PAN) => [ + q(0171), + q(0), + ], + q(PCN) => [ + q(0176), + q(0), + ], + q(PER) => [ + q(0174), + q(0), + ], + q(PHL) => [ + q(0175), + q(0), + ], + q(PLW) => [ + q(0169), + q(0), + ], + q(PNG) => [ + q(0172), + q(0), + ], + q(POL) => [ + q(0177), + q(0), + ], + q(PRI) => [ + q(0179), + q(0), + ], + q(PRK) => [ + q(0118), + q(0), + ], + q(PRT) => [ + q(0178), + q(0), + ], + q(PRY) => [ + q(0173), + q(0), + ], + q(PSE) => [ + q(0170), + q(0), + ], + q(PYF) => [ + q(0078), + q(0), + ], + q(QAT) => [ + q(0180), + q(0), + ], + q(REU) => [ + q(0181), + q(0), + ], + q(ROU) => [ + q(0182), + q(0), + ], + q(RUS) => [ + q(0183), + q(0), + ], + q(RWA) => [ + q(0184), + q(0), + ], + q(SAU) => [ + q(0195), + q(0), + ], + q(SEN) => [ + q(0196), + q(0), + ], + q(SGP) => [ + q(0200), + q(0), + ], + q(SHN) => [ + q(0186), + q(0), + ], + q(SLB) => [ + q(0204), + q(0), + ], + q(SLE) => [ + q(0199), + q(0), + ], + q(SLV) => [ + q(0067), + q(0), + ], + q(SMR) => [ + q(0193), + q(0), + ], + q(SOM) => [ + q(0205), + q(0), + ], + q(SPM) => [ + q(0190), + q(0), + ], + q(SRB) => [ + q(0197), + q(0), + ], + q(SSD) => [ + q(0208), + q(0), + ], + q(STP) => [ + q(0194), + q(0), + ], + q(SVK) => [ + q(0202), + q(0), + ], + q(SVN) => [ + q(0203), + q(0), + ], + q(SXM) => [ + q(0201), + q(0), + ], + q(SYC) => [ + q(0198), + q(0), + ], + q(TCD) => [ + q(0044), + q(0), + ], + q(VAT) => [ + q(0098), + q(0), + ], + q(VCT) => [ + q(0191), + q(0), + ], + q(VGB) => [ + q(0243), + q(0), + ], + q(WSM) => [ + q(0192), + q(0), + ], + q(ZAF) => [ + q(0206), + q(0), + ], + }, + q(un-numeric) => { + q(004) => [ + q(0001), + q(0), + ], + q(008) => [ + q(0003), + q(0), + ], + q(012) => [ + q(0004), + q(0), + ], + q(016) => [ + q(0005), + q(0), + ], + q(020) => [ + q(0006), + q(0), + ], + q(024) => [ + q(0007), + q(0), + ], + q(028) => [ + q(0010), + q(0), + ], + q(031) => [ + q(0016), + q(0), + ], + q(032) => [ + q(0011), + q(0), + ], + q(036) => [ + q(0014), + q(0), + ], + q(040) => [ + q(0015), + q(0), + ], + q(044) => [ + q(0017), + q(0), + ], + q(048) => [ + q(0018), + q(0), + ], + q(050) => [ + q(0019), + q(0), + ], + q(051) => [ + q(0012), + q(0), + ], + q(052) => [ + q(0020), + q(0), + ], + q(056) => [ + q(0022), + q(0), + ], + q(060) => [ + q(0025), + q(0), + ], + q(064) => [ + q(0026), + q(0), + ], + q(068) => [ + q(0027), + q(0), + ], + q(070) => [ + q(0029), + q(0), + ], + q(072) => [ + q(0030), + q(0), + ], + q(076) => [ + q(0032), + q(0), + ], + q(084) => [ + q(0023), + q(0), + ], + q(090) => [ + q(0204), + q(0), + ], + q(092) => [ + q(0243), + q(0), + ], + q(096) => [ + q(0034), + q(0), + ], + q(100) => [ + q(0035), + q(0), + ], + q(104) => [ + q(0153), + q(0), + ], + q(108) => [ + q(0037), + q(0), + ], + q(112) => [ + q(0021), + q(0), + ], + q(116) => [ + q(0039), + q(0), + ], + q(120) => [ + q(0040), + q(0), + ], + q(124) => [ + q(0041), + q(0), + ], + q(132) => [ + q(0038), + q(0), + ], + q(136) => [ + q(0042), + q(0), + ], + q(140) => [ + q(0043), + q(0), + ], + q(144) => [ q(0210), q(0), ], @@ -6051,18 +11498,6 @@ $Locale::Codes::Data{'country'}{'code2id'} = { q(0046), q(0), ], - q(158) => [ - q(0218), - q(0), - ], - q(162) => [ - q(0047), - q(0), - ], - q(166) => [ - q(0048), - q(0), - ], q(170) => [ q(0049), q(0), @@ -6155,10 +11590,6 @@ $Locale::Codes::Data{'country'}{'code2id'} = { q(0072), q(0), ], - q(239) => [ - q(0207), - q(0), - ], q(242) => [ q(0074), q(0), @@ -6183,10 +11614,6 @@ $Locale::Codes::Data{'country'}{'code2id'} = { q(0078), q(0), ], - q(260) => [ - q(0079), - q(0), - ], q(262) => [ q(0062), q(0), @@ -6259,10 +11686,6 @@ $Locale::Codes::Data{'country'}{'code2id'} = { q(0096), q(0), ], - q(334) => [ - q(0097), - q(0), - ], q(336) => [ q(0098), q(0), @@ -6499,10 +11922,6 @@ $Locale::Codes::Data{'country'}{'code2id'} = { q(0158), q(0), ], - q(548) => [ - q(0240), - q(0), - ], q(554) => [ q(0159), q(0), @@ -6535,10 +11954,6 @@ $Locale::Codes::Data{'country'}{'code2id'} = { q(0165), q(0), ], - q(581) => [ - q(0236), - q(0), - ], q(583) => [ q(0145), q(0), @@ -6591,10 +12006,6 @@ $Locale::Codes::Data{'country'}{'code2id'} = { q(0094), q(0), ], - q(626) => [ - q(0222), - q(0), - ], q(630) => [ q(0179), q(0), @@ -6659,6 +12070,10 @@ $Locale::Codes::Data{'country'}{'code2id'} = { q(0194), q(0), ], + q(680) => [ + q(0251), + q(0), + ], q(682) => [ q(0195), q(0), @@ -6683,136 +12098,36 @@ $Locale::Codes::Data{'country'}{'code2id'} = { q(0200), q(0), ], - q(703) => [ - q(0202), - q(0), - ], - q(704) => [ - q(0242), - q(0), - ], - q(705) => [ - q(0203), - q(0), - ], - q(706) => [ - q(0205), - q(0), - ], - q(710) => [ - q(0206), - q(0), - ], - q(716) => [ - q(0249), - q(0), - ], - q(724) => [ - q(0209), - q(0), - ], - q(728) => [ - q(0208), - q(0), - ], - q(729) => [ - q(0211), - q(0), - ], - q(732) => [ - q(0246), - q(0), - ], - q(740) => [ - q(0212), - q(0), - ], - q(744) => [ - q(0213), - q(0), - ], - q(748) => [ - q(0214), - q(0), - ], - q(752) => [ - q(0215), - q(0), - ], - q(756) => [ - q(0216), - q(0), - ], - q(760) => [ - q(0217), - q(0), - ], - q(762) => [ - q(0219), - q(0), - ], - q(764) => [ - q(0221), - q(0), - ], - q(768) => [ - q(0223), - q(0), - ], - q(772) => [ - q(0224), - q(0), - ], - q(776) => [ - q(0225), - q(0), - ], - q(780) => [ - q(0226), - q(0), - ], - q(784) => [ - q(0234), - q(0), - ], - q(788) => [ - q(0227), - q(0), - ], - q(792) => [ - q(0228), - q(0), - ], - q(795) => [ - q(0229), + q(703) => [ + q(0202), q(0), ], - q(796) => [ - q(0230), + q(705) => [ + q(0203), q(0), ], - q(798) => [ - q(0231), + q(706) => [ + q(0205), q(0), ], - q(800) => [ - q(0232), + q(710) => [ + q(0206), q(0), ], - q(804) => [ - q(0233), + q(724) => [ + q(0209), q(0), ], - q(807) => [ - q(0132), + q(728) => [ + q(0208), q(0), ], q(818) => [ q(0066), q(0), ], - q(826) => [ - q(0235), + q(830) => [ + q(0250), q(0), ], q(831) => [ @@ -6827,50 +12142,14 @@ $Locale::Codes::Data{'country'}{'code2id'} = { q(0108), q(0), ], - q(834) => [ - q(0220), - q(0), - ], - q(840) => [ - q(0237), - q(0), - ], - q(850) => [ - q(0244), - q(0), - ], q(854) => [ q(0036), q(0), ], - q(858) => [ - q(0238), - q(0), - ], - q(860) => [ - q(0239), - q(0), - ], - q(862) => [ - q(0241), - q(0), - ], - q(876) => [ - q(0245), - q(0), - ], q(882) => [ q(0192), q(0), ], - q(887) => [ - q(0247), - q(0), - ], - q(894) => [ - q(0248), - q(0), - ], }, }; @@ -7628,6 +12907,840 @@ $Locale::Codes::Data{'country'}{'id2code'} = { q(0248) => q(zm), q(0249) => q(zw), }, + q(genc-alpha-2) => { + q(0001) => q(AF), + q(0003) => q(AL), + q(0004) => q(DZ), + q(0005) => q(AS), + q(0006) => q(AD), + q(0007) => q(AO), + q(0008) => q(AI), + q(0009) => q(AQ), + q(0010) => q(AG), + q(0011) => q(AR), + q(0012) => q(AM), + q(0013) => q(AW), + q(0014) => q(AU), + q(0015) => q(AT), + q(0016) => q(AZ), + q(0017) => q(BS), + q(0018) => q(BH), + q(0019) => q(BD), + q(0020) => q(BB), + q(0021) => q(BY), + q(0022) => q(BE), + q(0023) => q(BZ), + q(0024) => q(BJ), + q(0025) => q(BM), + q(0026) => q(BT), + q(0027) => q(BO), + q(0028) => q(BQ), + q(0029) => q(BA), + q(0030) => q(BW), + q(0031) => q(BV), + q(0032) => q(BR), + q(0033) => q(IO), + q(0034) => q(BN), + q(0035) => q(BG), + q(0036) => q(BF), + q(0037) => q(BI), + q(0038) => q(CV), + q(0039) => q(KH), + q(0040) => q(CM), + q(0041) => q(CA), + q(0042) => q(KY), + q(0043) => q(CF), + q(0044) => q(TD), + q(0045) => q(CL), + q(0046) => q(CN), + q(0047) => q(CX), + q(0048) => q(CC), + q(0049) => q(CO), + q(0050) => q(KM), + q(0051) => q(CD), + q(0052) => q(CG), + q(0053) => q(CK), + q(0054) => q(CR), + q(0055) => q(CI), + q(0056) => q(HR), + q(0057) => q(CU), + q(0058) => q(CW), + q(0059) => q(CY), + q(0060) => q(CZ), + q(0061) => q(DK), + q(0062) => q(DJ), + q(0063) => q(DM), + q(0064) => q(DO), + q(0065) => q(EC), + q(0066) => q(EG), + q(0067) => q(SV), + q(0068) => q(GQ), + q(0069) => q(ER), + q(0070) => q(EE), + q(0071) => q(ET), + q(0072) => q(FK), + q(0073) => q(FO), + q(0074) => q(FJ), + q(0075) => q(FI), + q(0076) => q(FR), + q(0077) => q(GF), + q(0078) => q(PF), + q(0079) => q(TF), + q(0080) => q(GA), + q(0081) => q(GM), + q(0082) => q(GE), + q(0083) => q(DE), + q(0084) => q(GH), + q(0085) => q(GI), + q(0086) => q(GR), + q(0087) => q(GL), + q(0088) => q(GD), + q(0089) => q(GP), + q(0090) => q(GU), + q(0091) => q(GT), + q(0092) => q(GG), + q(0093) => q(GN), + q(0094) => q(GW), + q(0095) => q(GY), + q(0096) => q(HT), + q(0097) => q(HM), + q(0098) => q(VA), + q(0099) => q(HN), + q(0100) => q(HK), + q(0101) => q(HU), + q(0102) => q(IS), + q(0103) => q(IN), + q(0104) => q(ID), + q(0105) => q(IR), + q(0106) => q(IQ), + q(0107) => q(IE), + q(0108) => q(IM), + q(0109) => q(IL), + q(0110) => q(IT), + q(0111) => q(JM), + q(0112) => q(JP), + q(0113) => q(JE), + q(0114) => q(JO), + q(0115) => q(KZ), + q(0116) => q(KE), + q(0117) => q(KI), + q(0118) => q(KP), + q(0119) => q(KR), + q(0120) => q(KW), + q(0121) => q(KG), + q(0122) => q(LA), + q(0123) => q(LV), + q(0124) => q(LB), + q(0125) => q(LS), + q(0126) => q(LR), + q(0127) => q(LY), + q(0128) => q(LI), + q(0129) => q(LT), + q(0130) => q(LU), + q(0131) => q(MO), + q(0132) => q(MK), + q(0133) => q(MG), + q(0134) => q(MW), + q(0135) => q(MY), + q(0136) => q(MV), + q(0137) => q(ML), + q(0138) => q(MT), + q(0139) => q(MH), + q(0140) => q(MQ), + q(0141) => q(MR), + q(0142) => q(MU), + q(0143) => q(YT), + q(0144) => q(MX), + q(0145) => q(FM), + q(0146) => q(MD), + q(0147) => q(MC), + q(0148) => q(MN), + q(0149) => q(ME), + q(0150) => q(MS), + q(0151) => q(MA), + q(0152) => q(MZ), + q(0153) => q(MM), + q(0154) => q(NA), + q(0155) => q(NR), + q(0156) => q(NP), + q(0157) => q(NL), + q(0158) => q(NC), + q(0159) => q(NZ), + q(0160) => q(NI), + q(0161) => q(NE), + q(0162) => q(NG), + q(0163) => q(NU), + q(0164) => q(NF), + q(0165) => q(MP), + q(0166) => q(NO), + q(0167) => q(OM), + q(0168) => q(PK), + q(0169) => q(PW), + q(0171) => q(PA), + q(0172) => q(PG), + q(0173) => q(PY), + q(0174) => q(PE), + q(0175) => q(PH), + q(0176) => q(PN), + q(0177) => q(PL), + q(0178) => q(PT), + q(0179) => q(PR), + q(0180) => q(QA), + q(0181) => q(RE), + q(0182) => q(RO), + q(0183) => q(RU), + q(0184) => q(RW), + q(0185) => q(BL), + q(0186) => q(SH), + q(0187) => q(KN), + q(0188) => q(LC), + q(0189) => q(MF), + q(0190) => q(PM), + q(0191) => q(VC), + q(0192) => q(WS), + q(0193) => q(SM), + q(0194) => q(ST), + q(0195) => q(SA), + q(0196) => q(SN), + q(0197) => q(RS), + q(0198) => q(SC), + q(0199) => q(SL), + q(0200) => q(SG), + q(0201) => q(SX), + q(0202) => q(SK), + q(0203) => q(SI), + q(0204) => q(SB), + q(0205) => q(SO), + q(0206) => q(ZA), + q(0207) => q(GS), + q(0208) => q(SS), + q(0209) => q(ES), + q(0210) => q(LK), + q(0211) => q(SD), + q(0212) => q(SR), + q(0214) => q(SZ), + q(0215) => q(SE), + q(0216) => q(CH), + q(0217) => q(SY), + q(0218) => q(TW), + q(0219) => q(TJ), + q(0220) => q(TZ), + q(0221) => q(TH), + q(0222) => q(TL), + q(0223) => q(TG), + q(0224) => q(TK), + q(0225) => q(TO), + q(0226) => q(TT), + q(0227) => q(TN), + q(0228) => q(TR), + q(0229) => q(TM), + q(0230) => q(TC), + q(0231) => q(TV), + q(0232) => q(UG), + q(0233) => q(UA), + q(0234) => q(AE), + q(0235) => q(GB), + q(0237) => q(US), + q(0238) => q(UY), + q(0239) => q(UZ), + q(0240) => q(VU), + q(0241) => q(VE), + q(0242) => q(VN), + q(0243) => q(VG), + q(0244) => q(VI), + q(0245) => q(WF), + q(0246) => q(EH), + q(0247) => q(YE), + q(0248) => q(ZM), + q(0249) => q(ZW), + q(0252) => q(QZ), + q(0253) => q(XA), + q(0254) => q(XB), + q(0255) => q(QS), + q(0256) => q(CP), + q(0257) => q(XC), + q(0258) => q(XD), + q(0259) => q(DG), + q(0260) => q([None Assigned]), + q(0261) => q(A3), + q(0262) => q(XE), + q(0263) => q(XG), + q(0264) => q(QX), + q(0265) => q(A2), + q(0266) => q(XH), + q(0267) => q(XJ), + q(0268) => q(XQ), + q(0269) => q(XU), + q(0270) => q(QU), + q(0271) => q(XM), + q(0272) => q(XK), + q(0273) => q(QM), + q(0274) => q(XV), + q(0275) => q(XL), + q(0276) => q(XP), + q(0277) => q(XS), + q(0278) => q(XR), + q(0279) => q(XT), + q(0280) => q(A1), + q(0281) => q(QW), + q(0282) => q(XW), + }, + q(genc-alpha-3) => { + q(0001) => q(AFG), + q(0003) => q(ALB), + q(0004) => q(DZA), + q(0005) => q(ASM), + q(0006) => q(AND), + q(0007) => q(AGO), + q(0008) => q(AIA), + q(0009) => q(ATA), + q(0010) => q(ATG), + q(0011) => q(ARG), + q(0012) => q(ARM), + q(0013) => q(ABW), + q(0014) => q(AUS), + q(0015) => q(AUT), + q(0016) => q(AZE), + q(0017) => q(BHS), + q(0018) => q(BHR), + q(0019) => q(BGD), + q(0020) => q(BRB), + q(0021) => q(BLR), + q(0022) => q(BEL), + q(0023) => q(BLZ), + q(0024) => q(BEN), + q(0025) => q(BMU), + q(0026) => q(BTN), + q(0027) => q(BOL), + q(0028) => q(BES), + q(0029) => q(BIH), + q(0030) => q(BWA), + q(0031) => q(BVT), + q(0032) => q(BRA), + q(0033) => q(IOT), + q(0034) => q(BRN), + q(0035) => q(BGR), + q(0036) => q(BFA), + q(0037) => q(BDI), + q(0038) => q(CPV), + q(0039) => q(KHM), + q(0040) => q(CMR), + q(0041) => q(CAN), + q(0042) => q(CYM), + q(0043) => q(CAF), + q(0044) => q(TCD), + q(0045) => q(CHL), + q(0046) => q(CHN), + q(0047) => q(CXR), + q(0048) => q(CCK), + q(0049) => q(COL), + q(0050) => q(COM), + q(0051) => q(COD), + q(0052) => q(COG), + q(0053) => q(COK), + q(0054) => q(CRI), + q(0055) => q(CIV), + q(0056) => q(HRV), + q(0057) => q(CUB), + q(0058) => q(CUW), + q(0059) => q(CYP), + q(0060) => q(CZE), + q(0061) => q(DNK), + q(0062) => q(DJI), + q(0063) => q(DMA), + q(0064) => q(DOM), + q(0065) => q(ECU), + q(0066) => q(EGY), + q(0067) => q(SLV), + q(0068) => q(GNQ), + q(0069) => q(ERI), + q(0070) => q(EST), + q(0071) => q(ETH), + q(0072) => q(FLK), + q(0073) => q(FRO), + q(0074) => q(FJI), + q(0075) => q(FIN), + q(0076) => q(FRA), + q(0077) => q(GUF), + q(0078) => q(PYF), + q(0079) => q(ATF), + q(0080) => q(GAB), + q(0081) => q(GMB), + q(0082) => q(GEO), + q(0083) => q(DEU), + q(0084) => q(GHA), + q(0085) => q(GIB), + q(0086) => q(GRC), + q(0087) => q(GRL), + q(0088) => q(GRD), + q(0089) => q(GLP), + q(0090) => q(GUM), + q(0091) => q(GTM), + q(0092) => q(GGY), + q(0093) => q(GIN), + q(0094) => q(GNB), + q(0095) => q(GUY), + q(0096) => q(HTI), + q(0097) => q(HMD), + q(0098) => q(VAT), + q(0099) => q(HND), + q(0100) => q(HKG), + q(0101) => q(HUN), + q(0102) => q(ISL), + q(0103) => q(IND), + q(0104) => q(IDN), + q(0105) => q(IRN), + q(0106) => q(IRQ), + q(0107) => q(IRL), + q(0108) => q(IMN), + q(0109) => q(ISR), + q(0110) => q(ITA), + q(0111) => q(JAM), + q(0112) => q(JPN), + q(0113) => q(JEY), + q(0114) => q(JOR), + q(0115) => q(KAZ), + q(0116) => q(KEN), + q(0117) => q(KIR), + q(0118) => q(PRK), + q(0119) => q(KOR), + q(0120) => q(KWT), + q(0121) => q(KGZ), + q(0122) => q(LAO), + q(0123) => q(LVA), + q(0124) => q(LBN), + q(0125) => q(LSO), + q(0126) => q(LBR), + q(0127) => q(LBY), + q(0128) => q(LIE), + q(0129) => q(LTU), + q(0130) => q(LUX), + q(0131) => q(MAC), + q(0132) => q(MKD), + q(0133) => q(MDG), + q(0134) => q(MWI), + q(0135) => q(MYS), + q(0136) => q(MDV), + q(0137) => q(MLI), + q(0138) => q(MLT), + q(0139) => q(MHL), + q(0140) => q(MTQ), + q(0141) => q(MRT), + q(0142) => q(MUS), + q(0143) => q(MYT), + q(0144) => q(MEX), + q(0145) => q(FSM), + q(0146) => q(MDA), + q(0147) => q(MCO), + q(0148) => q(MNG), + q(0149) => q(MNE), + q(0150) => q(MSR), + q(0151) => q(MAR), + q(0152) => q(MOZ), + q(0153) => q(MMR), + q(0154) => q(NAM), + q(0155) => q(NRU), + q(0156) => q(NPL), + q(0157) => q(NLD), + q(0158) => q(NCL), + q(0159) => q(NZL), + q(0160) => q(NIC), + q(0161) => q(NER), + q(0162) => q(NGA), + q(0163) => q(NIU), + q(0164) => q(NFK), + q(0165) => q(MNP), + q(0166) => q(NOR), + q(0167) => q(OMN), + q(0168) => q(PAK), + q(0169) => q(PLW), + q(0171) => q(PAN), + q(0172) => q(PNG), + q(0173) => q(PRY), + q(0174) => q(PER), + q(0175) => q(PHL), + q(0176) => q(PCN), + q(0177) => q(POL), + q(0178) => q(PRT), + q(0179) => q(PRI), + q(0180) => q(QAT), + q(0181) => q(REU), + q(0182) => q(ROU), + q(0183) => q(RUS), + q(0184) => q(RWA), + q(0185) => q(BLM), + q(0186) => q(SHN), + q(0187) => q(KNA), + q(0188) => q(LCA), + q(0189) => q(MAF), + q(0190) => q(SPM), + q(0191) => q(VCT), + q(0192) => q(WSM), + q(0193) => q(SMR), + q(0194) => q(STP), + q(0195) => q(SAU), + q(0196) => q(SEN), + q(0197) => q(SRB), + q(0198) => q(SYC), + q(0199) => q(SLE), + q(0200) => q(SGP), + q(0201) => q(SXM), + q(0202) => q(SVK), + q(0203) => q(SVN), + q(0204) => q(SLB), + q(0205) => q(SOM), + q(0206) => q(ZAF), + q(0207) => q(SGS), + q(0208) => q(SSD), + q(0209) => q(ESP), + q(0210) => q(LKA), + q(0211) => q(SDN), + q(0212) => q(SUR), + q(0214) => q(SWZ), + q(0215) => q(SWE), + q(0216) => q(CHE), + q(0217) => q(SYR), + q(0218) => q(TWN), + q(0219) => q(TJK), + q(0220) => q(TZA), + q(0221) => q(THA), + q(0222) => q(TLS), + q(0223) => q(TGO), + q(0224) => q(TKL), + q(0225) => q(TON), + q(0226) => q(TTO), + q(0227) => q(TUN), + q(0228) => q(TUR), + q(0229) => q(TKM), + q(0230) => q(TCA), + q(0231) => q(TUV), + q(0232) => q(UGA), + q(0233) => q(UKR), + q(0234) => q(ARE), + q(0235) => q(GBR), + q(0237) => q(USA), + q(0238) => q(URY), + q(0239) => q(UZB), + q(0240) => q(VUT), + q(0241) => q(VEN), + q(0242) => q(VNM), + q(0243) => q(VGB), + q(0244) => q(VIR), + q(0245) => q(WLF), + q(0246) => q(ESH), + q(0247) => q(YEM), + q(0248) => q(ZMB), + q(0249) => q(ZWE), + q(0252) => q(XQZ), + q(0253) => q(XAC), + q(0254) => q(XBK), + q(0255) => q(XBI), + q(0256) => q(CPT), + q(0257) => q(XCS), + q(0258) => q(XXD), + q(0259) => q(DGA), + q(0260) => q(XKN), + q(0261) => q(AX3), + q(0262) => q(XEU), + q(0263) => q(XGZ), + q(0264) => q(XGL), + q(0265) => q(AX2), + q(0266) => q(XHO), + q(0267) => q(XJM), + q(0268) => q(XJV), + q(0269) => q(XJA), + q(0270) => q(XJN), + q(0271) => q(XKR), + q(0272) => q(XKS), + q(0273) => q(XMW), + q(0274) => q(XNV), + q(0275) => q(XPL), + q(0276) => q(XPR), + q(0277) => q(XSP), + q(0278) => q(XSV), + q(0279) => q(XTR), + q(0280) => q(AX1), + q(0281) => q(XWK), + q(0282) => q(XWB), + }, + q(genc-numeric) => { + q(0001) => q(004), + q(0003) => q(008), + q(0004) => q(012), + q(0005) => q(016), + q(0006) => q(020), + q(0007) => q(024), + q(0008) => q(660), + q(0009) => q(010), + q(0010) => q(028), + q(0011) => q(032), + q(0012) => q(051), + q(0013) => q(533), + q(0014) => q(036), + q(0015) => q(040), + q(0016) => q(031), + q(0017) => q(044), + q(0018) => q(048), + q(0019) => q(050), + q(0020) => q(052), + q(0021) => q(112), + q(0022) => q(056), + q(0023) => q(084), + q(0024) => q(204), + q(0025) => q(060), + q(0026) => q(064), + q(0027) => q(068), + q(0028) => q(535), + q(0029) => q(070), + q(0030) => q(072), + q(0031) => q(074), + q(0032) => q(076), + q(0033) => q(086), + q(0034) => q(096), + q(0035) => q(100), + q(0036) => q(854), + q(0037) => q(108), + q(0038) => q(132), + q(0039) => q(116), + q(0040) => q(120), + q(0041) => q(124), + q(0042) => q(136), + q(0043) => q(140), + q(0044) => q(148), + q(0045) => q(152), + q(0046) => q(156), + q(0047) => q(162), + q(0048) => q(166), + q(0049) => q(170), + q(0050) => q(174), + q(0051) => q(180), + q(0052) => q(178), + q(0053) => q(184), + q(0054) => q(188), + q(0055) => q(384), + q(0056) => q(191), + q(0057) => q(192), + q(0058) => q(531), + q(0059) => q(196), + q(0060) => q(203), + q(0061) => q(208), + q(0062) => q(262), + q(0063) => q(212), + q(0064) => q(214), + q(0065) => q(218), + q(0066) => q(818), + q(0067) => q(222), + q(0068) => q(226), + q(0069) => q(232), + q(0070) => q(233), + q(0071) => q(231), + q(0072) => q(238), + q(0073) => q(234), + q(0074) => q(242), + q(0075) => q(246), + q(0076) => q(250), + q(0077) => q(254), + q(0078) => q(258), + q(0079) => q(260), + q(0080) => q(266), + q(0081) => q(270), + q(0082) => q(268), + q(0083) => q(276), + q(0084) => q(288), + q(0085) => q(292), + q(0086) => q(300), + q(0087) => q(304), + q(0088) => q(308), + q(0089) => q(312), + q(0090) => q(316), + q(0091) => q(320), + q(0092) => q(831), + q(0093) => q(324), + q(0094) => q(624), + q(0095) => q(328), + q(0096) => q(332), + q(0097) => q(334), + q(0098) => q(336), + q(0099) => q(340), + q(0100) => q(344), + q(0101) => q(348), + q(0102) => q(352), + q(0103) => q(356), + q(0104) => q(360), + q(0105) => q(364), + q(0106) => q(368), + q(0107) => q(372), + q(0108) => q(833), + q(0109) => q(376), + q(0110) => q(380), + q(0111) => q(388), + q(0112) => q(392), + q(0113) => q(832), + q(0114) => q(400), + q(0115) => q(398), + q(0116) => q(404), + q(0117) => q(296), + q(0118) => q(408), + q(0119) => q(410), + q(0120) => q(414), + q(0121) => q(417), + q(0122) => q(418), + q(0123) => q(428), + q(0124) => q(422), + q(0125) => q(426), + q(0126) => q(430), + q(0127) => q(434), + q(0128) => q(438), + q(0129) => q(440), + q(0130) => q(442), + q(0131) => q(446), + q(0132) => q(807), + q(0133) => q(450), + q(0134) => q(454), + q(0135) => q(458), + q(0136) => q(462), + q(0137) => q(466), + q(0138) => q(470), + q(0139) => q(584), + q(0140) => q(474), + q(0141) => q(478), + q(0142) => q(480), + q(0143) => q(175), + q(0144) => q(484), + q(0145) => q(583), + q(0146) => q(498), + q(0147) => q(492), + q(0148) => q(496), + q(0149) => q(499), + q(0150) => q(500), + q(0151) => q(504), + q(0152) => q(508), + q(0153) => q(104), + q(0154) => q(516), + q(0155) => q(520), + q(0156) => q(524), + q(0157) => q(528), + q(0158) => q(540), + q(0159) => q(554), + q(0160) => q(558), + q(0161) => q(562), + q(0162) => q(566), + q(0163) => q(570), + q(0164) => q(574), + q(0165) => q(580), + q(0166) => q(578), + q(0167) => q(512), + q(0168) => q(586), + q(0169) => q(585), + q(0171) => q(591), + q(0172) => q(598), + q(0173) => q(600), + q(0174) => q(604), + q(0175) => q(608), + q(0176) => q(612), + q(0177) => q(616), + q(0178) => q(620), + q(0179) => q(630), + q(0180) => q(634), + q(0181) => q(638), + q(0182) => q(642), + q(0183) => q(643), + q(0184) => q(646), + q(0185) => q(652), + q(0186) => q(654), + q(0187) => q(659), + q(0188) => q(662), + q(0189) => q(663), + q(0190) => q(666), + q(0191) => q(670), + q(0192) => q(882), + q(0193) => q(674), + q(0194) => q(678), + q(0195) => q(682), + q(0196) => q(686), + q(0197) => q(688), + q(0198) => q(690), + q(0199) => q(694), + q(0200) => q(702), + q(0201) => q(534), + q(0202) => q(703), + q(0203) => q(705), + q(0204) => q(090), + q(0205) => q(706), + q(0206) => q(710), + q(0207) => q(239), + q(0208) => q(728), + q(0209) => q(724), + q(0210) => q(144), + q(0211) => q(729), + q(0212) => q(740), + q(0214) => q(748), + q(0215) => q(752), + q(0216) => q(756), + q(0217) => q(760), + q(0218) => q(158), + q(0219) => q(762), + q(0220) => q(834), + q(0221) => q(764), + q(0222) => q(626), + q(0223) => q(768), + q(0224) => q(772), + q(0225) => q(776), + q(0226) => q(780), + q(0227) => q(788), + q(0228) => q(792), + q(0229) => q(795), + q(0230) => q(796), + q(0231) => q(798), + q(0232) => q(800), + q(0233) => q(804), + q(0234) => q(784), + q(0235) => q(826), + q(0237) => q(840), + q(0238) => q(858), + q(0239) => q(860), + q(0240) => q(548), + q(0241) => q(862), + q(0242) => q(704), + q(0243) => q(092), + q(0244) => q(850), + q(0245) => q(876), + q(0246) => q(732), + q(0247) => q(887), + q(0248) => q(894), + q(0249) => q(716), + q(0252) => q(900), + q(0253) => q(902), + q(0254) => q(903), + q(0255) => q(904), + q(0256) => q(905), + q(0257) => q(906), + q(0258) => q(907), + q(0259) => q(908), + q(0260) => q(913), + q(0261) => q(914), + q(0262) => q(915), + q(0263) => q(916), + q(0264) => q(917), + q(0265) => q(918), + q(0266) => q(919), + q(0267) => q(920), + q(0268) => q(921), + q(0269) => q(922), + q(0270) => q(923), + q(0271) => q(924), + q(0272) => q(901), + q(0273) => q(925), + q(0274) => q(926), + q(0275) => q(927), + q(0276) => q(928), + q(0277) => q(929), + q(0278) => q(930), + q(0279) => q(931), + q(0280) => q(932), + q(0281) => q(933), + q(0282) => q(934), + }, q(numeric) => { q(0001) => q(004), q(0002) => q(248), @@ -7879,6 +13992,416 @@ $Locale::Codes::Data{'country'}{'id2code'} = { q(0248) => q(894), q(0249) => q(716), }, + q(un-alpha-3) => { + q(0001) => q(AFG), + q(0002) => q(ALA), + q(0003) => q(ALB), + q(0004) => q(DZA), + q(0005) => q(ASM), + q(0006) => q(AND), + q(0007) => q(AGO), + q(0008) => q(AIA), + q(0010) => q(ATG), + q(0011) => q(ARG), + q(0012) => q(ARM), + q(0013) => q(ABW), + q(0014) => q(AUS), + q(0015) => q(AUT), + q(0016) => q(AZE), + q(0017) => q(BHS), + q(0018) => q(BHR), + q(0019) => q(BGD), + q(0020) => q(BRB), + q(0021) => q(BLR), + q(0022) => q(BEL), + q(0023) => q(BLZ), + q(0024) => q(BEN), + q(0025) => q(BMU), + q(0026) => q(BTN), + q(0027) => q(BOL), + q(0028) => q(BES), + q(0029) => q(BIH), + q(0030) => q(BWA), + q(0032) => q(BRA), + q(0034) => q(BRN), + q(0035) => q(BGR), + q(0036) => q(BFA), + q(0037) => q(BDI), + q(0038) => q(CPV), + q(0039) => q(KHM), + q(0040) => q(CMR), + q(0041) => q(CAN), + q(0042) => q(CYM), + q(0043) => q(CAF), + q(0044) => q(TCD), + q(0045) => q(CHL), + q(0046) => q(CHN), + q(0049) => q(COL), + q(0050) => q(COM), + q(0051) => q(COD), + q(0052) => q(COG), + q(0053) => q(COK), + q(0054) => q(CRI), + q(0055) => q(CIV), + q(0056) => q(HRV), + q(0057) => q(CUB), + q(0058) => q(CUW), + q(0059) => q(CYP), + q(0060) => q(CZE), + q(0061) => q(DNK), + q(0062) => q(DJI), + q(0063) => q(DMA), + q(0064) => q(DOM), + q(0065) => q(ECU), + q(0066) => q(EGY), + q(0067) => q(SLV), + q(0068) => q(GNQ), + q(0069) => q(ERI), + q(0070) => q(EST), + q(0071) => q(ETH), + q(0072) => q(FLK), + q(0073) => q(FRO), + q(0074) => q(FJI), + q(0075) => q(FIN), + q(0076) => q(FRA), + q(0077) => q(GUF), + q(0078) => q(PYF), + q(0080) => q(GAB), + q(0081) => q(GMB), + q(0082) => q(GEO), + q(0083) => q(DEU), + q(0084) => q(GHA), + q(0085) => q(GIB), + q(0086) => q(GRC), + q(0087) => q(GRL), + q(0088) => q(GRD), + q(0089) => q(GLP), + q(0090) => q(GUM), + q(0091) => q(GTM), + q(0092) => q(GGY), + q(0093) => q(GIN), + q(0094) => q(GNB), + q(0095) => q(GUY), + q(0096) => q(HTI), + q(0098) => q(VAT), + q(0099) => q(HND), + q(0100) => q(HKG), + q(0101) => q(HUN), + q(0102) => q(ISL), + q(0103) => q(IND), + q(0104) => q(IDN), + q(0105) => q(IRN), + q(0106) => q(IRQ), + q(0107) => q(IRL), + q(0108) => q(IMN), + q(0109) => q(ISR), + q(0110) => q(ITA), + q(0111) => q(JAM), + q(0112) => q(JPN), + q(0113) => q(JEY), + q(0114) => q(JOR), + q(0115) => q(KAZ), + q(0116) => q(KEN), + q(0117) => q(KIR), + q(0118) => q(PRK), + q(0119) => q(KOR), + q(0120) => q(KWT), + q(0121) => q(KGZ), + q(0122) => q(LAO), + q(0123) => q(LVA), + q(0124) => q(LBN), + q(0125) => q(LSO), + q(0126) => q(LBR), + q(0127) => q(LBY), + q(0128) => q(LIE), + q(0129) => q(LTU), + q(0130) => q(LUX), + q(0131) => q(MAC), + q(0133) => q(MDG), + q(0134) => q(MWI), + q(0135) => q(MYS), + q(0136) => q(MDV), + q(0137) => q(MLI), + q(0138) => q(MLT), + q(0139) => q(MHL), + q(0140) => q(MTQ), + q(0141) => q(MRT), + q(0142) => q(MUS), + q(0143) => q(MYT), + q(0144) => q(MEX), + q(0145) => q(FSM), + q(0146) => q(MDA), + q(0147) => q(MCO), + q(0148) => q(MNG), + q(0149) => q(MNE), + q(0150) => q(MSR), + q(0151) => q(MAR), + q(0152) => q(MOZ), + q(0153) => q(MMR), + q(0154) => q(NAM), + q(0155) => q(NRU), + q(0156) => q(NPL), + q(0157) => q(NLD), + q(0158) => q(NCL), + q(0159) => q(NZL), + q(0160) => q(NIC), + q(0161) => q(NER), + q(0162) => q(NGA), + q(0163) => q(NIU), + q(0164) => q(NFK), + q(0165) => q(MNP), + q(0166) => q(NOR), + q(0167) => q(OMN), + q(0168) => q(PAK), + q(0169) => q(PLW), + q(0170) => q(PSE), + q(0171) => q(PAN), + q(0172) => q(PNG), + q(0173) => q(PRY), + q(0174) => q(PER), + q(0175) => q(PHL), + q(0176) => q(PCN), + q(0177) => q(POL), + q(0178) => q(PRT), + q(0179) => q(PRI), + q(0180) => q(QAT), + q(0181) => q(REU), + q(0182) => q(ROU), + q(0183) => q(RUS), + q(0184) => q(RWA), + q(0185) => q(BLM), + q(0186) => q(SHN), + q(0187) => q(KNA), + q(0188) => q(LCA), + q(0189) => q(MAF), + q(0190) => q(SPM), + q(0191) => q(VCT), + q(0192) => q(WSM), + q(0193) => q(SMR), + q(0194) => q(STP), + q(0195) => q(SAU), + q(0196) => q(SEN), + q(0197) => q(SRB), + q(0198) => q(SYC), + q(0199) => q(SLE), + q(0200) => q(SGP), + q(0201) => q(SXM), + q(0202) => q(SVK), + q(0203) => q(SVN), + q(0204) => q(SLB), + q(0205) => q(SOM), + q(0206) => q(ZAF), + q(0208) => q(SSD), + q(0209) => q(ESP), + q(0210) => q(LKA), + q(0243) => q(VGB), + }, + q(un-numeric) => { + q(0001) => q(004), + q(0002) => q(248), + q(0003) => q(008), + q(0004) => q(012), + q(0005) => q(016), + q(0006) => q(020), + q(0007) => q(024), + q(0008) => q(660), + q(0010) => q(028), + q(0011) => q(032), + q(0012) => q(051), + q(0013) => q(533), + q(0014) => q(036), + q(0015) => q(040), + q(0016) => q(031), + q(0017) => q(044), + q(0018) => q(048), + q(0019) => q(050), + q(0020) => q(052), + q(0021) => q(112), + q(0022) => q(056), + q(0023) => q(084), + q(0024) => q(204), + q(0025) => q(060), + q(0026) => q(064), + q(0027) => q(068), + q(0028) => q(535), + q(0029) => q(070), + q(0030) => q(072), + q(0032) => q(076), + q(0034) => q(096), + q(0035) => q(100), + q(0036) => q(854), + q(0037) => q(108), + q(0038) => q(132), + q(0039) => q(116), + q(0040) => q(120), + q(0041) => q(124), + q(0042) => q(136), + q(0043) => q(140), + q(0044) => q(148), + q(0045) => q(152), + q(0046) => q(156), + q(0049) => q(170), + q(0050) => q(174), + q(0051) => q(180), + q(0052) => q(178), + q(0053) => q(184), + q(0054) => q(188), + q(0055) => q(384), + q(0056) => q(191), + q(0057) => q(192), + q(0058) => q(531), + q(0059) => q(196), + q(0060) => q(203), + q(0061) => q(208), + q(0062) => q(262), + q(0063) => q(212), + q(0064) => q(214), + q(0065) => q(218), + q(0066) => q(818), + q(0067) => q(222), + q(0068) => q(226), + q(0069) => q(232), + q(0070) => q(233), + q(0071) => q(231), + q(0072) => q(238), + q(0073) => q(234), + q(0074) => q(242), + q(0075) => q(246), + q(0076) => q(250), + q(0077) => q(254), + q(0078) => q(258), + q(0080) => q(266), + q(0081) => q(270), + q(0082) => q(268), + q(0083) => q(276), + q(0084) => q(288), + q(0085) => q(292), + q(0086) => q(300), + q(0087) => q(304), + q(0088) => q(308), + q(0089) => q(312), + q(0090) => q(316), + q(0091) => q(320), + q(0092) => q(831), + q(0093) => q(324), + q(0094) => q(624), + q(0095) => q(328), + q(0096) => q(332), + q(0098) => q(336), + q(0099) => q(340), + q(0100) => q(344), + q(0101) => q(348), + q(0102) => q(352), + q(0103) => q(356), + q(0104) => q(360), + q(0105) => q(364), + q(0106) => q(368), + q(0107) => q(372), + q(0108) => q(833), + q(0109) => q(376), + q(0110) => q(380), + q(0111) => q(388), + q(0112) => q(392), + q(0113) => q(832), + q(0114) => q(400), + q(0115) => q(398), + q(0116) => q(404), + q(0117) => q(296), + q(0118) => q(408), + q(0119) => q(410), + q(0120) => q(414), + q(0121) => q(417), + q(0122) => q(418), + q(0123) => q(428), + q(0124) => q(422), + q(0125) => q(426), + q(0126) => q(430), + q(0127) => q(434), + q(0128) => q(438), + q(0129) => q(440), + q(0130) => q(442), + q(0131) => q(446), + q(0133) => q(450), + q(0134) => q(454), + q(0135) => q(458), + q(0136) => q(462), + q(0137) => q(466), + q(0138) => q(470), + q(0139) => q(584), + q(0140) => q(474), + q(0141) => q(478), + q(0142) => q(480), + q(0143) => q(175), + q(0144) => q(484), + q(0145) => q(583), + q(0146) => q(498), + q(0147) => q(492), + q(0148) => q(496), + q(0149) => q(499), + q(0150) => q(500), + q(0151) => q(504), + q(0152) => q(508), + q(0153) => q(104), + q(0154) => q(516), + q(0155) => q(520), + q(0156) => q(524), + q(0157) => q(528), + q(0158) => q(540), + q(0159) => q(554), + q(0160) => q(558), + q(0161) => q(562), + q(0162) => q(566), + q(0163) => q(570), + q(0164) => q(574), + q(0165) => q(580), + q(0166) => q(578), + q(0167) => q(512), + q(0168) => q(586), + q(0169) => q(585), + q(0170) => q(275), + q(0171) => q(591), + q(0172) => q(598), + q(0173) => q(600), + q(0174) => q(604), + q(0175) => q(608), + q(0176) => q(612), + q(0177) => q(616), + q(0178) => q(620), + q(0179) => q(630), + q(0180) => q(634), + q(0181) => q(638), + q(0182) => q(642), + q(0183) => q(643), + q(0184) => q(646), + q(0185) => q(652), + q(0186) => q(654), + q(0187) => q(659), + q(0188) => q(662), + q(0189) => q(663), + q(0190) => q(666), + q(0191) => q(670), + q(0192) => q(882), + q(0193) => q(674), + q(0194) => q(678), + q(0195) => q(682), + q(0196) => q(686), + q(0197) => q(688), + q(0198) => q(690), + q(0199) => q(694), + q(0200) => q(702), + q(0201) => q(534), + q(0202) => q(703), + q(0203) => q(705), + q(0204) => q(090), + q(0205) => q(706), + q(0206) => q(710), + q(0208) => q(728), + q(0209) => q(724), + q(0210) => q(144), + q(0243) => q(092), + q(0250) => q(830), + q(0251) => q(680), + }, }; 1; diff --git a/cpan/Locale-Codes/lib/Locale/Codes/Country_Retired.pm b/cpan/Locale-Codes/lib/Locale/Codes/Country_Retired.pm index d073bbe..488519c 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/Country_Retired.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes/Country_Retired.pm @@ -3,7 +3,7 @@ Locale::Codes::Country_Retired; # This file was automatically generated. Any changes to this file will # be lost the next time 'deprecate_codes' is run. -# Generated on: Wed Mar 2 09:26:23 EST 2016 +# Generated on: Tue May 31 09:21:49 EDT 2016 use strict; require 5.006; @@ -11,7 +11,7 @@ use warnings; use utf8; our($VERSION); -$VERSION='3.38'; +$VERSION='3.39'; $Locale::Codes::Retired{'country'}{'alpha-2'}{'code'} = { q(an) => q(Netherlands Antilles), @@ -308,6 +308,15 @@ $Locale::Codes::Retired{'country'}{'dom'}{'code'} = { q(uk) => q(United Kingdom), }; +$Locale::Codes::Retired{'country'}{'genc-alpha-2'}{'code'} = { +}; + +$Locale::Codes::Retired{'country'}{'genc-alpha-3'}{'code'} = { +}; + +$Locale::Codes::Retired{'country'}{'genc-numeric'}{'code'} = { +}; + $Locale::Codes::Retired{'country'}{'numeric'}{'code'} = { q(010) => q(Antarctica), q(074) => q(Bouvet Island), @@ -327,6 +336,12 @@ $Locale::Codes::Retired{'country'}{'numeric'}{'code'} = { q(891) => q(Serbia and Montenegro), }; +$Locale::Codes::Retired{'country'}{'un-alpha-3'}{'code'} = { +}; + +$Locale::Codes::Retired{'country'}{'un-numeric'}{'code'} = { +}; + $Locale::Codes::Retired{'country'}{'alpha-2'}{'name'} = { q(bolivia) => [ q(bo), q(Bolivia) ], q(bolivia, plurinational state of) => [ q(bo), q(Bolivia, Plurinational State of) ], @@ -498,6 +513,15 @@ $Locale::Codes::Retired{'country'}{'dom'}{'name'} = { q(yugoslavia ) => [ q(YU), q(Yugoslavia ) ], }; +$Locale::Codes::Retired{'country'}{'genc-alpha-2'}{'name'} = { +}; + +$Locale::Codes::Retired{'country'}{'genc-alpha-3'}{'name'} = { +}; + +$Locale::Codes::Retired{'country'}{'genc-numeric'}{'name'} = { +}; + $Locale::Codes::Retired{'country'}{'numeric'}{'name'} = { q(antarctica) => [ q(010), q(Antarctica) ], q(bolivia) => [ q(068), q(Bolivia) ], @@ -582,5 +606,11 @@ $Locale::Codes::Retired{'country'}{'numeric'}{'name'} = { q(zaire) => [ q(180), q(Zaire) ], }; +$Locale::Codes::Retired{'country'}{'un-alpha-3'}{'name'} = { +}; + +$Locale::Codes::Retired{'country'}{'un-numeric'}{'name'} = { +}; + 1; diff --git a/cpan/Locale-Codes/lib/Locale/Codes/Currency.pm b/cpan/Locale-Codes/lib/Locale/Codes/Currency.pm index 555a7c0..f5c7a10 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/Currency.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes/Currency.pm @@ -22,7 +22,7 @@ use Locale::Codes::Currency_Retired; our($VERSION,@ISA,@EXPORT,@EXPORT_OK); -$VERSION='3.38'; +$VERSION='3.39'; @ISA = qw(Exporter); @EXPORT = qw(code2currency currency2code diff --git a/cpan/Locale-Codes/lib/Locale/Codes/Currency_Codes.pm b/cpan/Locale-Codes/lib/Locale/Codes/Currency_Codes.pm index 70011a5..a04ff44 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/Currency_Codes.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes/Currency_Codes.pm @@ -3,7 +3,7 @@ Locale::Codes::Currency_Codes; # This file was automatically generated. Any changes to this file will # be lost the next time 'harvest_data' is run. -# Generated on: Wed Mar 2 09:20:52 EST 2016 +# Generated on: Tue May 24 14:46:57 EDT 2016 use strict; require 5.006; @@ -11,7 +11,7 @@ use warnings; use utf8; our($VERSION); -$VERSION='3.38'; +$VERSION='3.39'; $Locale::Codes::Data{'currency'}{'id'} = '0177'; diff --git a/cpan/Locale-Codes/lib/Locale/Codes/Currency_Retired.pm b/cpan/Locale-Codes/lib/Locale/Codes/Currency_Retired.pm index 447c3a6..6658c82 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/Currency_Retired.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes/Currency_Retired.pm @@ -3,7 +3,7 @@ Locale::Codes::Currency_Retired; # This file was automatically generated. Any changes to this file will # be lost the next time 'deprecate_codes' is run. -# Generated on: Wed Mar 2 09:26:23 EST 2016 +# Generated on: Tue May 31 09:21:49 EDT 2016 use strict; require 5.006; @@ -11,7 +11,7 @@ use warnings; use utf8; our($VERSION); -$VERSION='3.38'; +$VERSION='3.39'; $Locale::Codes::Retired{'currency'}{'alpha'}{'code'} = { q(ADP) => q(Andorran Peseta), diff --git a/cpan/Locale-Codes/lib/Locale/Codes/LangExt.pm b/cpan/Locale-Codes/lib/Locale/Codes/LangExt.pm index bf7d97b..5859729 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/LangExt.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes/LangExt.pm @@ -20,7 +20,7 @@ use Locale::Codes::LangExt_Retired; our($VERSION,@ISA,@EXPORT,@EXPORT_OK); -$VERSION='3.38'; +$VERSION='3.39'; @ISA = qw(Exporter); @EXPORT = qw(code2langext langext2code diff --git a/cpan/Locale-Codes/lib/Locale/Codes/LangExt_Codes.pm b/cpan/Locale-Codes/lib/Locale/Codes/LangExt_Codes.pm index 86c78b1..e14832f 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/LangExt_Codes.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes/LangExt_Codes.pm @@ -3,7 +3,7 @@ Locale::Codes::LangExt_Codes; # This file was automatically generated. Any changes to this file will # be lost the next time 'harvest_data' is run. -# Generated on: Wed Mar 2 09:24:09 EST 2016 +# Generated on: Tue May 24 14:47:11 EDT 2016 use strict; require 5.006; @@ -11,7 +11,7 @@ use warnings; use utf8; our($VERSION); -$VERSION='3.38'; +$VERSION='3.39'; $Locale::Codes::Data{'langext'}{'id'} = '0230'; diff --git a/cpan/Locale-Codes/lib/Locale/Codes/LangExt_Retired.pm b/cpan/Locale-Codes/lib/Locale/Codes/LangExt_Retired.pm index c9e0502..6601024 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/LangExt_Retired.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes/LangExt_Retired.pm @@ -3,7 +3,7 @@ Locale::Codes::LangExt_Retired; # This file was automatically generated. Any changes to this file will # be lost the next time 'deprecate_codes' is run. -# Generated on: Wed Mar 2 09:26:23 EST 2016 +# Generated on: Tue May 31 09:21:49 EDT 2016 use strict; require 5.006; @@ -11,7 +11,7 @@ use warnings; use utf8; our($VERSION); -$VERSION='3.38'; +$VERSION='3.39'; $Locale::Codes::Retired{'langext'}{'alpha'}{'code'} = { q(yds) => q(Yiddish Sign Language), diff --git a/cpan/Locale-Codes/lib/Locale/Codes/LangFam.pm b/cpan/Locale-Codes/lib/Locale/Codes/LangFam.pm index b3b96c1..33c69d0 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/LangFam.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes/LangFam.pm @@ -20,7 +20,7 @@ use Locale::Codes::LangFam_Retired; our($VERSION,@ISA,@EXPORT,@EXPORT_OK); -$VERSION='3.38'; +$VERSION='3.39'; @ISA = qw(Exporter); @EXPORT = qw(code2langfam langfam2code diff --git a/cpan/Locale-Codes/lib/Locale/Codes/LangFam_Codes.pm b/cpan/Locale-Codes/lib/Locale/Codes/LangFam_Codes.pm index d1d1946..9540a61 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/LangFam_Codes.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes/LangFam_Codes.pm @@ -3,7 +3,7 @@ Locale::Codes::LangFam_Codes; # This file was automatically generated. Any changes to this file will # be lost the next time 'harvest_data' is run. -# Generated on: Wed Mar 2 09:24:18 EST 2016 +# Generated on: Tue May 24 14:47:19 EDT 2016 use strict; require 5.006; @@ -11,7 +11,7 @@ use warnings; use utf8; our($VERSION); -$VERSION='3.38'; +$VERSION='3.39'; $Locale::Codes::Data{'langfam'}{'id'} = '0116'; diff --git a/cpan/Locale-Codes/lib/Locale/Codes/LangFam_Retired.pm b/cpan/Locale-Codes/lib/Locale/Codes/LangFam_Retired.pm index eddff37..aacea25 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/LangFam_Retired.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes/LangFam_Retired.pm @@ -10,7 +10,7 @@ use warnings; require 5.002; our($VERSION); -$VERSION='3.38'; +$VERSION='3.39'; $Locale::Codes::Retired{'langfam'}{'alpha'}{'code'} = { }; diff --git a/cpan/Locale-Codes/lib/Locale/Codes/LangVar.pm b/cpan/Locale-Codes/lib/Locale/Codes/LangVar.pm index eb00999..4dc4125 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/LangVar.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes/LangVar.pm @@ -20,7 +20,7 @@ use Locale::Codes::LangVar_Retired; our($VERSION,@ISA,@EXPORT,@EXPORT_OK); -$VERSION='3.38'; +$VERSION='3.39'; @ISA = qw(Exporter); @EXPORT = qw(code2langvar langvar2code diff --git a/cpan/Locale-Codes/lib/Locale/Codes/LangVar_Codes.pm b/cpan/Locale-Codes/lib/Locale/Codes/LangVar_Codes.pm index 89528c1..4af74bc 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/LangVar_Codes.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes/LangVar_Codes.pm @@ -3,7 +3,7 @@ Locale::Codes::LangVar_Codes; # This file was automatically generated. Any changes to this file will # be lost the next time 'harvest_data' is run. -# Generated on: Wed Mar 2 09:24:14 EST 2016 +# Generated on: Tue May 24 14:47:17 EDT 2016 use strict; require 5.006; @@ -11,7 +11,7 @@ use warnings; use utf8; our($VERSION); -$VERSION='3.38'; +$VERSION='3.39'; $Locale::Codes::Data{'langvar'}{'id'} = '0076'; diff --git a/cpan/Locale-Codes/lib/Locale/Codes/LangVar_Retired.pm b/cpan/Locale-Codes/lib/Locale/Codes/LangVar_Retired.pm index 1a7ff1c..56eb7be 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/LangVar_Retired.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes/LangVar_Retired.pm @@ -3,7 +3,7 @@ Locale::Codes::LangVar_Retired; # This file was automatically generated. Any changes to this file will # be lost the next time 'deprecate_codes' is run. -# Generated on: Wed Mar 2 09:26:23 EST 2016 +# Generated on: Tue May 31 09:21:49 EDT 2016 use strict; require 5.006; @@ -11,7 +11,7 @@ use warnings; use utf8; our($VERSION); -$VERSION='3.38'; +$VERSION='3.39'; $Locale::Codes::Retired{'langvar'}{'alpha'}{'code'} = { }; diff --git a/cpan/Locale-Codes/lib/Locale/Codes/Language.pm b/cpan/Locale-Codes/lib/Locale/Codes/Language.pm index 5838107..1037400 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/Language.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes/Language.pm @@ -22,7 +22,7 @@ use Locale::Codes::Language_Retired; our($VERSION,@ISA,@EXPORT,@EXPORT_OK); -$VERSION='3.38'; +$VERSION='3.39'; @ISA = qw(Exporter); @EXPORT = qw(code2language language2code diff --git a/cpan/Locale-Codes/lib/Locale/Codes/Language_Codes.pm b/cpan/Locale-Codes/lib/Locale/Codes/Language_Codes.pm index 13f8bfe..fec5b05 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/Language_Codes.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes/Language_Codes.pm @@ -3,7 +3,7 @@ Locale::Codes::Language_Codes; # This file was automatically generated. Any changes to this file will # be lost the next time 'harvest_data' is run. -# Generated on: Wed Mar 2 08:58:07 EST 2016 +# Generated on: Tue May 24 14:46:48 EDT 2016 use strict; require 5.006; @@ -11,7 +11,7 @@ use warnings; use utf8; our($VERSION); -$VERSION='3.38'; +$VERSION='3.39'; $Locale::Codes::Data{'language'}{'id'} = '7976'; diff --git a/cpan/Locale-Codes/lib/Locale/Codes/Language_Retired.pm b/cpan/Locale-Codes/lib/Locale/Codes/Language_Retired.pm index c3c8699..683041f 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/Language_Retired.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes/Language_Retired.pm @@ -3,7 +3,7 @@ Locale::Codes::Language_Retired; # This file was automatically generated. Any changes to this file will # be lost the next time 'deprecate_codes' is run. -# Generated on: Wed Mar 2 09:26:23 EST 2016 +# Generated on: Tue May 31 09:21:49 EDT 2016 use strict; require 5.006; @@ -11,7 +11,7 @@ use warnings; use utf8; our($VERSION); -$VERSION='3.38'; +$VERSION='3.39'; $Locale::Codes::Retired{'language'}{'alpha-2'}{'code'} = { q(in) => q(Indonesian), diff --git a/cpan/Locale-Codes/lib/Locale/Codes/Script.pm b/cpan/Locale-Codes/lib/Locale/Codes/Script.pm index c174397..993e5b3 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/Script.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes/Script.pm @@ -22,7 +22,7 @@ use Locale::Codes::Script_Retired; our($VERSION,@ISA,@EXPORT,@EXPORT_OK); -$VERSION='3.38'; +$VERSION='3.39'; @ISA = qw(Exporter); @EXPORT = qw(code2script script2code diff --git a/cpan/Locale-Codes/lib/Locale/Codes/Script_Codes.pm b/cpan/Locale-Codes/lib/Locale/Codes/Script_Codes.pm index f0d4766..7006612 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/Script_Codes.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes/Script_Codes.pm @@ -3,7 +3,7 @@ Locale::Codes::Script_Codes; # This file was automatically generated. Any changes to this file will # be lost the next time 'harvest_data' is run. -# Generated on: Wed Mar 2 09:24:01 EST 2016 +# Generated on: Tue May 24 14:47:06 EDT 2016 use strict; require 5.006; @@ -11,7 +11,7 @@ use warnings; use utf8; our($VERSION); -$VERSION='3.38'; +$VERSION='3.39'; $Locale::Codes::Data{'script'}{'id'} = '0180'; diff --git a/cpan/Locale-Codes/lib/Locale/Codes/Script_Retired.pm b/cpan/Locale-Codes/lib/Locale/Codes/Script_Retired.pm index 29e3293..14c6eec 100644 --- a/cpan/Locale-Codes/lib/Locale/Codes/Script_Retired.pm +++ b/cpan/Locale-Codes/lib/Locale/Codes/Script_Retired.pm @@ -3,7 +3,7 @@ Locale::Codes::Script_Retired; # This file was automatically generated. Any changes to this file will # be lost the next time 'deprecate_codes' is run. -# Generated on: Wed Mar 2 09:26:23 EST 2016 +# Generated on: Tue May 31 09:21:49 EDT 2016 use strict; require 5.006; @@ -11,7 +11,7 @@ use warnings; use utf8; our($VERSION); -$VERSION='3.38'; +$VERSION='3.39'; $Locale::Codes::Retired{'script'}{'alpha'}{'code'} = { }; diff --git a/cpan/Locale-Codes/lib/Locale/Country.pm b/cpan/Locale-Codes/lib/Locale/Country.pm index 16aa45b..3ab13a3 100644 --- a/cpan/Locale-Codes/lib/Locale/Country.pm +++ b/cpan/Locale-Codes/lib/Locale/Country.pm @@ -10,7 +10,7 @@ use warnings; use Exporter; our $VERSION; -$VERSION='3.38'; +$VERSION='3.39'; our (@ISA,@EXPORT); diff --git a/cpan/Locale-Codes/lib/Locale/Country.pod b/cpan/Locale-Codes/lib/Locale/Country.pod index 300adcd..e21726f 100644 --- a/cpan/Locale-Codes/lib/Locale/Country.pod +++ b/cpan/Locale-Codes/lib/Locale/Country.pod @@ -70,6 +70,23 @@ The IANA is responsible for delegating management of the top level country domains. The country domains are the two-letter (lowercase) codes from ISO 3166 with a few other additions. +=item B + +=item B + +The UN maintains a list of codes that is similar, but not identical, to the +standard ISO 3166 lists. They maintain a 3-letter code (similar to alpha-3) +and a numeric code (similar to numeric). + +=item B + +=item B + +=item B + +The GENC codes are the US Government codes that replace the FIPS-11 codes. +They are based on, but not identical to the standard ISO 3166 lists. + =back NOTE: As of version 3.27, the FIPS code set is no longer supported. See the @@ -143,12 +160,15 @@ Official source of the top-level domain names. =item L -The source of the official ISO 3166-1 three-letter codes and -three-digit codes. +The source of the UN codes. + +Previously, this table was treated as a source of the ISO 3166 data, +but I found that the table was incomplete, so I stopped using it. +Later, it was added back in as it's own list of codes. + +=item L -For some reason, this table is incomplete! Several countries are -missing from it, and I cannot find them anywhere on the UN site. I -no longer use this as a source of data. +The source of the GENC codes. =item L diff --git a/cpan/Locale-Codes/lib/Locale/Currency.pm b/cpan/Locale-Codes/lib/Locale/Currency.pm index 1594122..ddf50dd 100644 --- a/cpan/Locale-Codes/lib/Locale/Currency.pm +++ b/cpan/Locale-Codes/lib/Locale/Currency.pm @@ -10,7 +10,7 @@ use warnings; use Exporter; our $VERSION; -$VERSION='3.38'; +$VERSION='3.39'; our (@ISA,@EXPORT); diff --git a/cpan/Locale-Codes/lib/Locale/Language.pm b/cpan/Locale-Codes/lib/Locale/Language.pm index 685c5d2..78760a8 100644 --- a/cpan/Locale-Codes/lib/Locale/Language.pm +++ b/cpan/Locale-Codes/lib/Locale/Language.pm @@ -10,7 +10,7 @@ use warnings; use Exporter; our $VERSION; -$VERSION='3.38'; +$VERSION='3.39'; our (@ISA,@EXPORT); diff --git a/cpan/Locale-Codes/lib/Locale/Script.pm b/cpan/Locale-Codes/lib/Locale/Script.pm index 9ff2210..870540a 100644 --- a/cpan/Locale-Codes/lib/Locale/Script.pm +++ b/cpan/Locale-Codes/lib/Locale/Script.pm @@ -10,7 +10,7 @@ use warnings; use Exporter; our $VERSION; -$VERSION='3.38'; +$VERSION='3.39'; our (@ISA,@EXPORT); diff --git a/cpan/Pod-Checker/lib/Pod/Checker.pm b/cpan/Pod-Checker/lib/Pod/Checker.pm index ba47e6f..0d18aae 100644 --- a/cpan/Pod-Checker/lib/Pod/Checker.pm +++ b/cpan/Pod-Checker/lib/Pod/Checker.pm @@ -1,1330 +1,1090 @@ -############################################################################# -# Pod/Checker.pm -- check pod documents for syntax errors -# -# Copyright (C) 1994-2000 by Bradford Appleton. All rights reserved. -# This file is part of "PodParser". PodParser is free software; -# you can redistribute it and/or modify it under the same terms -# as Perl itself. -############################################################################# - -package Pod::Checker; -use strict; - -use vars qw($VERSION @ISA @EXPORT %VALID_COMMANDS %VALID_SEQUENCES); -$VERSION = '1.60'; ## Current version of this package -require 5.005; ## requires this Perl version or later - -use Pod::ParseUtils; ## for hyperlinks and lists - -=head1 NAME - -Pod::Checker, podchecker() - check pod documents for syntax errors - -=head1 SYNOPSIS - - use Pod::Checker; - - $num_errors = podchecker($filepath, $outputpath, %options); - - my $checker = new Pod::Checker %options; - $checker->parse_from_file($filepath, \*STDERR); - -=head1 OPTIONS/ARGUMENTS - -C<$filepath> is the input POD to read and C<$outputpath> is -where to write POD syntax error messages. Either argument may be a scalar -indicating a file-path, or else a reference to an open filehandle. -If unspecified, the input-file it defaults to C<\*STDIN>, and -the output-file defaults to C<\*STDERR>. - -=head2 podchecker() - -This function can take a hash of options: - -=over 4 - -=item B<-warnings> =E I - -Turn warnings on/off. I is usually 1 for on, but higher values -trigger additional warnings. See L<"Warnings">. - -=back - -=head1 DESCRIPTION - -B will perform syntax checking of Perl5 POD format documentation. - -Curious/ambitious users are welcome to propose additional features they wish -to see in B and B and verify that the checks are -consistent with L. - -The following checks are currently performed: - -=over 4 - -=item * - -Unknown '=xxxx' commands, unknown 'XE...E' interior-sequences, -and unterminated interior sequences. - -=item * - -Check for proper balancing of C<=begin> and C<=end>. The contents of such -a block are generally ignored, i.e. no syntax checks are performed. - -=item * - -Check for proper nesting and balancing of C<=over>, C<=item> and C<=back>. - -=item * - -Check for same nested interior-sequences (e.g. -C...LE...E...E>). - -=item * - -Check for malformed or non-existing entities C...E>. - -=item * - -Check for correct syntax of hyperlinks C...E>. See L -for details. - -=item * - -Check for unresolved document-internal links. This check may also reveal -misspelled links that seem to be internal links but should be links -to something else. - -=back - -=head1 DIAGNOSTICS - -=head2 Errors - -=over 4 - -=item * empty =headn - -A heading (C<=head1> or C<=head2>) without any text? That ain't no -heading! - -=item * =over on line I without closing =back - -The C<=over> command does not have a corresponding C<=back> before the -next heading (C<=head1> or C<=head2>) or the end of the file. - -=item * =item without previous =over - -=item * =back without previous =over - -An C<=item> or C<=back> command has been found outside a -C<=over>/C<=back> block. - -=item * No argument for =begin - -A C<=begin> command was found that is not followed by the formatter -specification. - -=item * =end without =begin - -A standalone C<=end> command was found. - -=item * Nested =begin's - -There were at least two consecutive C<=begin> commands without -the corresponding C<=end>. Only one C<=begin> may be active at -a time. - -=item * =for without formatter specification - -There is no specification of the formatter after the C<=for> command. - -=item * Apparent command =foo not preceded by blank line - -A command which has ended up in the middle of a paragraph or other command, -such as - - =item one - =item two <-- bad - -=item * unresolved internal link I - -The given link to I does not have a matching node in the current -POD. This also happened when a single word node name is not enclosed in -C<"">. - -=item * Unknown command "I" - -An invalid POD command has been found. Valid are C<=head1>, C<=head2>, -C<=head3>, C<=head4>, C<=over>, C<=item>, C<=back>, C<=begin>, C<=end>, -C<=for>, C<=pod>, C<=cut> - -=item * Unknown interior-sequence "I" - -An invalid markup command has been encountered. Valid are: -CE>, CE>, CE>, CE>, -CE>, CE>, CE>, CE>, -CE> - -=item * nested commands IE...IE...E...E - -Two nested identical markup commands have been found. Generally this -does not make sense. - -=item * garbled entity I - -The I found cannot be interpreted as a character entity. - -=item * Entity number out of range - -An entity specified by number (dec, hex, oct) is out of range (1-255). - -=item * malformed link LEE - -The link found cannot be parsed because it does not conform to the -syntax described in L. - -=item * nonempty ZEE - -The CE> sequence is supposed to be empty. - -=item * empty XEE - -The index entry specified contains nothing but whitespace. - -=item * Spurious text after =pod / =cut - -The commands C<=pod> and C<=cut> do not take any arguments. - -=item * Spurious =cut command - -A C<=cut> command was found without a preceding POD paragraph. - -=item * Spurious =pod command - -A C<=pod> command was found after a preceding POD paragraph. - -=item * Spurious character(s) after =back - -The C<=back> command does not take any arguments. - -=back - -=head2 Warnings - -These may not necessarily cause trouble, but indicate mediocre style. - -=over 4 - -=item * multiple occurrence of link target I - -The POD file has some C<=item> and/or C<=head> commands that have -the same text. Potential hyperlinks to such a text cannot be unique then. -This warning is printed only with warning level greater than one. - -=item * line containing nothing but whitespace in paragraph - -There is some whitespace on a seemingly empty line. POD is very sensitive -to such things, so this is flagged. B users switch on the B -option to avoid this problem. - -=begin _disabled_ - -=item * file does not start with =head - -The file starts with a different POD directive than head. -This is most probably something you do not want. - -=end _disabled_ - -=item * previous =item has no contents - -There is a list C<=item> right above the flagged line that has no -text contents. You probably want to delete empty items. - -=item * preceding non-item paragraph(s) - -A list introduced by C<=over> starts with a text or verbatim paragraph, -but continues with C<=item>s. Move the non-item paragraph out of the -C<=over>/C<=back> block. - -=item * =item type mismatch (I vs. I) - -A list started with e.g. a bullet-like C<=item> and continued with a -numbered one. This is obviously inconsistent. For most translators the -type of the I C<=item> determines the type of the list. - -=item * I unescaped CE> in paragraph - -Angle brackets not written as CltE> and CgtE> -can potentially cause errors as they could be misinterpreted as -markup commands. This is only printed when the -warnings level is -greater than 1. - -=item * Unknown entity - -A character entity was found that does not belong to the standard -ISO set or the POD specials C and C. - -=item * No items in =over - -The list opened with C<=over> does not contain any items. - -=item * No argument for =item - -C<=item> without any parameters is deprecated. It should either be followed -by C<*> to indicate an unordered list, by a number (optionally followed -by a dot) to indicate an ordered (numbered) list or simple text for a -definition list. - -=item * empty section in previous paragraph - -The previous section (introduced by a C<=head> command) does not contain -any text. This usually indicates that something is missing. Note: A -C<=head1> followed immediately by C<=head2> does not trigger this warning. - -=item * Verbatim paragraph in NAME section - -The NAME section (C<=head1 NAME>) should consist of a single paragraph -with the script/module name, followed by a dash `-' and a very short -description of what the thing is good for. - -=item * =headI without preceding higher level - -For example if there is a C<=head2> in the POD file prior to a -C<=head1>. - -=back - -=head2 Hyperlinks - -There are some warnings with respect to malformed hyperlinks: - -=over 4 - -=item * ignoring leading/trailing whitespace in link - -There is whitespace at the beginning or the end of the contents of -LE...E. - -=item * (section) in '$page' deprecated - -There is a section detected in the page name of LE...E, e.g. -Cpasswd(2)E>. POD hyperlinks may point to POD documents only. -Please write Cpasswd(2)E> instead. Some formatters are able -to expand this to appropriate code. For links to (builtin) functions, -please say Cperlfunc/mkdirE>, without (). - -=item * alternative text/node '%s' contains non-escaped | or / - -The characters C<|> and C are special in the LE...E context. -Although the hyperlink parser does its best to determine which "/" is -text and which is a delimiter in case of doubt, one ought to escape -these literal characters like this: - - / E - | E - -=back - -=head1 RETURN VALUE - -B returns the number of POD syntax errors found or -1 if -there were no POD commands at all found in the file. - -=head1 EXAMPLES - -See L - -=head1 INTERFACE - -While checking, this module collects document properties, e.g. the nodes -for hyperlinks (C<=headX>, C<=item>) and index entries (CE>). -POD translators can use this feature to syntax-check and get the nodes in -a first pass before actually starting to convert. This is expensive in terms -of execution time, but allows for very robust conversions. - -Since PodParser-1.24 the B module uses only the B -method to print errors and warnings. The summary output (e.g. -"Pod syntax OK") has been dropped from the module and has been included in -B (the script). This allows users of B to -control completely the output behavior. Users of B (the script) -get the well-known behavior. - -=cut - -############################################################################# - -#use diagnostics; -use Carp qw(croak); -use Exporter; -use Pod::Parser; - -@ISA = qw(Pod::Parser); -@EXPORT = qw(&podchecker); - -my %VALID_COMMANDS = ( - 'pod' => 1, - 'cut' => 1, - 'head1' => 1, - 'head2' => 1, - 'head3' => 1, - 'head4' => 1, - 'over' => 1, - 'back' => 1, - 'item' => 1, - 'for' => 1, - 'begin' => 1, - 'end' => 1, - 'encoding' => 1, -); - -my %VALID_SEQUENCES = ( - 'I' => 1, - 'B' => 1, - 'S' => 1, - 'C' => 1, - 'L' => 1, - 'F' => 1, - 'X' => 1, - 'Z' => 1, - 'E' => 1, -); - -# stolen from HTML::Entities -my %ENTITIES = ( - # Some normal chars that have special meaning in SGML context - amp => '&', # ampersand -'gt' => '>', # greater than -'lt' => '<', # less than - quot => '"', # double quote - - # PUBLIC ISO 8879-1986//ENTITIES Added Latin 1//EN//HTML - AElig => 'Æ', # capital AE diphthong (ligature) - Aacute => 'Á', # capital A, acute accent - Acirc => 'Â', # capital A, circumflex accent - Agrave => 'À', # capital A, grave accent - Aring => 'Å', # capital A, ring - Atilde => 'Ã', # capital A, tilde - Auml => 'Ä', # capital A, dieresis or umlaut mark - Ccedil => 'Ç', # capital C, cedilla - ETH => 'Ð', # capital Eth, Icelandic - Eacute => 'É', # capital E, acute accent - Ecirc => 'Ê', # capital E, circumflex accent - Egrave => 'È', # capital E, grave accent - Euml => 'Ë', # capital E, dieresis or umlaut mark - Iacute => 'Í', # capital I, acute accent - Icirc => 'Î', # capital I, circumflex accent - Igrave => 'Ì', # capital I, grave accent - Iuml => 'Ï', # capital I, dieresis or umlaut mark - Ntilde => 'Ñ', # capital N, tilde - Oacute => 'Ó', # capital O, acute accent - Ocirc => 'Ô', # capital O, circumflex accent - Ograve => 'Ò', # capital O, grave accent - Oslash => 'Ø', # capital O, slash - Otilde => 'Õ', # capital O, tilde - Ouml => 'Ö', # capital O, dieresis or umlaut mark - THORN => 'Þ', # capital THORN, Icelandic - Uacute => 'Ú', # capital U, acute accent - Ucirc => 'Û', # capital U, circumflex accent - Ugrave => 'Ù', # capital U, grave accent - Uuml => 'Ü', # capital U, dieresis or umlaut mark - Yacute => 'Ý', # capital Y, acute accent - aacute => 'á', # small a, acute accent - acirc => 'â', # small a, circumflex accent - aelig => 'æ', # small ae diphthong (ligature) - agrave => 'à', # small a, grave accent - aring => 'å', # small a, ring - atilde => 'ã', # small a, tilde - auml => 'ä', # small a, dieresis or umlaut mark - ccedil => 'ç', # small c, cedilla - eacute => 'é', # small e, acute accent - ecirc => 'ê', # small e, circumflex accent - egrave => 'è', # small e, grave accent - eth => 'ð', # small eth, Icelandic - euml => 'ë', # small e, dieresis or umlaut mark - iacute => 'í', # small i, acute accent - icirc => 'î', # small i, circumflex accent - igrave => 'ì', # small i, grave accent - iuml => 'ï', # small i, dieresis or umlaut mark - ntilde => 'ñ', # small n, tilde - oacute => 'ó', # small o, acute accent - ocirc => 'ô', # small o, circumflex accent - ograve => 'ò', # small o, grave accent - oslash => 'ø', # small o, slash - otilde => 'õ', # small o, tilde - ouml => 'ö', # small o, dieresis or umlaut mark - szlig => 'ß', # small sharp s, German (sz ligature) - thorn => 'þ', # small thorn, Icelandic - uacute => 'ú', # small u, acute accent - ucirc => 'û', # small u, circumflex accent - ugrave => 'ù', # small u, grave accent - uuml => 'ü', # small u, dieresis or umlaut mark - yacute => 'ý', # small y, acute accent - yuml => 'ÿ', # small y, dieresis or umlaut mark - - # Some extra Latin 1 chars that are listed in the HTML3.2 draft (21-May-96) - copy => '©', # copyright sign - reg => '®', # registered sign - nbsp => "\240", # non breaking space - - # Additional ISO-8859/1 entities listed in rfc1866 (section 14) - iexcl => '¡', - cent => '¢', - pound => '£', - curren => '¤', - yen => '¥', - brvbar => '¦', - sect => '§', - uml => '¨', - ordf => 'ª', - laquo => '«', -'not' => '¬', # not is a keyword in perl - shy => '­', - macr => '¯', - deg => '°', - plusmn => '±', - sup1 => '¹', - sup2 => '²', - sup3 => '³', - acute => '´', - micro => 'µ', - para => '¶', - middot => '·', - cedil => '¸', - ordm => 'º', - raquo => '»', - frac14 => '¼', - frac12 => '½', - frac34 => '¾', - iquest => '¿', -'times' => '×', # times is a keyword in perl - divide => '÷', - -# some POD special entities - verbar => '|', - sol => '/' -); - -##--------------------------------------------------------------------------- - -##--------------------------------- -## Function definitions begin here -##--------------------------------- - -sub podchecker { - my ($infile, $outfile, %options) = @_; - local $_; - - ## Set defaults - $infile ||= \*STDIN; - $outfile ||= \*STDERR; - - ## Now create a pod checker - my $checker = new Pod::Checker(%options); - - ## Now check the pod document for errors - $checker->parse_from_file($infile, $outfile); - - ## Return the number of errors found - return $checker->num_errors(); -} - -##--------------------------------------------------------------------------- - -##------------------------------- -## Method definitions begin here -##------------------------------- - -################################## - -=over 4 - -=item Cnew( %options )> - -Return a reference to a new Pod::Checker object that inherits from -Pod::Parser and is used for calling the required methods later. The -following options are recognized: - -C<-warnings =E num> - Print warnings if C is true. The higher the value of C, -the more warnings are printed. Currently there are only levels 1 and 2. - -C<-quiet =E num> - If C is true, do not print any errors/warnings. This is useful -when Pod::Checker is used to munge POD code into plain text from within -POD formatters. - -=cut - -## sub new { -## my $this = shift; -## my $class = ref($this) || $this; -## my %params = @_; -## my $self = {%params}; -## bless $self, $class; -## $self->initialize(); -## return $self; -## } - -sub initialize { - my $self = shift; - ## Initialize number of errors, and setup an error function to - ## increment this number and then print to the designated output. - $self->{_NUM_ERRORS} = 0; - $self->{_NUM_WARNINGS} = 0; - $self->{-quiet} ||= 0; - # set the error handling subroutine - $self->errorsub($self->{-quiet} ? sub { 1; } : 'poderror'); - $self->{_commands} = 0; # total number of POD commands encountered - $self->{_list_stack} = []; # stack for nested lists - $self->{_have_begin} = ''; # stores =begin - $self->{_links} = []; # stack for internal hyperlinks - $self->{_nodes} = []; # stack for =head/=item nodes - $self->{_index} = []; # text in X<> - # print warnings? - $self->{-warnings} = 1 unless(defined $self->{-warnings}); - $self->{_current_head1} = ''; # the current =head1 block - $self->parseopts(-process_cut_cmd => 1, -warnings => $self->{-warnings}); -} - -################################## - -=item C<$checker-Epoderror( @args )> - -=item C<$checker-Epoderror( {%opts}, @args )> - -Internal method for printing errors and warnings. If no options are -given, simply prints "@_". The following options are recognized and used -to form the output: - - -msg - -A message to print prior to C<@args>. - - -line - -The line number the error occurred in. - - -file - -The file (name) the error occurred in. - - -severity - -The error level, should be 'WARNING' or 'ERROR'. - -=cut - -# Invoked as $self->poderror( @args ), or $self->poderror( {%opts}, @args ) -sub poderror { - my $self = shift; - my %opts = (ref $_[0]) ? %{shift()} : (); - - ## Retrieve options - chomp( my $msg = ($opts{-msg} || '')."@_" ); - my $line = (exists $opts{-line}) ? " at line $opts{-line}" : ''; - my $file = (exists $opts{-file}) ? " in file $opts{-file}" : ''; - unless (exists $opts{-severity}) { - ## See if can find severity in message prefix - $opts{-severity} = $1 if ( $msg =~ s/^\**\s*([A-Z]{3,}):\s+// ); - } - my $severity = (exists $opts{-severity}) ? "*** $opts{-severity}: " : ''; - - ## Increment error count and print message " - ++($self->{_NUM_ERRORS}) - if(!%opts || ($opts{-severity} && $opts{-severity} eq 'ERROR')); - ++($self->{_NUM_WARNINGS}) - if(!%opts || ($opts{-severity} && $opts{-severity} eq 'WARNING')); - unless($self->{-quiet}) { - my $out_fh = $self->output_handle() || \*STDERR; - print $out_fh ($severity, $msg, $line, $file, "\n") - if($self->{-warnings} || !%opts || $opts{-severity} ne 'WARNING'); - } -} - -################################## - -=item C<$checker-Enum_errors()> - -Set (if argument specified) and retrieve the number of errors found. - -=cut - -sub num_errors { - return (@_ > 1) ? ($_[0]->{_NUM_ERRORS} = $_[1]) : $_[0]->{_NUM_ERRORS}; -} - -################################## - -=item C<$checker-Enum_warnings()> - -Set (if argument specified) and retrieve the number of warnings found. - -=cut - -sub num_warnings { - return (@_ > 1) ? ($_[0]->{_NUM_WARNINGS} = $_[1]) : $_[0]->{_NUM_WARNINGS}; -} - -################################## - -=item C<$checker-Ename()> - -Set (if argument specified) and retrieve the canonical name of POD as -found in the C<=head1 NAME> section. - -=cut - -sub name { - return (@_ > 1 && $_[1]) ? - ($_[0]->{-name} = $_[1]) : $_[0]->{-name}; -} - -################################## - -=item C<$checker-Enode()> - -Add (if argument specified) and retrieve the nodes (as defined by C<=headX> -and C<=item>) of the current POD. The nodes are returned in the order of -their occurrence. They consist of plain text, each piece of whitespace is -collapsed to a single blank. - -=cut - -sub node { - my ($self,$text) = @_; - if(defined $text) { - $text =~ s/\s+$//s; # strip trailing whitespace - $text =~ s/\s+/ /gs; # collapse whitespace - # add node, order important! - push(@{$self->{_nodes}}, $text); - # keep also a uniqueness counter - $self->{_unique_nodes}->{$text}++ if($text !~ /^\s*$/s); - return $text; - } - @{$self->{_nodes}}; -} - -################################## - -=item C<$checker-Eidx()> - -Add (if argument specified) and retrieve the index entries (as defined by -CE>) of the current POD. They consist of plain text, each piece -of whitespace is collapsed to a single blank. - -=cut - -# set/return index entries of current POD -sub idx { - my ($self,$text) = @_; - if(defined $text) { - $text =~ s/\s+$//s; # strip trailing whitespace - $text =~ s/\s+/ /gs; # collapse whitespace - # add node, order important! - push(@{$self->{_index}}, $text); - # keep also a uniqueness counter - $self->{_unique_nodes}->{$text}++ if($text !~ /^\s*$/s); - return $text; - } - @{$self->{_index}}; -} - -################################## - -=item C<$checker-Ehyperlink()> - -Add (if argument specified) and retrieve the hyperlinks (as defined by -CE>) of the current POD. They consist of a 2-item array: line -number and C object. - -=back - -=cut - -# set/return hyperlinks of the current POD -sub hyperlink { - my $self = shift; - if($_[0]) { - push(@{$self->{_links}}, $_[0]); - return $_[0]; - } - @{$self->{_links}}; -} - -## overrides for Pod::Parser - -sub end_pod { - ## Do some final checks and - ## print the number of errors found - my $self = shift; - my $infile = $self->input_file(); - - if(@{$self->{_list_stack}}) { - my $list; - while(($list = $self->_close_list('EOF',$infile)) && - $list->indent() ne 'auto') { - $self->poderror({ -line => 'EOF', -file => $infile, - -severity => 'ERROR', -msg => '=over on line ' . - $list->start() . ' without closing =back' }); - } - } - - # check validity of document internal hyperlinks - # first build the node names from the paragraph text - my %nodes; - foreach($self->node()) { - $nodes{$_} = 1; - if(/^(\S+)\s+\S/) { - # we have more than one word. Use the first as a node, too. - # This is used heavily in perlfunc.pod - $nodes{$1} ||= 2; # derived node - } - } - foreach($self->idx()) { - $nodes{$_} = 3; # index node - } - foreach($self->hyperlink()) { - my ($line,$link) = @$_; - # _TODO_ what if there is a link to the page itself by the name, - # e.g. in Tk::Pod : L - if($link->node() && !$link->page() && $link->type() ne 'hyperlink') { - my $node = $self->_check_ptree($self->parse_text($link->node(), - $line), $line, $infile, 'L'); - if($node && !$nodes{$node}) { - $self->poderror({ -line => $line || '', -file => $infile, - -severity => 'ERROR', - -msg => "unresolved internal link '$node'"}); - } - } - } - - # check the internal nodes for uniqueness. This pertains to - # =headX, =item and X<...> - if($self->{-warnings} && $self->{-warnings}>1) { - foreach(grep($self->{_unique_nodes}->{$_} > 1, - keys %{$self->{_unique_nodes}})) { - $self->poderror({ -line => '-', -file => $infile, - -severity => 'WARNING', - -msg => "multiple occurrence of link target '$_'"}); - } - } - - # no POD found here - $self->num_errors(-1) if($self->{_commands} == 0); -} - -# check a POD command directive -sub command { - my ($self, $cmd, $paragraph, $line_num, $pod_para) = @_; - my ($file, $line) = $pod_para->file_line; - ## Check the command syntax - my $arg; # this will hold the command argument - if (! $VALID_COMMANDS{$cmd}) { - $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR', - -msg => "Unknown command '$cmd'" }); - } - else { # found a valid command - $self->{_commands}++; # delete this line if below is enabled again - - $self->_commands_in_paragraphs($paragraph, $pod_para); - - ##### following check disabled due to strong request - #if(!$self->{_commands}++ && $cmd !~ /^head/) { - # $self->poderror({ -line => $line, -file => $file, - # -severity => 'WARNING', - # -msg => "file does not start with =head" }); - #} - - # check syntax of particular command - if($cmd eq 'over') { - # check for argument - $arg = $self->interpolate_and_check($paragraph, $line,$file); - my $indent = 4; # default - if($arg && $arg =~ /^\s*(\d+)\s*$/) { - $indent = $1; - } - # start a new list - $self->_open_list($indent,$line,$file); - } - elsif($cmd eq 'item') { - # are we in a list? - unless(@{$self->{_list_stack}}) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => '=item without previous =over' }); - # auto-open in case we encounter many more - $self->_open_list('auto',$line,$file); - } - my $list = $self->{_list_stack}->[0]; - # check whether the previous item had some contents - if(defined $self->{_list_item_contents} && - $self->{_list_item_contents} == 0) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => 'previous =item has no contents' }); - } - if($list->{_has_par}) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => 'preceding non-item paragraph(s)' }); - delete $list->{_has_par}; - } - # check for argument - $arg = $self->interpolate_and_check($paragraph, $line, $file); - if($arg && $arg =~ /(\S+)/) { - $arg =~ s/[\s\n]+$//; - my $type; - if($arg =~ /^[*]\s*(\S*.*)/) { - $type = 'bullet'; - $self->{_list_item_contents} = $1 ? 1 : 0; - $arg = $1; - } - elsif($arg =~ /^\d+\.?\s+(\S*)/) { - $type = 'number'; - $self->{_list_item_contents} = $1 ? 1 : 0; - $arg = $1; - } - else { - $type = 'definition'; - $self->{_list_item_contents} = 1; - } - my $first = $list->type(); - if($first && $first ne $type) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => "=item type mismatch ('$first' vs. '$type')"}); - } - else { # first item - $list->type($type); - } - } - else { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => 'No argument for =item' }); - $arg = ' '; # empty - $self->{_list_item_contents} = 0; - } - # add this item - $list->item($arg); - # remember this node - $self->node($arg); - } - elsif($cmd eq 'back') { - # check if we have an open list - unless(@{$self->{_list_stack}}) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => '=back without previous =over' }); - } - else { - # check for spurious characters - $arg = $self->interpolate_and_check($paragraph, $line,$file); - if($arg && $arg =~ /\S/) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => 'Spurious character(s) after =back' }); - } - # close list - my $list = $self->_close_list($line,$file); - # check for empty lists - if(!$list->item() && $self->{-warnings}) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => 'No items in =over (at line ' . - $list->start() . ') / =back list'}); - } - } - } - elsif($cmd =~ /^head(\d+)/) { - my $hnum = $1; - $self->{"_have_head_$hnum"}++; # count head types - if($hnum > 1 && !$self->{'_have_head_'.($hnum -1)}) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => "=head$hnum without preceding higher level"}); - } - # check whether the previous =head section had some contents - if(defined $self->{_commands_in_head} && - $self->{_commands_in_head} == 0 && - defined $self->{_last_head} && - $self->{_last_head} >= $hnum) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => 'empty section in previous paragraph'}); - } - $self->{_commands_in_head} = -1; - $self->{_last_head} = $hnum; - # check if there is an open list - if(@{$self->{_list_stack}}) { - my $list; - while(($list = $self->_close_list($line,$file)) && - $list->indent() ne 'auto') { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => '=over on line '. $list->start() . - " without closing =back (at $cmd)" }); - } - } - # remember this node - $arg = $self->interpolate_and_check($paragraph, $line,$file); - $arg =~ s/[\s\n]+$//s; - $self->node($arg); - unless(length($arg)) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => "empty =$cmd"}); - } - if($cmd eq 'head1') { - $self->{_current_head1} = $arg; - } else { - $self->{_current_head1} = ''; - } - } - elsif($cmd eq 'begin') { - if($self->{_have_begin}) { - # already have a begin - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => q{Nested =begin's (first at line } . - $self->{_have_begin} . ')'}); - } - else { - # check for argument - $arg = $self->interpolate_and_check($paragraph, $line,$file); - unless($arg && $arg =~ /(\S+)/) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => 'No argument for =begin'}); - } - # remember the =begin - $self->{_have_begin} = "$line:$1"; - } - } - elsif($cmd eq 'end') { - if($self->{_have_begin}) { - # close the existing =begin - $self->{_have_begin} = ''; - # check for spurious characters - $arg = $self->interpolate_and_check($paragraph, $line,$file); - # the closing argument is optional - #if($arg && $arg =~ /\S/) { - # $self->poderror({ -line => $line, -file => $file, - # -severity => 'WARNING', - # -msg => "Spurious character(s) after =end" }); - #} - } - else { - # don't have a matching =begin - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => '=end without =begin' }); - } - } - elsif($cmd eq 'for') { - unless($paragraph =~ /\s*(\S+)\s*/) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => '=for without formatter specification' }); - } - $arg = ''; # do not expand paragraph below - } - elsif($cmd =~ /^(pod|cut)$/) { - # check for argument - $arg = $self->interpolate_and_check($paragraph, $line,$file); - if($arg && $arg =~ /(\S+)/) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => "Spurious text after =$cmd"}); - } - if($cmd eq 'cut' && (!$self->{_PREVIOUS} || $self->{_PREVIOUS} eq 'cut')) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => "Spurious =cut command"}); - } - if($cmd eq 'pod' && $self->{_PREVIOUS} && $self->{_PREVIOUS} ne 'cut') { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => "Spurious =pod command"}); - } - } - $self->{_commands_in_head}++; - ## Check the interior sequences in the command-text - $self->interpolate_and_check($paragraph, $line,$file) - unless(defined $arg); - } -} - -sub _open_list -{ - my ($self,$indent,$line,$file) = @_; - my $list = Pod::List->new( - -indent => $indent, - -start => $line, - -file => $file); - unshift(@{$self->{_list_stack}}, $list); - undef $self->{_list_item_contents}; - $list; -} - -sub _close_list -{ - my ($self,$line,$file) = @_; - my $list = shift(@{$self->{_list_stack}}); - if(defined $self->{_list_item_contents} && - $self->{_list_item_contents} == 0) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => 'previous =item has no contents' }); - } - undef $self->{_list_item_contents}; - $list; -} - -# process a block of some text -sub interpolate_and_check { - my ($self, $paragraph, $line, $file) = @_; - ## Check the interior sequences in the command-text - # and return the text - $self->_check_ptree( - $self->parse_text($paragraph,$line), $line, $file, ''); -} - -sub _check_ptree { - my ($self,$ptree,$line,$file,$nestlist) = @_; - local($_); - my $text = ''; - # process each node in the parse tree - foreach(@$ptree) { - # regular text chunk - unless(ref) { - # count the unescaped angle brackets - # complain only when warning level is greater than 1 - if($self->{-warnings} && $self->{-warnings}>1) { - my $count; - if($count = tr/<>/<>/) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => "$count unescaped <> in paragraph" }); - } - } - $text .= $_; - next; - } - # have an interior sequence - my $cmd = $_->cmd_name(); - my $contents = $_->parse_tree(); - ($file,$line) = $_->file_line(); - # check for valid tag - if (! $VALID_SEQUENCES{$cmd}) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => qq(Unknown interior-sequence '$cmd')}); - # expand it anyway - $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); - next; - } - if(index($nestlist, $cmd) != -1) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => "nested commands $cmd<...$cmd<...>...>"}); - # _TODO_ should we add the contents anyway? - # expand it anyway, see below - } - if($cmd eq 'E') { - # preserve entities - if(@$contents > 1 || ref $$contents[0] || $$contents[0] !~ /^\w+$/) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => 'garbled entity ' . $_->raw_text()}); - next; - } - my $ent = $$contents[0]; - my $val; - if($ent =~ /^0x[0-9a-f]+$/i) { - # hexadec entity - $val = hex($ent); - } - elsif($ent =~ /^0\d+$/) { - # octal - $val = oct($ent); - } - elsif($ent =~ /^\d+$/) { - # numeric entity - $val = $ent; - } - if(defined $val) { - if($val>0 && $val<256) { - $text .= chr($val); - } - else { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => 'Entity number out of range ' . $_->raw_text()}); - } - } - elsif($ENTITIES{$ent}) { - # known ISO entity - $text .= $ENTITIES{$ent}; - } - else { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => 'Unknown entity ' . $_->raw_text()}); - $text .= "E<$ent>"; - } - } - elsif($cmd eq 'L') { - # try to parse the hyperlink - my $link = Pod::Hyperlink->new($contents->raw_text()); - unless(defined $link) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => 'malformed link ' . $_->raw_text() ." : $@"}); - next; - } - $link->line($line); # remember line - if($self->{-warnings}) { - foreach my $w ($link->warning()) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => $w }); - } - } - # check the link text - $text .= $self->_check_ptree($self->parse_text($link->text(), - $line), $line, $file, "$nestlist$cmd"); - # remember link - $self->hyperlink([$line,$link]); - } - elsif($cmd =~ /[BCFIS]/) { - # add the guts - $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); - } - elsif($cmd eq 'Z') { - if(length($contents->raw_text())) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => 'Nonempty Z<>'}); - } - } - elsif($cmd eq 'X') { - my $idx = $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); - if($idx =~ /^\s*$/s) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => 'Empty X<>'}); - } - else { - # remember this node - $self->idx($idx); - } - } - else { - # not reached - croak 'internal error'; - } - } - $text; -} - -# process a block of verbatim text -sub verbatim { - ## Nothing particular to check - my ($self, $paragraph, $line_num, $pod_para) = @_; - - $self->_preproc_par($paragraph); - $self->_commands_in_paragraphs($paragraph, $pod_para); - - if($self->{_current_head1} eq 'NAME') { - my ($file, $line) = $pod_para->file_line; - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => 'Verbatim paragraph in NAME section' }); - } -} - -# process a block of regular text -sub textblock { - my ($self, $paragraph, $line_num, $pod_para) = @_; - my ($file, $line) = $pod_para->file_line; - - $self->_preproc_par($paragraph); - $self->_commands_in_paragraphs($paragraph, $pod_para); - - # skip this paragraph if in a =begin block - unless($self->{_have_begin}) { - my $block = $self->interpolate_and_check($paragraph, $line,$file); - if($self->{_current_head1} eq 'NAME') { - if($block =~ /^\s*(\S+?)\s*[,-]/) { - # this is the canonical name - $self->{-name} = $1 unless(defined $self->{-name}); - } - } - } -} - -sub _preproc_par -{ - my $self = shift; - $_[0] =~ s/[\s\n]+$//; - if($_[0]) { - $self->{_commands_in_head}++; - $self->{_list_item_contents}++ if(defined $self->{_list_item_contents}); - if(@{$self->{_list_stack}} && !$self->{_list_stack}->[0]->item()) { - $self->{_list_stack}->[0]->{_has_par} = 1; - } - } -} - -# look for =foo commands at the start of a line within a paragraph, as for -# instance the following which prints as "* one =item two". -# -# =item one -# =item two -# -# Examples of =foo written in docs are expected to be indented in a verbatim -# or marked up C<=foo> so won't be caught. A double-angle C<< =foo >> could -# have the =foo at the start of a line, but that should be unlikely and is -# easily enough dealt with by not putting a newline after the C<<. -# -sub _commands_in_paragraphs { - my ($self, $str, $pod_para) = @_; - while ($str =~ /[^\n]\n=([a-z][a-z0-9]+)/sg) { - my $cmd = $1; - my $pos = pos($str); - if ($VALID_COMMANDS{$cmd}) { - my ($file, $line) = $pod_para->file_line; - my $part = substr($str, 0, $pos); - $line += ($part =~ tr/\n//); # count of newlines - - $self->poderror - ({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => "Apparent command =$cmd not preceded by blank line"}); - } - } -} - -1; - -__END__ - -=head1 AUTHOR - -Please report bugs using L. - -Brad Appleton Ebradapp@enteract.comE (initial version), -Marek Rouchal Emarekr@cpan.orgE - -Based on code for B written by -Tom Christiansen Etchrist@mox.perl.comE - -B is part of the Pod-Checker distribution, and is based on -L. - -=cut - +############################################################################# +# Pod/Checker.pm -- check pod documents for syntax errors +# +# Copyright (C) 1994-2000 by Bradford Appleton. All rights reserved. +# This is free software; you can redistribute it and/or modify it under the +# same terms as Perl itself. +############################################################################# + +package Pod::Checker; +use strict; +use warnings; + +our $VERSION = '1.73'; ## Current version of this package + +=head1 NAME + +Pod::Checker - check pod documents for syntax errors + +=head1 SYNOPSIS + + use Pod::Checker; + + $syntax_okay = podchecker($filepath, $outputpath, %options); + + my $checker = Pod::Checker->new(%options); + $checker->parse_from_file($filepath, \*STDERR); + +=head1 OPTIONS/ARGUMENTS + +C<$filepath> is the input POD to read and C<$outputpath> is +where to write POD syntax error messages. Either argument may be a scalar +indicating a file-path, or else a reference to an open filehandle. +If unspecified, the input-file it defaults to C<\*STDIN>, and +the output-file defaults to C<\*STDERR>. + +=head2 podchecker() + +This function can take a hash of options: + +=over 4 + +=item B<-warnings> =E I + +Turn warnings on/off. I is usually 1 for on, but higher values +trigger additional warnings. See L<"Warnings">. + +=item B<-quiet> =E I + +If C is true, do not print any errors/warnings. + +=back + +=head1 DESCRIPTION + +B will perform syntax checking of Perl5 POD format documentation. + +Curious/ambitious users are welcome to propose additional features they wish +to see in B and B and verify that the checks are +consistent with L. + +The following checks are currently performed: + +=over 4 + +=item * + +Unknown '=xxxx' commands, unknown 'XE...E' interior-sequences, +and unterminated interior sequences. + +=item * + +Check for proper balancing of C<=begin> and C<=end>. The contents of such +a block are generally ignored, i.e. no syntax checks are performed. + +=item * + +Check for proper nesting and balancing of C<=over>, C<=item> and C<=back>. + +=item * + +Check for same nested interior-sequences (e.g. +C...LE...E...E>). + +=item * + +Check for malformed or non-existing entities C...E>. + +=item * + +Check for correct syntax of hyperlinks C...E>. See L +for details. + +=item * + +Check for unresolved document-internal links. This check may also reveal +misspelled links that seem to be internal links but should be links +to something else. + +=back + +=head1 DIAGNOSTICS + +=head2 Errors + +=over 4 + +=item * empty =headn + +A heading (C<=head1> or C<=head2>) without any text? That ain't no +heading! + +=item * =over on line I without closing =back + +=item * You forgot a '=back' before '=headI' + +=item * =over is the last thing in the document?! + +The C<=over> command does not have a corresponding C<=back> before the +next heading (C<=head1> or C<=head2>) or the end of the file. + +=item * '=item' outside of any '=over' + +=item * =back without =over + +An C<=item> or C<=back> command has been found outside a +C<=over>/C<=back> block. + +=item * Can't have a 0 in =over I + +You need to indent a strictly positive number of spaces, not 0. + +=item * =over should be: '=over' or '=over positive_number' + +Either have an argumentless =over, or have its argument a strictly positive number. + +=item * =begin I without matching =end I + +A C<=begin> command was found that has no matching =end command. + +=item * =begin without a target? + +A C<=begin> command was found that is not followed by the formatter +specification. + +=item * =end I without matching =begin. + +A standalone C<=end> command was found. + +=item * '=end' without a target? + +'=end' directives need to have a target, just like =begin directives. + +=item * '=end I' is invalid. + +I needs to be one word + +=item * =end I doesn't match =begin I + +I needs to match =begin's I. + +=item * =for without a target? + +There is no specification of the formatter after the C<=for> command. + +=item * unresolved internal link I + +The given link to I does not have a matching node in the current +POD. This also happened when a single word node name is not enclosed in +C<"">. + +=item * Unknown directive: I + +An invalid POD command has been found. Valid are C<=head1>, C<=head2>, +C<=head3>, C<=head4>, C<=over>, C<=item>, C<=back>, C<=begin>, C<=end>, +C<=for>, C<=pod>, C<=cut> + +=item * Deleting unknown formatting code I + +An invalid markup command has been encountered. Valid are: +CE>, CE>, CE>, CE>, +CE>, CE>, CE>, CE>, +CE> + +=item * Unterminated IEE sequence + +An unclosed formatting code + +=item * An EE...E surrounding strange content + +The I found cannot be interpreted as a character entity. + +=item * An empty EEE + +=item * An empty C<< LEE >> + +=item * An empty XEE + +There needs to be content inside E, L, and X formatting codes. + +=item * A non-empty ZEE + +The CE> sequence is supposed to be empty. + +=item * Spurious text after =pod / =cut + +The commands C<=pod> and C<=cut> do not take any arguments. + +=item * =back doesn't take any parameters, but you said =back I + +The C<=back> command does not take any arguments. + +=item * =pod directives shouldn't be over one line long! Ignoring all I lines of content + +Self explanatory + +=item * =cut found outside a pod block. + +A '=cut' directive found in the middle of non-POD + +=item * Invalid =encoding syntax: I + +Syntax error in =encoding directive + +=back + +=head2 Warnings + +These may not necessarily cause trouble, but indicate mediocre style. + +=over 4 + +=item * nested commands IE...IE...E...E + +Two nested identical markup commands have been found. Generally this +does not make sense. + +=item * multiple occurrences (I) of link target I + +The POD file has some C<=item> and/or C<=head> commands that have +the same text. Potential hyperlinks to such a text cannot be unique then. +This warning is printed only with warning level greater than one. + +=item * line containing nothing but whitespace in paragraph + +There is some whitespace on a seemingly empty line. POD is very sensitive +to such things, so this is flagged. B users switch on the B +option to avoid this problem. + +=item * =item has no contents + +There is a list C<=item> that has no text contents. You probably want to delete +empty items. + +=item * You can't have =items (as at line I) unless the first thing after the =over is an =item + +A list introduced by C<=over> starts with a text or verbatim paragraph, +but continues with C<=item>s. Move the non-item paragraph out of the +C<=over>/C<=back> block. + +=item * Expected '=item I' + +=item * Expected '=item *' + +=item * Possible =item type mismatch: 'I' found leading a supposed definition =item + +A list started with e.g. a bullet-like C<=item> and continued with a +numbered one. This is obviously inconsistent. For most translators the +type of the I C<=item> determines the type of the list. + +=item * You have '=item x' instead of the expected '=item I' + +Erroneous numbering of =item numbers; they need to ascend consecutively. + +=item * Unknown E content in EEIE + +A character entity was found that does not belong to the standard +ISO set or the POD specials C and C. I + +=item * empty =over/=back block + +The list opened with C<=over> does not contain anything. + +=item * empty section in previous paragraph + +The previous section (introduced by a C<=head> command) does not contain +any valid content. This usually indicates that something is missing. Note: A +C<=head1> followed immediately by C<=head2> does not trigger this warning. + +=item * Verbatim paragraph in NAME section + +The NAME section (C<=head1 NAME>) should consist of a single paragraph +with the script/module name, followed by a dash `-' and a very short +description of what the thing is good for. + +=item * =headI without preceding higher level + +For example if there is a C<=head2> in the POD file prior to a +C<=head1>. + +=back + +=head2 Hyperlinks + +There are some warnings with respect to malformed hyperlinks: + +=over 4 + +=item * ignoring leading/trailing whitespace in link + +There is whitespace at the beginning or the end of the contents of +LE...E. + +=item * alternative text/node '%s' contains non-escaped | or / + +The characters C<|> and C are special in the LE...E context. +Although the hyperlink parser does its best to determine which "/" is +text and which is a delimiter in case of doubt, one ought to escape +these literal characters like this: + + / E + | E + +=back + +Note that the line number of the error/warning may refer to the line number of +the start of the paragraph in which the error/warning exists, not the line +number that the error/warning is on. This bug is present in errors/warnings +related to formatting codes. I + +=head1 RETURN VALUE + +B returns the number of POD syntax errors found or -1 if +there were no POD commands at all found in the file. + +=head1 EXAMPLES + +See L + +=head1 SCRIPTS + +The B script that comes with this distribution is a lean wrapper +around this module. See the online manual with + + podchecker -help + podchecker -man + +=head1 INTERFACE + +While checking, this module collects document properties, e.g. the nodes +for hyperlinks (C<=headX>, C<=item>) and index entries (CE>). +POD translators can use this feature to syntax-check and get the nodes in +a first pass before actually starting to convert. This is expensive in terms +of execution time, but allows for very robust conversions. + +Since v1.24 the B module uses only the B +method to print errors and warnings. The summary output (e.g. +"Pod syntax OK") has been dropped from the module and has been included in +B (the script). This allows users of B to +control completely the output behavior. Users of B (the script) +get the well-known behavior. + +v1.45 inherits from Pod::Simple as opposed to all previous versions +inheriting from Pod::Parser. Do B use Pod::Simple's interface when +using Pod::Checker unless it is documented somewhere on this page. I +repeat, DO B USE POD::SIMPLE'S INTERFACE. + +=cut + +############################################################################# + +#use diagnostics; +use Carp qw(croak); +use Exporter 'import'; +use base qw/Pod::Simple::Methody/; + +our @EXPORT = qw(&podchecker); + +##--------------------------------- +## Function definitions begin here +##--------------------------------- + +sub podchecker { + my ($infile, $outfile, %options) = @_; + local $_; + + ## Set defaults + $infile ||= \*STDIN; + $outfile ||= \*STDERR; + + ## Now create a pod checker + my $checker = Pod::Checker->new(%options); + + ## Now check the pod document for errors + $checker->parse_from_file($infile, $outfile); + + ## Return the number of errors found + return $checker->num_errors(); +} + + +##--------------------------------------------------------------------------- + +##------------------------------- +## Method definitions begin here +##------------------------------- + +################################## + +=over 4 + +=item Cnew( %options )> + +Return a reference to a new Pod::Checker object that inherits from +Pod::Simple and is used for calling the required methods later. The +following options are recognized: + +C<-warnings =E num> + Print warnings if C is true. The higher the value of C, +the more warnings are printed. Currently there are only levels 1 and 2. + +C<-quiet =E num> + If C is true, do not print any errors/warnings. This is useful +when Pod::Checker is used to munge POD code into plain text from within +POD formatters. + +=cut + +sub new { + my $new = shift->SUPER::new(@_); + $new->{'output_fh'} ||= *STDERR{IO}; + + # Set options + my %opts = @_; + $new->{'-warnings'} = defined $opts{'-warnings'} ? + $opts{'-warnings'} : 1; # default on + $new->{'-quiet'} = $opts{'-quiet'} || 0; # default off + + # Initialize number of errors/warnings + $new->{'_NUM_ERRORS'} = 0; + $new->{'_NUM_WARNINGS'} = 0; + + # 'current' also means 'most recent' in the follow comments + $new->{'_thispara'} = ''; # current POD paragraph + $new->{'_line'} = 0; # current line number + $new->{'_head_num'} = 0; # current =head level (set to 0 to make + # logic easier down the road) + $new->{'_cmds_since_head'} = 0; # num of POD directives since prev. =headN + $new->{'_nodes'} = []; # stack for =head/=item nodes + $new->{'_fcode_stack'} = []; # stack for nested formatting codes + $new->{'_fcode_pos'} = []; # stack for position in paragraph of fcodes + $new->{'_begin_stack'} = []; # stack for =begins: [line #, target] + $new->{'_links'} = []; # stack for hyperlinks to external entities + $new->{'_internal_links'} = []; # set of linked-to internal sections + $new->{'_index'} = []; # stack for text in X<>s + + $new->accept_targets('*'); # check all =begin/=for blocks + $new->cut_handler( \&handle_pod_and_cut ); # warn if text after =cut + $new->pod_handler( \&handle_pod_and_cut ); # warn if text after =pod + $new->whiteline_handler( \&handle_whiteline ); # warn if whiteline + $new->parse_empty_lists(1); # warn if they are empty + + return $new; +} + +################################## + +=item C<$checker-Epoderror( @args )> + +=item C<$checker-Epoderror( {%opts}, @args )> + +Internal method for printing errors and warnings. If no options are given, +simply prints "@_". The following options are recognized and used to form +the output: + + -msg + +A message to print prior to C<@args>. + + -line + +The line number the error occurred in. + + -file + +The file (name) the error occurred in. Defaults to the name of the current +file being processed. + + -severity + +The error level, should be 'WARNING' or 'ERROR'. + +=cut + +# Invoked as $self->poderror( @args ), or $self->poderror( {%opts}, @args ) +sub poderror { + my $self = shift; + my %opts = (ref $_[0]) ? %{shift()} : (); + + ## Retrieve options + chomp( my $msg = ($opts{'-msg'} || '')."@_" ); + my $line = (exists $opts{'-line'}) ? " at line $opts{'-line'}" : ''; + my $file = ' in file ' . ((exists $opts{'-file'}) + ? $opts{'-file'} + : ((defined $self->source_filename) + ? $self->source_filename + : "???")); + unless (exists $opts{'-severity'}) { + ## See if can find severity in message prefix + $opts{'-severity'} = $1 if ( $msg =~ s/^\**\s*([A-Z]{3,}):\s+// ); + } + my $severity = (exists $opts{'-severity'}) ? "*** $opts{-severity}: " : ''; + + ## Increment error count and print message " + ++($self->{'_NUM_ERRORS'}) + if(!%opts || ($opts{-severity} && $opts{'-severity'} eq 'ERROR')); + ++($self->{'_NUM_WARNINGS'}) + if(!%opts || ($opts{-severity} && $opts{'-severity'} eq 'WARNING')); + unless($self->{'-quiet'}) { + my $out_fh = $self->{'output_fh'} || \*STDERR; + print $out_fh ($severity, $msg, $line, $file, "\n") + if($self->{'-warnings'} || !%opts || $opts{'-severity'} ne 'WARNING'); + } +} + +################################## + +=item C<$checker-Enum_errors()> + +Set (if argument specified) and retrieve the number of errors found. + +=cut + +sub num_errors { + return (@_ > 1) ? ($_[0]->{'_NUM_ERRORS'} = $_[1]) : $_[0]->{'_NUM_ERRORS'}; +} + +################################## + +=item C<$checker-Enum_warnings()> + +Set (if argument specified) and retrieve the number of warnings found. + +=cut + +sub num_warnings { + return (@_ > 1) ? ($_[0]->{'_NUM_WARNINGS'} = $_[1]) : + $_[0]->{'_NUM_WARNINGS'}; +} + +################################## + +=item C<$checker-Ename()> + +Set (if argument specified) and retrieve the canonical name of POD as +found in the C<=head1 NAME> section. + +=cut + +sub name { + return (@_ > 1 && $_[1]) ? + ($_[0]->{'_pod_name'} = $_[1]) : $_[0]->{'_pod_name'}; +} + +################################## + +=item C<$checker-Enode()> + +Add (if argument specified) and retrieve the nodes (as defined by C<=headX> +and C<=item>) of the current POD. The nodes are returned in the order of +their occurrence. They consist of plain text, each piece of whitespace is +collapsed to a single blank. + +=cut + +sub node { + my ($self,$text) = @_; + if(defined $text) { + $text =~ s/\s+$//s; # strip trailing whitespace + $text =~ s/\s+/ /gs; # collapse whitespace + # add node, order important! + push(@{$self->{'_nodes'}}, $text); + # keep also a uniqueness counter + $self->{'_unique_nodes'}->{$text}++ if($text !~ /^\s*$/s); + return $text; + } + @{$self->{'_nodes'}}; +} + +################################## + +=item C<$checker-Eidx()> + +Add (if argument specified) and retrieve the index entries (as defined by +CE>) of the current POD. They consist of plain text, each piece +of whitespace is collapsed to a single blank. + +=cut + +# set/return index entries of current POD +sub idx { + my ($self,$text) = @_; + if(defined $text) { + $text =~ s/\s+$//s; # strip trailing whitespace + $text =~ s/\s+/ /gs; # collapse whitespace + # add node, order important! + push(@{$self->{'_index'}}, $text); + # keep also a uniqueness counter + $self->{'_unique_nodes'}->{$text}++ if($text !~ /^\s*$/s); + return $text; + } + @{$self->{'_index'}}; +} + +################################## + +# add a hyperlink to the list of those of the current POD; returns current +# list after the addition has been done +sub hyperlink { + my $self = shift; + push(@{$self->{'_links'}}, $_[0]); + return $_[0]; +} + +=item C<$checker-Ehyperlinks()> + +Retrieve an array containing the hyperlinks to things outside +the current POD (as defined by CE>). + +Each is an instance of a class with the following methods: + +=cut + +sub hyperlinks { + @{shift->{'_links'}}; +} + +################################## + +# override Pod::Simple's whine() and scream() to use poderror() + +# Note: +# Ignore $self->{'no_whining'} b/c $self->{'quiet'} takes care of it in poderror +# Don't bother incrementing $self->{'errors_seen'} -- it's not used +# Don't bother pushing to $self->{'errata'} b/c poderror() outputs immediately +# We don't need to set $self->no_errata_section(1) b/c of these overrides + + +sub whine { + my ($self, $line, $complaint) = @_; + + my $severity = 'ERROR'; + + if (0) { + # XXX: Let's standardize what's a warning and what's an error. Let's not + # move stuff up and down the severity tree. -- rjbs, 2013-04-12 + # Convert errors in Pod::Simple that are warnings in Pod::Checker + # XXX Do differently so the $complaint can be reworded without this breaking + $severity = 'WARNING' if + $complaint =~ /^Expected '=item .+?'$/ || + $complaint =~ /^You can't have =items \(as at line .+?\) unless the first thing after the =over is an =item$/ || + $complaint =~ /^You have '=item .+?' instead of the expected '=item .+?'$/; + } + + $self->poderror({ -line => $line, + -severity => $severity, + -msg => $complaint }); + + return 1; # assume everything is peachy keen +} + +sub scream { + my ($self, $line, $complaint) = @_; + + $self->poderror({ -line => $line, + -severity => 'ERROR', # consider making severity 'FATAL' + -msg => $complaint }); + + return 1; +} + + +################################## + +# Some helper subroutines + +sub _init_event { # assignments done at the start of most events + $_[0]{'_thispara'} = ''; + $_[0]{'_line'} = $_[1]{'start_line'}; + $_[0]{'_cmds_since_head'}++; +} + +sub _check_fcode { + my ($self, $inner, $outers) = @_; + # Check for an fcode inside another of the same fcode + # XXX line number is the line of the start of the paragraph that the warning + # is in, not the line that the warning is on. Fix this + + # Later versions of Pod::Simple forbid nested L<>'s + return if $inner eq 'L' && $Pod::Simple::VERSION ge '3.33'; + + if (grep { $_ eq $inner } @$outers) { + $self->poderror({ -line => $self->{'_line'}, + -severity => 'WARNING', + -msg => "nested commands $inner<...$inner<...>...>"}); + } +} + +################################## + +sub handle_text { $_[0]{'_thispara'} .= $_[1] } + +# whiteline is a seemingly blank line that matches /[^\S\r\n]/ +sub handle_whiteline { + my ($line, $line_n, $self) = @_; + $self->poderror({ + -line => $line_n, + -severity => 'WARNING', + -msg => 'line containing nothing but whitespace in paragraph'}); +} + +######## Directives +sub handle_pod_and_cut { + my ($line, $line_n, $self) = @_; + $self->{'_cmds_since_head'}++; + if ($line =~ /=(pod|cut)\s+\S/) { + $self->poderror({ -line => $line_n, + -severity => 'ERROR', + -msg => "Spurious text after =$1"}); + } +} + +sub start_Para { shift->_init_event(@_); } +sub end_Para { + my $self = shift; + # Get the NAME of the pod document + if ($self->{'_head_num'} == 1 && $self->{'_head_text'} eq 'NAME') { + if ($self->{'_thispara'} =~ /^\s*(\S+?)\s*[,-]/) { + $self->{'_pod_name'} = $1 unless defined $self->{'_pod_name'}; + } + } +} + +sub start_Verbatim { + my $self = shift; + $self->_init_event(@_); + + if ($self->{'_head_num'} == 1 && $self->{'_head_text'} eq 'NAME') { + $self->poderror({ -line => $self->{'_line'}, + -severity => 'WARNING', + -msg => 'Verbatim paragraph in NAME section' }); + } +} +# Don't need an end_Verbatim + +# Do I need to do anything else with this? +sub start_Data { shift->_init_event() } + +sub start_head1 { shift->start_head(1, @_) } +sub start_head2 { shift->start_head(2, @_) } +sub start_head3 { shift->start_head(3, @_) } +sub start_head4 { shift->start_head(4, @_) } +sub start_head { + my $self = shift; + my $h = shift; + $self->_init_event(@_); + my $prev_h = $self->{'_head_num'}; + $self->{'_head_num'} = $h; + $self->{"_count_head$h"}++; + + if ($h > 1 && !$self->{'_count_head'.($h-1)}) { + $self->poderror({ -line => $self->{'_line'}, + -severity => 'WARNING', + -msg => "=head$h without preceding higher level"}); + } + + # If this is the first =head of the doc, $prev_h is 0, thus less than $h + if ($self->{'_cmds_since_head'} == 1 && $prev_h >= $h) { + $self->poderror({ -line => $self->{'_line'}, + -severity => 'WARNING', + -msg => 'empty section in previous paragraph'}); + } +} + +sub end_head1 { shift->end_head(@_) } +sub end_head2 { shift->end_head(@_) } +sub end_head3 { shift->end_head(@_) } +sub end_head4 { shift->end_head(@_) } +sub end_head { + my $self = shift; + my $arg = $self->{'_thispara'}; + $arg =~ s/\s+$//; + $self->{'_head_text'} = $arg; + $self->{'_cmds_since_head'} = 0; + my $h = $self->{'_head_num'}; + $self->node($arg); # remember this node + if ($arg eq '') { + $self->poderror({ -line => $self->{'_line'}, + -severity => 'ERROR', + -msg => "empty =head$h" }); + } +} + +sub start_over_bullet { shift->start_over(@_, 'bullet') } +sub start_over_number { shift->start_over(@_, 'number') } +sub start_over_text { shift->start_over(@_, 'definition') } +sub start_over_block { shift->start_over(@_, 'block') } +sub start_over_empty { + my $self = shift; + $self->start_over(@_, 'empty'); + $self->poderror({ -line => $self->{'_line'}, + -severity => 'WARNING', + -msg => 'empty =over/=back block' }); +} +sub start_over { + my $self = shift; + my $type = pop; + $self->_init_event(@_); +} + +sub start_item_bullet { shift->_init_event(@_) } +sub start_item_number { shift->_init_event(@_) } +sub start_item_text { shift->_init_event(@_) } +sub end_item_bullet { shift->end_item('bullet') } +sub end_item_number { shift->end_item('number') } +sub end_item_text { shift->end_item('definition') } +sub end_item { + my $self = shift; + my $type = shift; + # If there is verbatim text in this item, it will show up as part of + # 'paras', and not part of '_thispara'. If the first para after this is a + # verbatim one, it actually will be (part of) the contents for this item. + if ( $self->{'_thispara'} eq '' + && ( ! @{$self->{'paras'}} + || $self->{'paras'}[0][0] !~ /Verbatim/i)) + { + $self->poderror({ -line => $self->{'_line'}, + -severity => 'WARNING', + -msg => '=item has no contents' }); + } + + $self->node($self->{'_thispara'}); # remember this node +} + +sub start_for { # =for and =begin directives + my ($self, $flags) = @_; + $self->_init_event($flags); + push @{$self->{'_begin_stack'}}, [$self->{'_line'}, $flags->{'target'}]; +} + +sub end_for { + my ($self, $flags) = @_; + my ($line, $target) = @{pop @{$self->{'_begin_stack'}}}; + if ($flags->{'fake-closer'}) { # meaning Pod::Simple generated this =end + $self->poderror({ -line => $line, + -severity => 'ERROR', + -msg => "=begin $target without matching =end $target" + }); + } +} + +sub end_Document { + # Some final error checks + my $self = shift; + + # no POD found here + $self->num_errors(-1) && return unless $self->content_seen; + + my %nodes; + for ($self->node()) { + $nodes{$_} = 1; + if(/^(\S+)\s+\S/) { + # we have more than one word. Use the first as a node, too. + # This is used heavily in perlfunc.pod + $nodes{$1} ||= 2; # derived node + } + } + for ($self->idx()) { + $nodes{$_} = 3; # index node + } + + # XXX update unresolved internal link POD -- single word not enclosed in ""? + # I don't know what I was thinking when I made the above TODO, and I don't + # know what it means... + + for my $link (@{ $self->{'_internal_links'} }) { + my ($name, $line) = @$link; + unless ( $nodes{$name} ) { + $self->poderror({ -line => $line, + -severity => 'ERROR', + -msg => "unresolved internal link '$name'"}); + } + } + + # check the internal nodes for uniqueness. This pertains to + # =headX, =item and X<...> + if ($self->{'-warnings'} > 1 ) { + for my $node (sort keys %{ $self->{'_unique_nodes'} }) { + my $count = $self->{'_unique_nodes'}{$node}; + if ($count > 1) { # not unique + $self->poderror({ + -line => '-', + -severity => 'WARNING', + -msg => "multiple occurrences ($count) of link target ". + "'$node'"}); + } + } + } +} + +######## Formatting codes + +sub start_B { shift->start_fcode('B') } +sub start_C { shift->start_fcode('C') } +sub start_F { shift->start_fcode('F') } +sub start_I { shift->start_fcode('I') } +sub start_S { shift->start_fcode('S') } +sub start_fcode { + my ($self, $fcode) = @_; + unshift @{$self->{'_fcode_stack'}}, $fcode; +} + +sub end_B { shift->end_fcode() } +sub end_C { shift->end_fcode() } +sub end_F { shift->end_fcode() } +sub end_I { shift->end_fcode() } +sub end_S { shift->end_fcode() } +sub end_fcode { + my $self = shift; + $self->_check_fcode(shift @{$self->{'_fcode_stack'}}, # current fcode removed + $self->{'_fcode_stack'}); # previous fcodes +} + +sub start_L { + my ($self, $flags) = @_; + $self->start_fcode('L'); + + my $link = Pod::Checker::Hyperlink->new($flags, $self); + if ($link) { + if ( $link->type eq 'pod' + && $link->node + # It's an internal-to-this-page link if no page is given, or + # if the given one is to our NAME. + && (! $link->page || ( $self->{'_pod_name'} + && $link->page eq $self->{'_pod_name'}))) + { + push @{ $self->{'_internal_links'} }, [ $link->{'-raw_node'}, $link->line ]; + } + else { + $self->hyperlink($link); + } + } +} + +sub end_L { + my $self = shift; + $self->end_fcode(); +} + +sub start_X { + my $self = shift; + $self->start_fcode('X'); + # keep track of where X<> starts in the paragraph + # (this is a stack so nested X<>s are handled correctly) + push @{$self->{'_fcode_pos'}}, length $self->{'_thispara'}; +} +sub end_X { + my $self = shift; + # extract contents of X<> and replace with '' + my $start = pop @{$self->{'_fcode_pos'}}; # start at the beginning of X<> + my $end = length($self->{'_thispara'}) - $start; # end at end of X<> + my $x = substr($self->{'_thispara'}, $start, $end, ''); + if ($x eq "") { + $self->poderror({ -line => $self->{'_line'}, + -severity => 'ERROR', + -msg => "An empty X<>" }); + } + $self->idx($x); # remember this node + $self->end_fcode(); +} + +package Pod::Checker::Hyperlink; + +# This class is used to represent L<> link structures, so that the individual +# elements are easily accessible. It is based on code in Pod::Hyperlink + +sub new { + my ($class, + $simple_link, # The link structure returned by Pod::Simple + $caller # The caller class + ) = @_; + + my $self = +{}; + bless $self, $class; + + $self->{'-line'} ||= $caller->{'_line'}; + $self->{'-type'} ||= $simple_link->{'type'}; + + # Force stringification of page and node. (This expands any E<>.) + $self->{'-page'} = exists $simple_link->{'to'} ? "$simple_link->{'to'}" : ""; + $self->{'-node'} = exists $simple_link->{'section'} ? "$simple_link->{'section'}" : ""; + + # Save the unmodified node text, as the .t files are expecting the message + # for internal link failures to include it (hence this preserves backward + # compatibility). + $self->{'-raw_node'} = $self->{'-node'}; + + # Remove leading/trailing white space. Pod::Simple already warns about + # these, so if the only error is this, and the link is otherwise correct, + # only the Pod::Simple warning will be output, avoiding unnecessary + # confusion. + $self->{'-page'} =~ s/ ^ \s+ //x; + $self->{'-page'} =~ s/ \s+ $ //x; + + $self->{'-node'} =~ s/ ^ \s+ //x; + $self->{'-node'} =~ s/ \s+ $ //x; + + # Pod::Simple warns about L<> and L< >, but not L + if ($self->{'-page'} eq "" && $self->{'-node'} eq "") { + $caller->poderror({ -line => $caller->{'_line'}, + -severity => 'WARNING', + -msg => 'empty link'}); + return; + } + + return $self; +} + +=item line() + +Returns the approximate line number in which the link was encountered + +=cut + +sub line { + return $_[0]->{-line}; +} + +=item type() + +Returns the type of the link; one of: +C<"url"> for things like +C, C<"man"> for man pages, or C<"pod">. + +=cut + +sub type { + return $_[0]->{-type}; +} + +=item page() + +Returns the linked-to page or url. + +=cut + +sub page { + return $_[0]->{-page}; +} + +=item node() + +Returns the anchor or node within the linked-to page, or an empty string +(C<"">) if none appears in the link. + +=back + +=cut + +sub node { + return $_[0]->{-node}; +} + +=head1 AUTHOR + +Please report bugs using L. + +Brad Appleton Ebradapp@enteract.comE (initial version), +Marek Rouchal Emarekr@cpan.orgE, +Marc Green Emarcgreen@cpan.orgE (port to Pod::Simple) +Ricardo Signes Erjbs@cpan.orgE (more porting to Pod::Simple) +Karl Williamson Ekhw@cpan.orgE (more porting to Pod::Simple) + +Based on code for B written by +Tom Christiansen Etchrist@mox.perl.comE + +=cut + +1 diff --git a/cpan/Pod-Checker/scripts/podchecker.PL b/cpan/Pod-Checker/scripts/podchecker.PL index 2c33e8c..44bcfc5 100644 --- a/cpan/Pod-Checker/scripts/podchecker.PL +++ b/cpan/Pod-Checker/scripts/podchecker.PL @@ -1,186 +1,185 @@ -#!/usr/local/bin/perl - -use Config; -use File::Basename qw(&basename &dirname); -use Cwd; - -# List explicitly here the variables you want Configure to -# generate. Metaconfig only looks for shell variables, so you -# have to mention them as if they were shell variables, not -# %Config entries. Thus you write -# $startperl -# to ensure Configure will look for $Config{startperl}. - -# This forces PL files to create target in same directory as PL file. -# This is so that make depend always knows where to find PL derivatives. -$origdir = cwd; -chdir(dirname($0)); -($file = basename($0)) =~ s/\.PL$//; -$file =~ s/\.pl$// - if ($^O eq 'VMS' or $^O eq 'os2' or $^O eq 'dos'); # "case-forgiving" -$file .= '.com' if $^O eq 'VMS'; - -open OUT,">$file" or die "Can't create $file: $!"; - -print "Extracting $file (with variable substitutions)\n"; - -# In this section, perl variables will be expanded during extraction. -# You can use $Config{...} to use Configure variables. - -print OUT <<"!GROK!THIS!"; -$Config{'startperl'} - eval 'exec perl -S \$0 "\$@"' - if 0; -!GROK!THIS! - -# In the following, perl variables are not expanded during extraction. - -print OUT <<'!NO!SUBS!'; -############################################################################# -# podchecker -- command to invoke the podchecker function in Pod::Checker -# -# Copyright (c) 1998-2000 by Bradford Appleton. All rights reserved. -# This file is part of "PodParser". PodParser is free software; -# you can redistribute it and/or modify it under the same terms -# as Perl itself. -############################################################################# - -use strict; -#use diagnostics; - -=head1 NAME - -podchecker - check the syntax of POD format documentation files - -=head1 SYNOPSIS - -B [B<-help>] [B<-man>] [B<-(no)warnings>] [IS< >...] - -=head1 OPTIONS AND ARGUMENTS - -=over 8 - -=item B<-help> - -Print a brief help message and exit. - -=item B<-man> - -Print the manual page and exit. - -=item B<-warnings> B<-nowarnings> - -Turn on/off printing of warnings. Repeating B<-warnings> increases the -warning level, i.e. more warnings are printed. Currently increasing to -level two causes flagging of unescaped "E,E" characters. - -=item I - -The pathname of a POD file to syntax-check (defaults to standard input). - -=back - -=head1 DESCRIPTION - -B will read the given input files looking for POD -syntax errors in the POD documentation and will print any errors -it find to STDERR. At the end, it will print a status message -indicating the number of errors found. - -Directories are ignored, an appropriate warning message is printed. - -B invokes the B function exported by B -Please see L for more details. - -=head1 RETURN VALUE - -B returns a 0 (zero) exit status if all specified -POD files are ok. - -=head1 ERRORS - -B returns the exit status 1 if at least one of -the given POD files has syntax errors. - -The status 2 indicates that at least one of the specified -files does not contain I POD commands. - -Status 1 overrides status 2. If you want unambiguous -results, call B with one single argument only. - -=head1 SEE ALSO - -L and L - -=head1 AUTHORS - -Please report bugs using L. - -Brad Appleton Ebradapp@enteract.comE, -Marek Rouchal Emarekr@cpan.orgE - -Based on code for B written by -Tom Christiansen Etchrist@mox.perl.comE - -=cut - - -use Pod::Checker; -use Pod::Usage; -use Getopt::Long; - -## Define options -my %options; - -## Parse options -GetOptions(\%options, qw(help man warnings+ nowarnings)) || pod2usage(2); -pod2usage(1) if ($options{help}); -pod2usage(-verbose => 2) if ($options{man}); - -if($options{nowarnings}) { - $options{warnings} = 0; -} -elsif(!defined $options{warnings}) { - $options{warnings} = 1; # default is warnings on -} - -## Dont default to STDIN if connected to a terminal -pod2usage(2) if ((@ARGV == 0) && (-t STDIN)); - -## Invoke podchecker() -my $status = 0; -@ARGV = qw(-) unless(@ARGV); -for my $podfile (@ARGV) { - if($podfile eq '-') { - $podfile = '<&STDIN'; - } - elsif(-d $podfile) { - warn "podchecker: Warning: Ignoring directory '$podfile'\n"; - next; - } - my $errors = - podchecker($podfile, undef, '-warnings' => $options{warnings}); - if($errors > 0) { - # errors occurred - $status = 1; - printf STDERR ("%s has %d pod syntax %s.\n", - $podfile, $errors, - ($errors == 1) ? 'error' : 'errors'); - } - elsif($errors < 0) { - # no pod found - $status = 2 unless($status); - print STDERR "$podfile does not contain any pod commands.\n"; - } - else { - print STDERR "$podfile pod syntax OK.\n"; - } -} -exit $status; - -!NO!SUBS! - -close OUT or die "Can't close $file: $!"; -chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; -exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; -chdir $origdir; +#!/usr/local/bin/perl + +use Config; +use File::Basename qw(&basename &dirname); +use Cwd; + +# List explicitly here the variables you want Configure to +# generate. Metaconfig only looks for shell variables, so you +# have to mention them as if they were shell variables, not +# %Config entries. Thus you write +# $startperl +# to ensure Configure will look for $Config{startperl}. + +# This forces PL files to create target in same directory as PL file. +# This is so that make depend always knows where to find PL derivatives. +$origdir = cwd; +chdir(dirname($0)); +($file = basename($0)) =~ s/\.PL$//; +$file =~ s/\.pl$// + if ($^O eq 'VMS' or $^O eq 'os2' or $^O eq 'dos'); # "case-forgiving" +$file .= '.com' if $^O eq 'VMS'; + +open OUT,">$file" or die "Can't create $file: $!"; + +print "Extracting $file (with variable substitutions)\n"; + +# In this section, perl variables will be expanded during extraction. +# You can use $Config{...} to use Configure variables. + +print OUT <<"!GROK!THIS!"; +$Config{'startperl'} + eval 'exec perl -S \$0 "\$@"' + if 0; +!GROK!THIS! + +# In the following, perl variables are not expanded during extraction. + +print OUT <<'!NO!SUBS!'; +############################################################################# +# podchecker -- command to invoke the podchecker function in Pod::Checker +# +# Copyright (c) 1998-2000 by Bradford Appleton. All rights reserved. +# This is free software; you can redistribute it and/or modify it under the +# same terms as Perl itself. +############################################################################# + +use strict; +#use diagnostics; + +=head1 NAME + +podchecker - check the syntax of POD format documentation files + +=head1 SYNOPSIS + +B [B<-help>] [B<-man>] [B<-(no)warnings>] [IS< >...] + +=head1 OPTIONS AND ARGUMENTS + +=over 8 + +=item B<-help> + +Print a brief help message and exit. + +=item B<-man> + +Print the manual page and exit. + +=item B<-warnings> B<-nowarnings> + +Turn on/off printing of warnings. Repeating B<-warnings> increases the +warning level, i.e. more warnings are printed. Currently increasing to +level two causes flagging of unescaped "E,E" characters. + +=item I + +The pathname of a POD file to syntax-check (defaults to standard input). + +=back + +=head1 DESCRIPTION + +B will read the given input files looking for POD +syntax errors in the POD documentation and will print any errors +it find to STDERR. At the end, it will print a status message +indicating the number of errors found. + +Directories are ignored, an appropriate warning message is printed. + +B invokes the B function exported by B +Please see L for more details. + +=head1 RETURN VALUE + +B returns a 0 (zero) exit status if all specified +POD files are ok. + +=head1 ERRORS + +B returns the exit status 1 if at least one of +the given POD files has syntax errors. + +The status 2 indicates that at least one of the specified +files does not contain I POD commands. + +Status 1 overrides status 2. If you want unambiguous +results, call B with one single argument only. + +=head1 SEE ALSO + +L and L + +=head1 AUTHORS + +Please report bugs using L. + +Brad Appleton Ebradapp@enteract.comE, +Marek Rouchal Emarekr@cpan.orgE + +Based on code for B written by +Tom Christiansen Etchrist@mox.perl.comE + +=cut + + +use Pod::Checker; +use Pod::Usage; +use Getopt::Long; + +## Define options +my %options; + +## Parse options +GetOptions(\%options, qw(help man warnings+ nowarnings)) || pod2usage(2); +pod2usage(1) if ($options{help}); +pod2usage(-verbose => 2) if ($options{man}); + +if($options{nowarnings}) { + $options{warnings} = 0; +} +elsif(!defined $options{warnings}) { + $options{warnings} = 1; # default is warnings on +} + +## Dont default to STDIN if connected to a terminal +pod2usage(2) if ((@ARGV == 0) && (-t STDIN)); + +## Invoke podchecker() +my $status = 0; +@ARGV = qw(-) unless(@ARGV); +for my $podfile (@ARGV) { + if($podfile eq '-') { + $podfile = '<&STDIN'; + } + elsif(-d $podfile) { + warn "podchecker: Warning: Ignoring directory '$podfile'\n"; + next; + } + my $errors = + podchecker($podfile, undef, '-warnings' => $options{warnings}); + if($errors > 0) { + # errors occurred + $status = 1; + printf STDERR ("%s has %d pod syntax %s.\n", + $podfile, $errors, + ($errors == 1) ? 'error' : 'errors'); + } + elsif($errors < 0) { + # no pod found + $status = 2 unless($status); + print STDERR "$podfile does not contain any pod commands.\n"; + } + else { + print STDERR "$podfile pod syntax OK.\n"; + } +} +exit $status; + +!NO!SUBS! + +close OUT or die "Can't close $file: $!"; +chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; +exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; +chdir $origdir; diff --git a/cpan/Pod-Checker/t/pod/contains_bad_pod.xr b/cpan/Pod-Checker/t/pod/contains_bad_pod.xr index c790796..ad65663 100644 --- a/cpan/Pod-Checker/t/pod/contains_bad_pod.xr +++ b/cpan/Pod-Checker/t/pod/contains_bad_pod.xr @@ -1,5 +1,5 @@ -=head foo - -bar baz. - -=cut +=head foo + +bar baz. + +=cut diff --git a/cpan/Pod-Checker/t/pod/podchkenc.t b/cpan/Pod-Checker/t/pod/podchkenc.t index e7a5d7a..ccc2421 100644 --- a/cpan/Pod-Checker/t/pod/podchkenc.t +++ b/cpan/Pod-Checker/t/pod/podchkenc.t @@ -1,29 +1,29 @@ -#!/usr/bin/perl -BEGIN { - use File::Basename; - my $THISDIR = dirname $0; - unshift @INC, $THISDIR; - require "testpchk.pl"; - import TestPodChecker; -} - -# this tests Pod::Checker accepts =encoding directive - -my %options = map { $_ => 1 } @ARGV; ## convert cmdline to options-hash -my $passed = testpodchecker \%options, $0; -exit( ($passed == 1) ? 0 : -1 ) unless $ENV{HARNESS_ACTIVE}; - -__END__ - -=encoding utf8 - -=encode utf8 - -dummy error - -=head1 An example. - -'Twas brillig, and the slithy toves did gyre and gimble in the wabe. - -=cut - +#!/usr/bin/perl +BEGIN { + use File::Basename; + my $THISDIR = dirname $0; + unshift @INC, $THISDIR; + require "testpchk.pl"; + import TestPodChecker; +} + +# this tests Pod::Checker accepts =encoding directive + +my %options = map { $_ => 1 } @ARGV; ## convert cmdline to options-hash +my $passed = testpodchecker \%options, $0; +exit( ($passed == 1) ? 0 : -1 ) unless $ENV{HARNESS_ACTIVE}; + +__END__ + +=encoding utf8 + +=encode utf8 + +dummy error + +=head1 An example. + +'Twas brillig, and the slithy toves did gyre and gimble in the wabe. + +=cut + diff --git a/cpan/Pod-Checker/t/pod/podchkenc.xr b/cpan/Pod-Checker/t/pod/podchkenc.xr index 8a21a12..4b942e9 100644 --- a/cpan/Pod-Checker/t/pod/podchkenc.xr +++ b/cpan/Pod-Checker/t/pod/podchkenc.xr @@ -1 +1 @@ -*** ERROR: Unknown command 'encode' at line 20 in file t/pod/podchkenc.t +*** ERROR: Unknown directive: =encode at line 20 in file t/pod/podchkenc.t diff --git a/cpan/Pod-Checker/t/pod/podchklink.t b/cpan/Pod-Checker/t/pod/podchklink.t new file mode 100644 index 0000000..ea6dfa7 --- /dev/null +++ b/cpan/Pod-Checker/t/pod/podchklink.t @@ -0,0 +1,275 @@ +#!/usr/bin/perl + +# This tests Pod::Checker::Hyperlink + +use Test::More; +use Pod::Checker; + +my @answers = ( + { + 'line' => 12, + 'node' => 'section', + 'page' => 'manpage', + 'type' => 'pod' + }, + { + 'line' => 14, + 'node' => 'section', + 'page' => '"manpage"', + 'type' => 'pod', + }, + { + 'line' => 16, + 'node' => 'section', + 'page' => 'manpage', + 'type' => 'pod', + }, + { + 'line' => 20, + 'node' => 'section', + 'page' => 'manpage', + 'type' => 'pod', + }, + { + 'line' => 22, + 'node' => 'section', + 'page' => 'manpage', + 'type' => 'pod', + }, + { + 'line' => 24, + 'node' => 'section', + 'page' => 'manpage', + 'type' => 'pod', + }, + { + 'line' => 26, + 'node' => 'section', + 'page' => 'manpage', + 'type' => 'pod', + }, + { + 'line' => 28, + 'node' => 'section', + 'page' => 'manpage', + 'type' => 'pod', + }, + { + 'line' => 30, + 'node' => 'section', + 'page' => 'manpage', + 'type' => 'pod', + }, + { + 'line' => 36, + 'node' => '', + 'page' => 'foo', + 'type' => 'pod', + }, + { + 'line' => 38, + 'node' => '', + 'page' => 'bar', + 'type' => 'pod' + }, + { + 'line' => 40, + 'node' => 'bar', + 'page' => 'foo', + 'type' => 'pod' + }, + { + 'line' => 42, + 'node' => 'baz boo', + 'page' => 'foo', + 'type' => 'pod' + }, + { + 'line' => 50, + 'node' => 'baz boo', + 'page' => 'foo bar', + 'type' => 'pod', + }, + { + 'line' => 59, + 'node' => '', + 'page' => 'foobar', + 'type' => 'pod', + }, + { + 'line' => 61, + 'node' => 'bar', + 'page' => 'foo', + 'type' => 'pod' + }, + { + 'line' => 63, + 'node' => 'Italic text', + 'page' => 'foo', + 'type' => 'pod' + }, + { + 'line' => 65, + 'node' => 'Section with other markup', + 'page' => 'foo|bar', + 'type' => 'pod', + }, + { + 'line' => 67, + 'node' => '', + 'page' => 'chmod', + 'type' => 'pod', + }, + { + 'line' => 69, + 'node' => '', + 'page' => 'chmod(2)', + 'type' => 'man', + }, + { + 'line' => 71, + 'node' => '', + 'page' => 'chmod(2)', + 'type' => 'man', + }, + { + 'line' => 73, + 'node' => '', + 'page' => 'chmod()', + 'type' => 'pod', + }, + { + 'line' => 75, + 'node' => '', + 'page' => 'mailto:foo@cpan.org', + 'type' => 'url', + }, + { + 'line' => 77, + 'node' => '', + 'page' => 'mailto:foo@cpan.org', + 'type' => 'url', + }, + { + 'line' => 79, + 'node' => '', + 'page' => 'http://www.perl.org', + 'type' => 'url', + }, + { + 'line' => 81, + 'node' => '', + 'page' => 'http://www.perl.org', + 'type' => 'url', + }, + ); + +plan 'tests' => @answers * 4 + 2; + +my $checker = Pod::Checker->new( '-quiet' => 1); +$checker->parse_from_file(\*DATA); + +is($checker->num_warnings, 0, "There were no warnings found"); +is($checker->num_errors, 0, "There were no errors found"); + +my @links = $checker->hyperlinks; + +for my $i (0 .. @links - 1) { + is($links[$i]->line(), $answers[$i]->{'line'}, "line() returns '$answers[$i]->{'line'}' correctly"); + is($links[$i]->node(), $answers[$i]->{'node'}, "node() returns '$answers[$i]->{'node'}' correctly"); + is($links[$i]->page(), $answers[$i]->{'page'}, "page() returns '$answers[$i]->{'page'}' correctly"); + is($links[$i]->type(), $answers[$i]->{'type'}, "type() returns '$answers[$i]->{'type'}' correctly"); +} + +__END__ + +=head1 NAME + +basic.pod - Extracted and expanded from podlators; test various link types + +=head1 LINKS + +These are all taken from the Pod::Parser tests. + +Try out I of different ways of specifying references: + +Reference the L + +Reference the L<"manpage"/section> + +Reference the L + +Now try it using the new "|" stuff ... + +Reference the L| + +Reference the L| + +Reference the L| + +Reference the L| + +Reference the L| + +Reference the L| + +And then throw in a few new ones of my own. + +L + +L + +L + +L + +L won't show up because is a link to this page + +L won't show up because is a link to this page + +L won't show up because is a link to this page + +L + +L<"boo var baz"> won't show up because the quotes make it a link to this page + +L won't show up because of blanks (deprecated) make it a link to this +page + +L, L, and L won't show up because are links to this page + +Lbar> + +L|foo/bar> + +L text> + +LbarZ<>/Section C I markup>> + +L + +L + +L + +L + +L + +L + +L + +L + +=head1 bar + +=head2 baz boo + +=head3 boo var baz + +=head4 bar baz + +=cut diff --git a/cpan/Pod-Checker/t/pod/poderrs.t b/cpan/Pod-Checker/t/pod/poderrs.t index 362cbb6..1c86c74 100644 --- a/cpan/Pod-Checker/t/pod/poderrs.t +++ b/cpan/Pod-Checker/t/pod/poderrs.t @@ -1,241 +1,324 @@ -BEGIN { - use File::Basename; - my $THISDIR = dirname $0; - unshift @INC, $THISDIR; - require "testpchk.pl"; - import TestPodChecker; -} - -my %options = map { $_ => 1 } @ARGV; ## convert cmdline to options-hash -my $passed = testpodchecker \%options, $0; -exit( ($passed == 1) ? 0 : -1 ) unless $ENV{HARNESS_ACTIVE}; - -### Deliberately throw in some blank but non-empty lines - -### The above line should contain spaces - - -__END__ - -=head2 This should cause a warning - -=head1 NAME - -poderrors.t - test Pod::Checker on some pod syntax errors - -=unknown1 this is an unknown command with two N -and D interior sequences. - -This is some paragraph text with some unknown interior sequences, -such as Q, -A, -and Y>. - -Now try some unterminated sequences like -I>> - -=head2 Garbled entities - -E -E> -E> -E<0x100> -E<07777> -E<300> - -=head2 Unresolved internal links - -L -L<"end with begin"> -L - -=head2 Some links with problems - -L -L<> -L< aha> -L -L<"Warnings"> this one is ok -L ok too, this POD has an X of the same name -L this is OK -L this is also OK - -=head2 Warnings - -L -L should give warnings as hell - -=over 4 - -=item bla - -=back 200 - -the 200 is evil - -=begin html - -What? - -=end xml - -Xsee these unescaped < and > in the text? - -=head2 Misc - -Z should be empty - -X<> should not be empty - -=over four - -This paragrapgh is misplaced - it ought to be an item. - -=item four should be numeric! - -=item - -=item blah - -=item previous is all empty!!! - -=back - -All empty over/back: - -=over 4 - -=back - -item w/o name - -=cut - -=pod bla - -bla is evil - -=cut blub - -blub is evil - -=head2 reoccurence - -=over 4 - -=item Misc - -we already have a head Misc - -=back - -=head2 some heading - -=head2 another one - -=head2 the next line should be empty -=head2 ... but there is a command instead - -And here is some text -=head2 again followed by a command - - verbatim -=item line missing - -previous section is empty! - -=head1 LINK TESTS - -Due to bug reported by Rafael Garcia-Suarez "rgarciasuarez@free.fr": - -The following hyperlinks : -L<"I/O Operators"> -L -trigger a podchecker warning (using bleadperl) : - node 'I/O Operators' contains non-escaped | or / - -=cut - -=pod - -=head1 ON-OFF tests - -The above =pod is OK. The following =cut is ok, the one after not. - -=cut - -# some comment or code here, not POD - -=cut - -# more code - -=head2 This opens POD - -=pod - -And the =pod above is too much. - -=cut - +BEGIN { + use File::Basename; + my $THISDIR = dirname $0; + unshift @INC, $THISDIR; + require "testpchk.pl"; + import TestPodChecker; +} + +my %options = map { $_ => 1 } @ARGV; ## convert cmdline to options-hash +my $passed = testpodchecker \%options, $0; +exit( ($passed == 1) ? 0 : -1 ) unless $ENV{HARNESS_ACTIVE}; + +### Deliberately throw in some blank but non-empty lines + +### The above line should contain spaces + +#line 18 +__END__ + +=head2 This should cause a warning + +=head1 NAME + +poderrors.t - test Pod::Checker on some pod syntax errors + + GASP! A verbatim paragraph in NAME + +=unknown1 this is an unknown command with two N +and D interior sequences. + +This is some paragraph text with some unknown interior sequences, +such as Q, +A, +and Y>. + +Now try some unterminated sequences like +I>>>>>>>>>>> + +A L to L> + +=head1 Additional tests + +=head2 item without over + +=item oops + +=head2 back without over + +=back + +=head2 over without back + +=over 4 + +=item aaps + +=head2 end without begin + +=end + +=end something + +=head2 begin and begin + +=begin html + +=begin text + +=end text + +=end html + +=head2 begin w/o formatter + +=begin + +=end + +=head2 for w/o formatter + +=for + +something... + +=head2 Nested sequences of the same type + +C>> + +=head2 Garbled entities + +E +E> +E> +E<0x100> +E<07777> +E<300> +E + +=head2 Unresolved internal links + +L +L<"end with begin"> +L + +=head2 Some links with problems + +L +L<> +L< aha> +L +L< weehee > +L<"Warnings"> this one is ok +L ok too, this POD has an X of the same name + +L<< lead >> +L<< trail >> +L<< neither >> +L<<< both >>> + +L<<<<>>>> + +L<<<< >>>> + +L<<<< >>>> + +=head2 Warnings + +L +L should give warnings as hell + +=over 4 + +=item bla + +=back 200 + +the 200 is evil + +Xsee these unescaped < and > in the text? + +=head2 Misc + +Z should be empty + +X<> should not be empty + +X<0> should not generate a warning about being empty + +E<> should not be empty + +=over four + +This paragrapgh is misplaced - it ought to be an item. + +=item four should be numeric! + +=back + +=over 4 + +=item + +=item blah + +=item previous is all empty!!! + +=back + +=over + + This verbatim paragraph should not be here. Spaces are on the line below this + +=item * + +bullet + +=item 1 + +number, uh oh + +=back + +=over + +=item * + +first bullet + +=item 1 + +then number + +=item finally definition + +=back + +=over + +=item 1 + +first number + +=item 3 + +bad numbering + +=item then definition + +=item * + +finally bullet + +=back + +=over + +=item first defintion + +=item * + +then bullet + +=item 1 + +finally number + +=item second definition + + This should not generate an empty =item warning, + because it has verbatim text. + +=back + +Empty over/back: + +=over 4 + +=over 2 + +=back + +=back + +item w/o name + +=cut + +=pod bla + +bla is evil + +=cut blub + +blub is evil + +=head2 reoccurence + +=over 4 + +=item Misc + +we already have a head Misc + +=back + +=head2 some heading + +=head2 another one + +previous section is empty! + +=head1 LINK TESTS + + + + + + + + + + +L +don't trigger a warning because node is quoted + +L<"I/O Operators"> +incorrectly interpreted as 'O Operators in I', but this is deprecated syntax, as per perlpodspec. +no warning due to quotes + +=head1 + +Empty head above and unclosed over/begins below + +=head3 test X I + +=over + +=begin html + +What? + +=begin :xml + +L, +so should generate a warning + +=cut + + diff --git a/cpan/Pod-Checker/t/pod/poderrs.xr b/cpan/Pod-Checker/t/pod/poderrs.xr index c1a80c6..fe7e015 100644 --- a/cpan/Pod-Checker/t/pod/poderrs.xr +++ b/cpan/Pod-Checker/t/pod/poderrs.xr @@ -1,53 +1,78 @@ -*** WARNING: =head2 without preceding higher level at line 20 in file t/pod/poderrs.t -*** WARNING: empty section in previous paragraph at line 22 in file t/pod/poderrs.t -*** ERROR: Unknown command 'unknown1' at line 26 in file t/pod/poderrs.t -*** ERROR: Unknown interior-sequence 'Q' at line 30 in file t/pod/poderrs.t -*** ERROR: Unknown interior-sequence 'A' at line 31 in file t/pod/poderrs.t -*** ERROR: Unknown interior-sequence 'Y' at line 32 in file t/pod/poderrs.t -*** ERROR: Unknown interior-sequence 'V' at line 32 in file t/pod/poderrs.t -*** ERROR: unterminated B<...> at line 36 in file t/pod/poderrs.t -*** ERROR: unterminated I<...> at line 35 in file t/pod/poderrs.t -*** ERROR: unterminated C<...> at line 38 in file t/pod/poderrs.t -*** WARNING: line containing nothing but whitespace in paragraph at line 46 in file t/pod/poderrs.t -*** ERROR: =item without previous =over at line 53 in file t/pod/poderrs.t -*** ERROR: =back without previous =over at line 57 in file t/pod/poderrs.t -*** ERROR: =over on line 61 without closing =back (at head2) at line 65 in file t/pod/poderrs.t -*** ERROR: =end without =begin at line 67 in file t/pod/poderrs.t -*** ERROR: Nested =begin's (first at line 71:html) at line 73 in file t/pod/poderrs.t -*** ERROR: =end without =begin at line 77 in file t/pod/poderrs.t -*** ERROR: No argument for =begin at line 83 in file t/pod/poderrs.t -*** ERROR: =for without formatter specification at line 89 in file t/pod/poderrs.t -*** WARNING: nested commands C<...C<...>...> at line 95 in file t/pod/poderrs.t -*** ERROR: garbled entity E at line 99 in file t/pod/poderrs.t -*** ERROR: garbled entity E> at line 100 in file t/pod/poderrs.t -*** ERROR: garbled entity E> at line 101 in file t/pod/poderrs.t -*** ERROR: Entity number out of range E<0x100> at line 102 in file t/pod/poderrs.t -*** ERROR: Entity number out of range E<07777> at line 103 in file t/pod/poderrs.t -*** ERROR: Entity number out of range E<300> at line 104 in file t/pod/poderrs.t -*** ERROR: malformed link L<> : empty link at line 116 in file t/pod/poderrs.t -*** WARNING: ignoring leading whitespace in link at line 117 in file t/pod/poderrs.t -*** WARNING: ignoring trailing whitespace in link at line 118 in file t/pod/poderrs.t -*** WARNING: (section) in 'passwd(5)' deprecated at line 126 in file t/pod/poderrs.t -*** WARNING: node '$|' contains non-escaped | or / at line 127 in file t/pod/poderrs.t -*** WARNING: alternative text '$|' contains non-escaped | or / at line 127 in file t/pod/poderrs.t -*** ERROR: Spurious character(s) after =back at line 133 in file t/pod/poderrs.t -*** ERROR: Nonempty Z<> at line 147 in file t/pod/poderrs.t -*** ERROR: Empty X<> at line 149 in file t/pod/poderrs.t -*** WARNING: preceding non-item paragraph(s) at line 155 in file t/pod/poderrs.t -*** WARNING: No argument for =item at line 157 in file t/pod/poderrs.t -*** WARNING: previous =item has no contents at line 159 in file t/pod/poderrs.t -*** WARNING: No items in =over (at line 167) / =back list at line 169 in file t/pod/poderrs.t -*** ERROR: Spurious text after =pod at line 175 in file t/pod/poderrs.t -*** ERROR: Spurious text after =cut at line 179 in file t/pod/poderrs.t -*** WARNING: empty section in previous paragraph at line 195 in file t/pod/poderrs.t -*** ERROR: Apparent command =head2 not preceded by blank line at line 198 in file t/pod/poderrs.t -*** WARNING: empty section in previous paragraph at line 197 in file t/pod/poderrs.t -*** ERROR: Apparent command =head2 not preceded by blank line at line 201 in file t/pod/poderrs.t -*** ERROR: Apparent command =item not preceded by blank line at line 204 in file t/pod/poderrs.t -*** ERROR: Spurious =cut command at line 230 in file t/pod/poderrs.t -*** ERROR: Spurious =pod command at line 236 in file t/pod/poderrs.t -*** ERROR: unresolved internal link 'begin or begin' at line 108 in file t/pod/poderrs.t -*** ERROR: unresolved internal link 'end with begin' at line 109 in file t/pod/poderrs.t -*** ERROR: unresolved internal link 'OoPs' at line 110 in file t/pod/poderrs.t -*** ERROR: unresolved internal link 'abc def' at line 114 in file t/pod/poderrs.t -*** ERROR: unresolved internal link 'I/O Operators' at line 213 in file t/pod/poderrs.t +*** WARNING: =head2 without preceding higher level at line 20 in file t/pod/poderrs.t +*** WARNING: empty section in previous paragraph at line 22 in file t/pod/poderrs.t +*** WARNING: Verbatim paragraph in NAME section at line 26 in file t/pod/poderrs.t +*** ERROR: Unknown directive: =unknown1 at line 28 in file t/pod/poderrs.t +*** ERROR: Deleting unknown formatting code Q<> at line 31 in file t/pod/poderrs.t +*** ERROR: Deleting unknown formatting code A<> at line 31 in file t/pod/poderrs.t +*** ERROR: Deleting unknown formatting code Y<> at line 31 in file t/pod/poderrs.t +*** ERROR: Deleting unknown formatting code V<> at line 31 in file t/pod/poderrs.t +*** ERROR: Unterminated I> sequence at line 36 in file t/pod/poderrs.t +*** ERROR: Unterminated C<...> sequence at line 40 in file t/pod/poderrs.t +*** WARNING: line containing nothing but whitespace in paragraph at line 48 in file t/pod/poderrs.t +*** WARNING: nested commands X<...X<...>...> at line 51 in file t/pod/poderrs.t +*** WARNING: nested commands S<...S<...>...> at line 51 in file t/pod/poderrs.t +*** WARNING: nested commands C<...C<...>...> at line 51 in file t/pod/poderrs.t +*** WARNING: nested commands I<...I<...>...> at line 51 in file t/pod/poderrs.t +*** WARNING: nested commands F<...F<...>...> at line 51 in file t/pod/poderrs.t +*** WARNING: nested commands B<...B<...>...> at line 51 in file t/pod/poderrs.t +*** ERROR: '=item' outside of any '=over' at line 59 in file t/pod/poderrs.t +*** ERROR: You forgot a '=back' before '=head2' at line 61 in file t/pod/poderrs.t +*** ERROR: =back without =over at line 63 in file t/pod/poderrs.t +*** WARNING: empty section in previous paragraph at line 65 in file t/pod/poderrs.t +*** ERROR: You forgot a '=back' before '=head2' at line 71 in file t/pod/poderrs.t +*** ERROR: '=end' without a target? at line 73 in file t/pod/poderrs.t +*** ERROR: =end something without matching =begin. (Stack: [empty]) at line 75 in file t/pod/poderrs.t +*** WARNING: empty section in previous paragraph at line 77 in file t/pod/poderrs.t +*** ERROR: =begin without a target? at line 89 in file t/pod/poderrs.t +*** ERROR: '=end' without a target? at line 91 in file t/pod/poderrs.t +*** WARNING: empty section in previous paragraph at line 93 in file t/pod/poderrs.t +*** ERROR: =for without a target? at line 95 in file t/pod/poderrs.t +*** WARNING: nested commands C<...C<...>...> at line 101 in file t/pod/poderrs.t +*** ERROR: Unknown E content in E at line 105 in file t/pod/poderrs.t +*** ERROR: An E<...> surrounding strange content at line 105 in file t/pod/poderrs.t +*** ERROR: An E<...> surrounding strange content at line 105 in file t/pod/poderrs.t +*** ERROR: Unknown E content in E at line 105 in file t/pod/poderrs.t +*** ERROR: An empty L<> at line 121 in file t/pod/poderrs.t +*** ERROR: L<> starts or ends with whitespace at line 121 in file t/pod/poderrs.t +*** ERROR: L<> starts or ends with whitespace at line 121 in file t/pod/poderrs.t +*** ERROR: L<> starts or ends with whitespace at line 121 in file t/pod/poderrs.t +*** ERROR: Unterminated L<<< ... >>> sequence at line 137 in file t/pod/poderrs.t +*** ERROR: Unterminated L<<< ... >>> sequence at line 139 in file t/pod/poderrs.t +*** ERROR: alternative text 'some text with / in it' contains non-escaped | or / at line 143 in file t/pod/poderrs.t +*** ERROR: =back doesn't take any parameters, but you said =back 200 at line 150 in file t/pod/poderrs.t +*** ERROR: A non-empty Z<> at line 158 in file t/pod/poderrs.t +*** ERROR: An empty X<> at line 160 in file t/pod/poderrs.t +*** ERROR: An empty E<> at line 164 in file t/pod/poderrs.t +*** ERROR: =over should be: '=over' or '=over positive_number' at line 166 in file t/pod/poderrs.t +*** ERROR: You can't have =items (as at line 170) unless the first thing after the =over is an =item at line 166 in file t/pod/poderrs.t +*** WARNING: =item has no contents at line 176 in file t/pod/poderrs.t +*** ERROR: Expected '=item *' at line 178 in file t/pod/poderrs.t +*** ERROR: Expected '=item *' at line 180 in file t/pod/poderrs.t +*** WARNING: line containing nothing but whitespace in paragraph at line 187 in file t/pod/poderrs.t +*** ERROR: You can't have =items (as at line 188) unless the first thing after the =over is an =item at line 184 in file t/pod/poderrs.t +*** ERROR: Expected '=item *' at line 204 in file t/pod/poderrs.t +*** ERROR: Expected '=item *' at line 208 in file t/pod/poderrs.t +*** ERROR: You have '=item 3' instead of the expected '=item 2' at line 218 in file t/pod/poderrs.t +*** ERROR: Expected '=item 3' at line 222 in file t/pod/poderrs.t +*** ERROR: Expected '=item 4' at line 224 in file t/pod/poderrs.t +*** ERROR: Expected text after =item, not a bullet at line 234 in file t/pod/poderrs.t +*** ERROR: Expected text after =item, not a number at line 238 in file t/pod/poderrs.t +*** WARNING: empty =over/=back block at line 253 in file t/pod/poderrs.t +*** ERROR: Spurious text after =pod at line 263 in file t/pod/poderrs.t +*** ERROR: Spurious text after =cut at line 267 in file t/pod/poderrs.t +*** WARNING: empty section in previous paragraph at line 283 in file t/pod/poderrs.t +*** ERROR: empty =head1 at line 305 in file t/pod/poderrs.t +*** ERROR: =over without closing =back at line 311 in file t/pod/poderrs.t +*** ERROR: =begin :xml without matching =end :xml at line 317 in file t/pod/poderrs.t +*** ERROR: =begin html without matching =end html at line 313 in file t/pod/poderrs.t +*** ERROR: unresolved internal link 'begin or begin' at line 115 in file t/pod/poderrs.t +*** ERROR: unresolved internal link 'end with begin' at line 115 in file t/pod/poderrs.t +*** ERROR: unresolved internal link 'OoPs' at line 115 in file t/pod/poderrs.t +*** ERROR: unresolved internal link 'abc def' at line 121 in file t/pod/poderrs.t +*** ERROR: unresolved internal link ' aha' at line 121 in file t/pod/poderrs.t +*** ERROR: unresolved internal link 'oho ' at line 121 in file t/pod/poderrs.t +*** ERROR: unresolved internal link ' weehee ' at line 121 in file t/pod/poderrs.t +*** ERROR: unresolved internal link 'link_to_nowhere' at line 319 in file t/pod/poderrs.t +*** WARNING: multiple occurrences (2) of link target '*' at line - in file t/pod/poderrs.t +*** WARNING: multiple occurrences (2) of link target '1' at line - in file t/pod/poderrs.t +*** WARNING: multiple occurrences (2) of link target 'Misc' at line - in file t/pod/poderrs.t diff --git a/cpan/Pod-Checker/t/pod/selfcheck.t b/cpan/Pod-Checker/t/pod/selfcheck.t index 3b6e352..d170570 100644 --- a/cpan/Pod-Checker/t/pod/selfcheck.t +++ b/cpan/Pod-Checker/t/pod/selfcheck.t @@ -1,45 +1,45 @@ -#!/usr/bin/perl -use File::Basename; -use File::Spec; -use strict; -my $THISDIR; -BEGIN { - $THISDIR = dirname $0; - unshift @INC, $THISDIR; - require "testpchk.pl"; - import TestPodChecker qw(testpodcheck); -} - -# test that our POD is correct! -my $path = File::Spec->catfile($THISDIR,(File::Spec->updir()) x 2, 'lib', 'Pod', '*.pm'); -print "THISDIR=$THISDIR PATH=$path\n"; -my @pods = glob($path); -print "PODS=@pods\n"; - -print "1..",scalar(@pods),"\n"; - -my $errs = 0; -my $testnum = 1; -foreach my $pod (@pods) { - my $out = File::Spec->catfile($THISDIR, basename($pod)); - $out =~ s{\.pm}{.OUT}; - my %options = ( -Out => $out ); - my $failmsg = testpodcheck(-In => $pod, -Out => $out, -Cmp => "$THISDIR/empty.xr"); - if($failmsg) { - if(open(IN, "<$out")) { - while() { - warn "podchecker: $_"; - } - close(IN); - } else { - warn "Error: Cannot read output file $out: $!\n"; - } - print "not ok $testnum\n"; - $errs++; - } else { - print "ok $testnum\n"; - } - $testnum++; -} -exit( ($errs == 0) ? 0 : -1 ) unless $ENV{HARNESS_ACTIVE}; - +#!/usr/bin/perl +use File::Basename; +use File::Spec; +use strict; +my $THISDIR; +BEGIN { + $THISDIR = dirname $0; + unshift @INC, $THISDIR; + require "testpchk.pl"; + import TestPodChecker qw(testpodcheck); +} + +# test that our POD is correct! +my $path = File::Spec->catfile($THISDIR,(File::Spec->updir()) x 2, 'lib', 'Pod', '*.pm'); +print "THISDIR=$THISDIR PATH=$path\n"; +my @pods = glob($path); +print "PODS=@pods\n"; + +print "1..",scalar(@pods),"\n"; + +my $errs = 0; +my $testnum = 1; +foreach my $pod (@pods) { + my $out = File::Spec->catfile($THISDIR, basename($pod)); + $out =~ s{\.pm}{.OUT}; + my %options = ( -Out => $out ); + my $failmsg = testpodcheck(-In => $pod, -Out => $out, -Cmp => "$THISDIR/empty.xr"); + if($failmsg) { + if(open(IN, "<$out")) { + while() { + warn "podchecker: $_"; + } + close(IN); + } else { + warn "Error: Cannot read output file $out: $!\n"; + } + print "not ok $testnum\n"; + $errs++; + } else { + print "ok $testnum\n"; + } + $testnum++; +} +exit( ($errs == 0) ? 0 : -1 ) unless $ENV{HARNESS_ACTIVE}; + diff --git a/cpan/Pod-Checker/t/pod/testcmp.pl b/cpan/Pod-Checker/t/pod/testcmp.pl index b8592fc..17f0b0b 100644 --- a/cpan/Pod-Checker/t/pod/testcmp.pl +++ b/cpan/Pod-Checker/t/pod/testcmp.pl @@ -1,94 +1,94 @@ -package TestCompare; - -use vars qw(@ISA @EXPORT $MYPKG); -#use strict; -#use diagnostics; -use Carp; -use Exporter; -use File::Basename; -use File::Spec; -use FileHandle; - -@ISA = qw(Exporter); -@EXPORT = qw(&testcmp); -$MYPKG = eval { (caller)[0] }; - -##-------------------------------------------------------------------------- - -=head1 NAME - -testcmp -- compare two files line-by-line - -=head1 SYNOPSIS - - $is_diff = testcmp($file1, $file2); - -or - - $is_diff = testcmp({-cmplines => \&mycmp}, $file1, $file2); - -=head2 DESCRIPTION - -Compare two text files line-by-line and return 0 if they are the -same, 1 if they differ. Each of $file1 and $file2 may be a filenames, -or a filehandles (in which case it must already be open for reading). - -If the first argument is a hashref, then the B<-cmplines> key in the -hash may have a subroutine reference as its corresponding value. -The referenced user-defined subroutine should be a line-comparator -function that takes two pre-chomped text-lines as its arguments -(the first is from $file1 and the second is from $file2). It should -return 0 if it considers the two lines equivalent, and non-zero -otherwise. - -=cut - -##-------------------------------------------------------------------------- - -sub testcmp( $ $ ; $) { - my %opts = ref($_[0]) eq 'HASH' ? %{shift()} : (); - my ($file1, $file2) = @_; - my ($fh1, $fh2) = ($file1, $file2); - unless (ref $fh1) { - $fh1 = FileHandle->new($file1, "r") or die "Can't open $file1: $!"; - } - unless (ref $fh2) { - $fh2 = FileHandle->new($file2, "r") or die "Can't open $file2: $!"; - } - - my $cmplines = $opts{'-cmplines'} || undef; - my ($f1text, $f2text) = ("", ""); - my ($line, $diffs) = (0, 0); - - while ( defined($f1text) and defined($f2text) ) { - defined($f1text = <$fh1>) and chomp($f1text); - defined($f2text = <$fh2>) and chomp($f2text); - ++$line; - last unless ( defined($f1text) and defined($f2text) ); - # kill any extra line endings - $f1text =~ s/[\r\n]+$//s; - $f2text =~ s/[\r\n]+$//s; - $diffs = (ref $cmplines) ? &$cmplines($f1text, $f2text) - : ($f1text ne $f2text); - last if $diffs; - } - close($fh1) unless (ref $file1); - close($fh2) unless (ref $file2); - - $diffs = 1 if (defined($f1text) or defined($f2text)); - if ( defined($f1text) and defined($f2text) ) { - ## these two lines must be different - warn "$file1 and $file2 differ at line $line\n"; - } - elsif (defined($f1text) and (! defined($f1text))) { - ## file1 must be shorter - warn "$file1 is shorter than $file2\n"; - } - elsif (defined $f2text) { - ## file2 must be longer - warn "$file1 is shorter than $file2\n"; - } - return $diffs; -} - -1; +package TestCompare; + +use vars qw(@ISA @EXPORT $MYPKG); +#use strict; +#use diagnostics; +use Carp; +use Exporter; +use File::Basename; +use File::Spec; +use FileHandle; + +@ISA = qw(Exporter); +@EXPORT = qw(&testcmp); +$MYPKG = eval { (caller)[0] }; + +##-------------------------------------------------------------------------- + +=head1 NAME + +testcmp -- compare two files line-by-line + +=head1 SYNOPSIS + + $is_diff = testcmp($file1, $file2); + +or + + $is_diff = testcmp({-cmplines => \&mycmp}, $file1, $file2); + +=head2 DESCRIPTION + +Compare two text files line-by-line and return 0 if they are the +same, 1 if they differ. Each of $file1 and $file2 may be a filenames, +or a filehandles (in which case it must already be open for reading). + +If the first argument is a hashref, then the B<-cmplines> key in the +hash may have a subroutine reference as its corresponding value. +The referenced user-defined subroutine should be a line-comparator +function that takes two pre-chomped text-lines as its arguments +(the first is from $file1 and the second is from $file2). It should +return 0 if it considers the two lines equivalent, and non-zero +otherwise. + +=cut + +##-------------------------------------------------------------------------- + +sub testcmp( $ $ ; $) { + my %opts = ref($_[0]) eq 'HASH' ? %{shift()} : (); + my ($file1, $file2) = @_; + my ($fh1, $fh2) = ($file1, $file2); + unless (ref $fh1) { + $fh1 = FileHandle->new($file1, "r") or die "Can't open $file1: $!"; + } + unless (ref $fh2) { + $fh2 = FileHandle->new($file2, "r") or die "Can't open $file2: $!"; + } + + my $cmplines = $opts{'-cmplines'} || undef; + my ($f1text, $f2text) = ("", ""); + my ($line, $diffs) = (0, 0); + + while ( defined($f1text) and defined($f2text) ) { + defined($f1text = <$fh1>) and chomp($f1text); + defined($f2text = <$fh2>) and chomp($f2text); + ++$line; + last unless ( defined($f1text) and defined($f2text) ); + # kill any extra line endings + $f1text =~ s/[\r\n]+$//s; + $f2text =~ s/[\r\n]+$//s; + $diffs = (ref $cmplines) ? &$cmplines($f1text, $f2text) + : ($f1text ne $f2text); + last if $diffs; + } + close($fh1) unless (ref $file1); + close($fh2) unless (ref $file2); + + $diffs = 1 if (defined($f1text) or defined($f2text)); + if ( defined($f1text) and defined($f2text) ) { + ## these two lines must be different + warn "$file1 and $file2 differ at line $line\n"; + } + elsif (defined($f1text) and (! defined($f1text))) { + ## file1 must be shorter + warn "$file1 is shorter than $file2\n"; + } + elsif (defined $f2text) { + ## file2 must be longer + warn "$file1 is shorter than $file2\n"; + } + return $diffs; +} + +1; diff --git a/cpan/Pod-Checker/t/pod/testpchk.pl b/cpan/Pod-Checker/t/pod/testpchk.pl index 0464a9a..8517cbd 100644 --- a/cpan/Pod-Checker/t/pod/testpchk.pl +++ b/cpan/Pod-Checker/t/pod/testpchk.pl @@ -1,130 +1,131 @@ -package TestPodChecker; - -BEGIN { - use File::Basename; - use File::Spec; - push @INC, '..'; - my $THISDIR = dirname $0; - unshift @INC, $THISDIR; - require "testcmp.pl"; - import TestCompare; - my $PARENTDIR = dirname $THISDIR; - push @INC, map { File::Spec->catfile($_, 'lib') } ($PARENTDIR, $THISDIR); - require VMS::Filespec if $^O eq 'VMS'; -} - -use Pod::Checker; -use vars qw(@ISA @EXPORT $MYPKG); -#use strict; -#use diagnostics; -use Carp; -use Exporter; -#use File::Compare; - -@ISA = qw(Exporter); -@EXPORT = qw(&testpodchecker); -@EXPORT_OK = qw(&testpodcheck); -$MYPKG = eval { (caller)[0] }; - -sub stripname( $ ) { - local $_ = shift; - return /(\w[.\w]*)\s*$/ ? $1 : $_; -} - -sub msgcmp( $ $ ) { - ## filter out platform-dependent aspects of error messages - my ($line1, $line2) = @_; - for ($line1, $line2) { - ## remove filenames from error messages to avoid any - ## filepath naming differences between OS platforms - s/(at line \S+ in file) .*\W(\w+\.[tT])\s*$/$1 \L$2\E/; - s/.*\W(\w+\.[tT]) (has \d+ pod syntax error)/\L$1\E $2/; - } - return ($line1 ne $line2); -} - -sub testpodcheck( @ ) { - my %args = @_; - my $infile = $args{'-In'} || croak "No input file given!"; - my $outfile = $args{'-Out'} || croak "No output file given!"; - my $cmpfile = $args{'-Cmp'} || croak "No compare-result file given!"; - - my $different = ''; - my $testname = basename $infile, '.t', '.xr'; - - unless (-e $cmpfile) { - my $msg = "*** Can't find comparison file $cmpfile for testing $infile"; - warn "$msg\n"; - return $msg; - } - - print "# Running podchecker for '$testname'...\n"; - ## Compare the output against the expected result - if ($^O eq 'VMS') { - for ($infile, $outfile, $cmpfile) { - $_ = VMS::Filespec::unixify($_) unless ref; - } - } - podchecker($infile, $outfile); - if ( testcmp({'-cmplines' => \&msgcmp}, $outfile, $cmpfile) ) { - $different = "$outfile is different from $cmpfile"; - } - else { - unlink($outfile); - } - return $different; -} - -sub testpodchecker( @ ) { - my %opts = (ref $_[0] eq 'HASH') ? %{shift()} : (); - my @testpods = @_; - my ($testname, $testdir) = ("", ""); - my ($podfile, $cmpfile) = ("", ""); - my ($outfile, $errfile) = ("", ""); - my $passes = 0; - my $failed = 0; - local $_; - - print "1..", scalar @testpods, "\n" unless ($opts{'-xrgen'}); - - for $podfile (@testpods) { - ($testname, $_) = fileparse($podfile); - $testdir ||= $_; - $testname =~ s/\.t$//; - $cmpfile = $testdir . $testname . '.xr'; - $outfile = $testdir . $testname . '.OUT'; - - if ($opts{'-xrgen'}) { - if ($opts{'-force'} or ! -e $cmpfile) { - ## Create the comparison file - print "# Creating expected result for \"$testname\"" . - " podchecker test ...\n"; - podchecker($podfile, $cmpfile); - } - else { - print "# File $cmpfile already exists" . - " (use '-force' to regenerate it).\n"; - } - next; - } - - my $failmsg = testpodcheck - -In => $podfile, - -Out => $outfile, - -Cmp => $cmpfile; - if ($failmsg) { - ++$failed; - print "#\tFAILED. ($failmsg)\n"; - print "not ok ", $failed+$passes, "\n"; - } - else { - ++$passes; - unlink($outfile); - print "#\tPASSED.\n"; - print "ok ", $failed+$passes, "\n"; - } - } - return $passes; -} - -1; +package TestPodChecker; + +BEGIN { + use File::Basename; + use File::Spec; + push @INC, '..'; + my $THISDIR = dirname $0; + unshift @INC, $THISDIR; + require "testcmp.pl"; + import TestCompare; + my $PARENTDIR = dirname $THISDIR; + push @INC, map { File::Spec->catfile($_, 'lib') } ($PARENTDIR, $THISDIR); + require VMS::Filespec if $^O eq 'VMS'; +} + +use Pod::Checker; +use vars qw(@ISA @EXPORT $MYPKG); +#use strict; +#use diagnostics; +use Carp; +use Exporter; +#use File::Compare; + +@ISA = qw(Exporter); +@EXPORT = qw(&testpodchecker); +@EXPORT_OK = qw(&testpodcheck); +$MYPKG = eval { (caller)[0] }; + +sub stripname( $ ) { + local $_ = shift; + return /(\w[.\w]*)\s*$/ ? $1 : $_; +} + +sub msgcmp( $ $ ) { + ## filter out platform-dependent aspects of error messages + my ($line1, $line2) = @_; + for ($line1, $line2) { + ## remove filenames from error messages to avoid any + ## filepath naming differences between OS platforms + s/(at line \S+ in file) .*\W(\w+\.[tT])\s*$/$1 \L$2\E/; + s/.*\W(\w+\.[tT]) (has \d+ pod syntax error)/\L$1\E $2/; + } + return ($line1 ne $line2); +} + +sub testpodcheck( @ ) { + my %args = @_; + my $infile = $args{'-In'} || croak "No input file given!"; + my $outfile = $args{'-Out'} || croak "No output file given!"; + my $cmpfile = $args{'-Cmp'} || croak "No compare-result file given!"; + + my $different = ''; + my $testname = basename $infile, '.t', '.xr'; + + unless (-e $cmpfile) { + my $msg = "*** Can't find comparison file $cmpfile for testing $infile"; + warn "$msg\n"; + return $msg; + } + + print "# Running podchecker for '$testname'...\n"; + ## Compare the output against the expected result + if ($^O eq 'VMS') { + for ($infile, $outfile, $cmpfile) { + $_ = VMS::Filespec::unixify($_) unless ref; + } + } + podchecker($infile, $outfile, -warnings => 200); + if ( testcmp({'-cmplines' => \&msgcmp}, $outfile, $cmpfile) ) { + $different = "$outfile is different from $cmpfile"; + system("diff -u $cmpfile $outfile") if $ENV{TEST_POD_CHECK_DIFF}; + } + else { + unlink($outfile); + } + return $different; +} + +sub testpodchecker( @ ) { + my %opts = (ref $_[0] eq 'HASH') ? %{shift()} : (); + my @testpods = @_; + my ($testname, $testdir) = ("", ""); + my ($podfile, $cmpfile) = ("", ""); + my ($outfile, $errfile) = ("", ""); + my $passes = 0; + my $failed = 0; + local $_; + + print "1..", scalar @testpods, "\n" unless ($opts{'-xrgen'}); + + for $podfile (@testpods) { + ($testname, $_) = fileparse($podfile); + $testdir ||= $_; + $testname =~ s/\.t$//; + $cmpfile = $testdir . $testname . '.xr'; + $outfile = $testdir . $testname . '.OUT'; + + if ($opts{'-xrgen'}) { + if ($opts{'-force'} or ! -e $cmpfile) { + ## Create the comparison file + print "# Creating expected result for \"$testname\"" . + " podchecker test ...\n"; + podchecker($podfile, $cmpfile); + } + else { + print "# File $cmpfile already exists" . + " (use '-force' to regenerate it).\n"; + } + next; + } + + my $failmsg = testpodcheck + -In => $podfile, + -Out => $outfile, + -Cmp => $cmpfile; + if ($failmsg) { + ++$failed; + print "#\tFAILED. ($failmsg)\n"; + print "not ok ", $failed+$passes, "\n"; + } + else { + ++$passes; + unlink($outfile); + print "#\tPASSED.\n"; + print "ok ", $failed+$passes, "\n"; + } + } + return $passes; +} + +1; diff --git a/cpan/Pod-Usage/lib/Pod/Usage.pm b/cpan/Pod-Usage/lib/Pod/Usage.pm index cc4f2e1..8f79850 100644 --- a/cpan/Pod-Usage/lib/Pod/Usage.pm +++ b/cpan/Pod-Usage/lib/Pod/Usage.pm @@ -12,7 +12,7 @@ package Pod::Usage; use strict; use vars qw($VERSION @ISA @EXPORT); -$VERSION = '1.68'; ## Current version of this package +$VERSION = '1.69'; ## Current version of this package require 5.006; ## requires this Perl version or later #use diagnostics; diff --git a/cpan/Pod-Usage/t/inc/Pod/InputObjects.pm b/cpan/Pod-Usage/t/inc/Pod/InputObjects.pm new file mode 100644 index 0000000..c19d4c5 --- /dev/null +++ b/cpan/Pod-Usage/t/inc/Pod/InputObjects.pm @@ -0,0 +1,942 @@ +############################################################################# +# Pod/InputObjects.pm -- package which defines objects for input streams +# and paragraphs and commands when parsing POD docs. +# +# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved. +# This file is part of "PodParser". PodParser is free software; +# you can redistribute it and/or modify it under the same terms +# as Perl itself. +############################################################################# + +package Pod::InputObjects; +use strict; + +use vars qw($VERSION); +$VERSION = '1.60'; ## Current version of this package +require 5.005; ## requires this Perl version or later + +############################################################################# + +=head1 NAME + +Pod::InputObjects - objects representing POD input paragraphs, commands, etc. + +=head1 SYNOPSIS + + use Pod::InputObjects; + +=head1 REQUIRES + +perl5.004, Carp + +=head1 EXPORTS + +Nothing. + +=head1 DESCRIPTION + +This module defines some basic input objects used by B when +reading and parsing POD text from an input source. The following objects +are defined: + +=begin __PRIVATE__ + +=over 4 + +=item package B + +An object corresponding to a source of POD input text. It is mostly a +wrapper around a filehandle or C-type object (or anything +that implements the C method) which keeps track of some +additional information relevant to the parsing of PODs. + +=back + +=end __PRIVATE__ + +=over 4 + +=item package B + +An object corresponding to a paragraph of POD input text. It may be a +plain paragraph, a verbatim paragraph, or a command paragraph (see +L). + +=item package B + +An object corresponding to an interior sequence command from the POD +input text (see L). + +=item package B + +An object corresponding to a tree of parsed POD text. Each "node" in +a parse-tree (or I) is either a text-string or a reference to +a B object. The nodes appear in the parse-tree +in the order in which they were parsed from left-to-right. + +=back + +Each of these input objects are described in further detail in the +sections which follow. + +=cut + +############################################################################# + +package Pod::InputSource; + +##--------------------------------------------------------------------------- + +=begin __PRIVATE__ + +=head1 B + +This object corresponds to an input source or stream of POD +documentation. When parsing PODs, it is necessary to associate and store +certain context information with each input source. All of this +information is kept together with the stream itself in one of these +C objects. Each such object is merely a wrapper around +an C object of some kind (or at least something that +implements the C method). They have the following +methods/attributes: + +=end __PRIVATE__ + +=cut + +##--------------------------------------------------------------------------- + +=begin __PRIVATE__ + +=head2 B + + my $pod_input1 = Pod::InputSource->new(-handle => $filehandle); + my $pod_input2 = new Pod::InputSource(-handle => $filehandle, + -name => $name); + my $pod_input3 = new Pod::InputSource(-handle => \*STDIN); + my $pod_input4 = Pod::InputSource->new(-handle => \*STDIN, + -name => "(STDIN)"); + +This is a class method that constructs a C object and +returns a reference to the new input source object. It takes one or more +keyword arguments in the form of a hash. The keyword C<-handle> is +required and designates the corresponding input handle. The keyword +C<-name> is optional and specifies the name associated with the input +handle (typically a file name). + +=end __PRIVATE__ + +=cut + +sub new { + ## Determine if we were called via an object-ref or a classname + my $this = shift; + my $class = ref($this) || $this; + + ## Any remaining arguments are treated as initial values for the + ## hash that is used to represent this object. Note that we default + ## certain values by specifying them *before* the arguments passed. + ## If they are in the argument list, they will override the defaults. + my $self = { -name => '(unknown)', + -handle => undef, + -was_cutting => 0, + @_ }; + + ## Bless ourselves into the desired class and perform any initialization + bless $self, $class; + return $self; +} + +##--------------------------------------------------------------------------- + +=begin __PRIVATE__ + +=head2 B + + my $filename = $pod_input->name(); + $pod_input->name($new_filename_to_use); + +This method gets/sets the name of the input source (usually a filename). +If no argument is given, it returns a string containing the name of +the input source; otherwise it sets the name of the input source to the +contents of the given argument. + +=end __PRIVATE__ + +=cut + +sub name { + (@_ > 1) and $_[0]->{'-name'} = $_[1]; + return $_[0]->{'-name'}; +} + +## allow 'filename' as an alias for 'name' +*filename = \&name; + +##--------------------------------------------------------------------------- + +=begin __PRIVATE__ + +=head2 B + + my $handle = $pod_input->handle(); + +Returns a reference to the handle object from which input is read (the +one used to contructed this input source object). + +=end __PRIVATE__ + +=cut + +sub handle { + return $_[0]->{'-handle'}; +} + +##--------------------------------------------------------------------------- + +=begin __PRIVATE__ + +=head2 B + + print "Yes.\n" if ($pod_input->was_cutting()); + +The value of the C state (that the B method would +have returned) immediately before any input was read from this input +stream. After all input from this stream has been read, the C +state is restored to this value. + +=end __PRIVATE__ + +=cut + +sub was_cutting { + (@_ > 1) and $_[0]->{-was_cutting} = $_[1]; + return $_[0]->{-was_cutting}; +} + +##--------------------------------------------------------------------------- + +############################################################################# + +package Pod::Paragraph; + +##--------------------------------------------------------------------------- + +=head1 B + +An object representing a paragraph of POD input text. +It has the following methods/attributes: + +=cut + +##--------------------------------------------------------------------------- + +=head2 Pod::Paragraph-EB + + my $pod_para1 = Pod::Paragraph->new(-text => $text); + my $pod_para2 = Pod::Paragraph->new(-name => $cmd, + -text => $text); + my $pod_para3 = new Pod::Paragraph(-text => $text); + my $pod_para4 = new Pod::Paragraph(-name => $cmd, + -text => $text); + my $pod_para5 = Pod::Paragraph->new(-name => $cmd, + -text => $text, + -file => $filename, + -line => $line_number); + +This is a class method that constructs a C object and +returns a reference to the new paragraph object. It may be given one or +two keyword arguments. The C<-text> keyword indicates the corresponding +text of the POD paragraph. The C<-name> keyword indicates the name of +the corresponding POD command, such as C or C (it should +I contain the C<=> prefix); this is needed only if the POD +paragraph corresponds to a command paragraph. The C<-file> and C<-line> +keywords indicate the filename and line number corresponding to the +beginning of the paragraph + +=cut + +sub new { + ## Determine if we were called via an object-ref or a classname + my $this = shift; + my $class = ref($this) || $this; + + ## Any remaining arguments are treated as initial values for the + ## hash that is used to represent this object. Note that we default + ## certain values by specifying them *before* the arguments passed. + ## If they are in the argument list, they will override the defaults. + my $self = { + -name => undef, + -text => (@_ == 1) ? shift : undef, + -file => '', + -line => 0, + -prefix => '=', + -separator => ' ', + -ptree => [], + @_ + }; + + ## Bless ourselves into the desired class and perform any initialization + bless $self, $class; + return $self; +} + +##--------------------------------------------------------------------------- + +=head2 $pod_para-EB + + my $para_cmd = $pod_para->cmd_name(); + +If this paragraph is a command paragraph, then this method will return +the name of the command (I any leading C<=> prefix). + +=cut + +sub cmd_name { + (@_ > 1) and $_[0]->{'-name'} = $_[1]; + return $_[0]->{'-name'}; +} + +## let name() be an alias for cmd_name() +*name = \&cmd_name; + +##--------------------------------------------------------------------------- + +=head2 $pod_para-EB + + my $para_text = $pod_para->text(); + +This method will return the corresponding text of the paragraph. + +=cut + +sub text { + (@_ > 1) and $_[0]->{'-text'} = $_[1]; + return $_[0]->{'-text'}; +} + +##--------------------------------------------------------------------------- + +=head2 $pod_para-EB + + my $raw_pod_para = $pod_para->raw_text(); + +This method will return the I text of the POD paragraph, exactly +as it appeared in the input. + +=cut + +sub raw_text { + return $_[0]->{'-text'} unless (defined $_[0]->{'-name'}); + return $_[0]->{'-prefix'} . $_[0]->{'-name'} . + $_[0]->{'-separator'} . $_[0]->{'-text'}; +} + +##--------------------------------------------------------------------------- + +=head2 $pod_para-EB + + my $prefix = $pod_para->cmd_prefix(); + +If this paragraph is a command paragraph, then this method will return +the prefix used to denote the command (which should be the string "=" +or "=="). + +=cut + +sub cmd_prefix { + return $_[0]->{'-prefix'}; +} + +##--------------------------------------------------------------------------- + +=head2 $pod_para-EB + + my $separator = $pod_para->cmd_separator(); + +If this paragraph is a command paragraph, then this method will return +the text used to separate the command name from the rest of the +paragraph (if any). + +=cut + +sub cmd_separator { + return $_[0]->{'-separator'}; +} + +##--------------------------------------------------------------------------- + +=head2 $pod_para-EB + + my $ptree = $pod_parser->parse_text( $pod_para->text() ); + $pod_para->parse_tree( $ptree ); + $ptree = $pod_para->parse_tree(); + +This method will get/set the corresponding parse-tree of the paragraph's text. + +=cut + +sub parse_tree { + (@_ > 1) and $_[0]->{'-ptree'} = $_[1]; + return $_[0]->{'-ptree'}; +} + +## let ptree() be an alias for parse_tree() +*ptree = \&parse_tree; + +##--------------------------------------------------------------------------- + +=head2 $pod_para-EB + + my ($filename, $line_number) = $pod_para->file_line(); + my $position = $pod_para->file_line(); + +Returns the current filename and line number for the paragraph +object. If called in a list context, it returns a list of two +elements: first the filename, then the line number. If called in +a scalar context, it returns a string containing the filename, followed +by a colon (':'), followed by the line number. + +=cut + +sub file_line { + my @loc = ($_[0]->{'-file'} || '', + $_[0]->{'-line'} || 0); + return (wantarray) ? @loc : join(':', @loc); +} + +##--------------------------------------------------------------------------- + +############################################################################# + +package Pod::InteriorSequence; + +##--------------------------------------------------------------------------- + +=head1 B + +An object representing a POD interior sequence command. +It has the following methods/attributes: + +=cut + +##--------------------------------------------------------------------------- + +=head2 Pod::InteriorSequence-EB + + my $pod_seq1 = Pod::InteriorSequence->new(-name => $cmd + -ldelim => $delimiter); + my $pod_seq2 = new Pod::InteriorSequence(-name => $cmd, + -ldelim => $delimiter); + my $pod_seq3 = new Pod::InteriorSequence(-name => $cmd, + -ldelim => $delimiter, + -file => $filename, + -line => $line_number); + + my $pod_seq4 = new Pod::InteriorSequence(-name => $cmd, $ptree); + my $pod_seq5 = new Pod::InteriorSequence($cmd, $ptree); + +This is a class method that constructs a C object +and returns a reference to the new interior sequence object. It should +be given two keyword arguments. The C<-ldelim> keyword indicates the +corresponding left-delimiter of the interior sequence (e.g. 'E'). +The C<-name> keyword indicates the name of the corresponding interior +sequence command, such as C or C or C. The C<-file> and +C<-line> keywords indicate the filename and line number corresponding +to the beginning of the interior sequence. If the C<$ptree> argument is +given, it must be the last argument, and it must be either string, or +else an array-ref suitable for passing to B (or +it may be a reference to a Pod::ParseTree object). + +=cut + +sub new { + ## Determine if we were called via an object-ref or a classname + my $this = shift; + my $class = ref($this) || $this; + + ## See if first argument has no keyword + if (((@_ <= 2) or (@_ % 2)) and $_[0] !~ /^-\w/) { + ## Yup - need an implicit '-name' before first parameter + unshift @_, '-name'; + } + + ## See if odd number of args + if ((@_ % 2) != 0) { + ## Yup - need an implicit '-ptree' before the last parameter + splice @_, $#_, 0, '-ptree'; + } + + ## Any remaining arguments are treated as initial values for the + ## hash that is used to represent this object. Note that we default + ## certain values by specifying them *before* the arguments passed. + ## If they are in the argument list, they will override the defaults. + my $self = { + -name => (@_ == 1) ? $_[0] : undef, + -file => '', + -line => 0, + -ldelim => '<', + -rdelim => '>', + @_ + }; + + ## Initialize contents if they havent been already + my $ptree = $self->{'-ptree'} || new Pod::ParseTree(); + if ( ref $ptree =~ /^(ARRAY)?$/ ) { + ## We have an array-ref, or a normal scalar. Pass it as an + ## an argument to the ptree-constructor + $ptree = new Pod::ParseTree($1 ? [$ptree] : $ptree); + } + $self->{'-ptree'} = $ptree; + + ## Bless ourselves into the desired class and perform any initialization + bless $self, $class; + return $self; +} + +##--------------------------------------------------------------------------- + +=head2 $pod_seq-EB + + my $seq_cmd = $pod_seq->cmd_name(); + +The name of the interior sequence command. + +=cut + +sub cmd_name { + (@_ > 1) and $_[0]->{'-name'} = $_[1]; + return $_[0]->{'-name'}; +} + +## let name() be an alias for cmd_name() +*name = \&cmd_name; + +##--------------------------------------------------------------------------- + +## Private subroutine to set the parent pointer of all the given +## children that are interior-sequences to be $self + +sub _set_child2parent_links { + my ($self, @children) = @_; + ## Make sure any sequences know who their parent is + for (@children) { + next unless (length and ref and ref ne 'SCALAR'); + if (UNIVERSAL::isa($_, 'Pod::InteriorSequence') or + UNIVERSAL::can($_, 'nested')) + { + $_->nested($self); + } + } +} + +## Private subroutine to unset child->parent links + +sub _unset_child2parent_links { + my $self = shift; + $self->{'-parent_sequence'} = undef; + my $ptree = $self->{'-ptree'}; + for (@$ptree) { + next unless (length and ref and ref ne 'SCALAR'); + $_->_unset_child2parent_links() + if UNIVERSAL::isa($_, 'Pod::InteriorSequence'); + } +} + +##--------------------------------------------------------------------------- + +=head2 $pod_seq-EB + + $pod_seq->prepend($text); + $pod_seq1->prepend($pod_seq2); + +Prepends the given string or parse-tree or sequence object to the parse-tree +of this interior sequence. + +=cut + +sub prepend { + my $self = shift; + $self->{'-ptree'}->prepend(@_); + _set_child2parent_links($self, @_); + return $self; +} + +##--------------------------------------------------------------------------- + +=head2 $pod_seq-EB + + $pod_seq->append($text); + $pod_seq1->append($pod_seq2); + +Appends the given string or parse-tree or sequence object to the parse-tree +of this interior sequence. + +=cut + +sub append { + my $self = shift; + $self->{'-ptree'}->append(@_); + _set_child2parent_links($self, @_); + return $self; +} + +##--------------------------------------------------------------------------- + +=head2 $pod_seq-EB + + $outer_seq = $pod_seq->nested || print "not nested"; + +If this interior sequence is nested inside of another interior +sequence, then the outer/parent sequence that contains it is +returned. Otherwise C is returned. + +=cut + +sub nested { + my $self = shift; + (@_ == 1) and $self->{'-parent_sequence'} = shift; + return $self->{'-parent_sequence'} || undef; +} + +##--------------------------------------------------------------------------- + +=head2 $pod_seq-EB + + my $seq_raw_text = $pod_seq->raw_text(); + +This method will return the I text of the POD interior sequence, +exactly as it appeared in the input. + +=cut + +sub raw_text { + my $self = shift; + my $text = $self->{'-name'} . $self->{'-ldelim'}; + for ( $self->{'-ptree'}->children ) { + $text .= (ref $_) ? $_->raw_text : $_; + } + $text .= $self->{'-rdelim'}; + return $text; +} + +##--------------------------------------------------------------------------- + +=head2 $pod_seq-EB + + my $ldelim = $pod_seq->left_delimiter(); + +The leftmost delimiter beginning the argument text to the interior +sequence (should be "<"). + +=cut + +sub left_delimiter { + (@_ > 1) and $_[0]->{'-ldelim'} = $_[1]; + return $_[0]->{'-ldelim'}; +} + +## let ldelim() be an alias for left_delimiter() +*ldelim = \&left_delimiter; + +##--------------------------------------------------------------------------- + +=head2 $pod_seq-EB + +The rightmost delimiter beginning the argument text to the interior +sequence (should be ">"). + +=cut + +sub right_delimiter { + (@_ > 1) and $_[0]->{'-rdelim'} = $_[1]; + return $_[0]->{'-rdelim'}; +} + +## let rdelim() be an alias for right_delimiter() +*rdelim = \&right_delimiter; + +##--------------------------------------------------------------------------- + +=head2 $pod_seq-EB + + my $ptree = $pod_parser->parse_text($paragraph_text); + $pod_seq->parse_tree( $ptree ); + $ptree = $pod_seq->parse_tree(); + +This method will get/set the corresponding parse-tree of the interior +sequence's text. + +=cut + +sub parse_tree { + (@_ > 1) and $_[0]->{'-ptree'} = $_[1]; + return $_[0]->{'-ptree'}; +} + +## let ptree() be an alias for parse_tree() +*ptree = \&parse_tree; + +##--------------------------------------------------------------------------- + +=head2 $pod_seq-EB + + my ($filename, $line_number) = $pod_seq->file_line(); + my $position = $pod_seq->file_line(); + +Returns the current filename and line number for the interior sequence +object. If called in a list context, it returns a list of two +elements: first the filename, then the line number. If called in +a scalar context, it returns a string containing the filename, followed +by a colon (':'), followed by the line number. + +=cut + +sub file_line { + my @loc = ($_[0]->{'-file'} || '', + $_[0]->{'-line'} || 0); + return (wantarray) ? @loc : join(':', @loc); +} + +##--------------------------------------------------------------------------- + +=head2 Pod::InteriorSequence::B + +This method performs any necessary cleanup for the interior-sequence. +If you override this method then it is B that you invoke +the parent method from within your own method, otherwise +I + +=cut + +sub DESTROY { + ## We need to get rid of all child->parent pointers throughout the + ## tree so their reference counts will go to zero and they can be + ## garbage-collected + _unset_child2parent_links(@_); +} + +##--------------------------------------------------------------------------- + +############################################################################# + +package Pod::ParseTree; + +##--------------------------------------------------------------------------- + +=head1 B + +This object corresponds to a tree of parsed POD text. As POD text is +scanned from left to right, it is parsed into an ordered list of +text-strings and B objects (in order of +appearance). A B object corresponds to this list of +strings and sequences. Each interior sequence in the parse-tree may +itself contain a parse-tree (since interior sequences may be nested). + +=cut + +##--------------------------------------------------------------------------- + +=head2 Pod::ParseTree-EB + + my $ptree1 = Pod::ParseTree->new; + my $ptree2 = new Pod::ParseTree; + my $ptree4 = Pod::ParseTree->new($array_ref); + my $ptree3 = new Pod::ParseTree($array_ref); + +This is a class method that constructs a C object and +returns a reference to the new parse-tree. If a single-argument is given, +it must be a reference to an array, and is used to initialize the root +(top) of the parse tree. + +=cut + +sub new { + ## Determine if we were called via an object-ref or a classname + my $this = shift; + my $class = ref($this) || $this; + + my $self = (@_ == 1 and ref $_[0]) ? $_[0] : []; + + ## Bless ourselves into the desired class and perform any initialization + bless $self, $class; + return $self; +} + +##--------------------------------------------------------------------------- + +=head2 $ptree-EB + + my $top_node = $ptree->top(); + $ptree->top( $top_node ); + $ptree->top( @children ); + +This method gets/sets the top node of the parse-tree. If no arguments are +given, it returns the topmost node in the tree (the root), which is also +a B. If it is given a single argument that is a reference, +then the reference is assumed to a parse-tree and becomes the new top node. +Otherwise, if arguments are given, they are treated as the new list of +children for the top node. + +=cut + +sub top { + my $self = shift; + if (@_ > 0) { + @{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_; + } + return $self; +} + +## let parse_tree() & ptree() be aliases for the 'top' method +*parse_tree = *ptree = \⊤ + +##--------------------------------------------------------------------------- + +=head2 $ptree-EB + +This method gets/sets the children of the top node in the parse-tree. +If no arguments are given, it returns the list (array) of children +(each of which should be either a string or a B. +Otherwise, if arguments are given, they are treated as the new list of +children for the top node. + +=cut + +sub children { + my $self = shift; + if (@_ > 0) { + @{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_; + } + return @{ $self }; +} + +##--------------------------------------------------------------------------- + +=head2 $ptree-EB + +This method prepends the given text or parse-tree to the current parse-tree. +If the first item on the parse-tree is text and the argument is also text, +then the text is prepended to the first item (not added as a separate string). +Otherwise the argument is added as a new string or parse-tree I +the current one. + +=cut + +use vars qw(@ptree); ## an alias used for performance reasons + +sub prepend { + my $self = shift; + local *ptree = $self; + for (@_) { + next unless length; + if (@ptree && !(ref $ptree[0]) && !(ref $_)) { + $ptree[0] = $_ . $ptree[0]; + } + else { + unshift @ptree, $_; + } + } +} + +##--------------------------------------------------------------------------- + +=head2 $ptree-EB + +This method appends the given text or parse-tree to the current parse-tree. +If the last item on the parse-tree is text and the argument is also text, +then the text is appended to the last item (not added as a separate string). +Otherwise the argument is added as a new string or parse-tree I +the current one. + +=cut + +sub append { + my $self = shift; + local *ptree = $self; + my $can_append = @ptree && !(ref $ptree[-1]); + for (@_) { + if (ref) { + push @ptree, $_; + } + elsif(!length) { + next; + } + elsif ($can_append) { + $ptree[-1] .= $_; + } + else { + push @ptree, $_; + } + } +} + +=head2 $ptree-EB + + my $ptree_raw_text = $ptree->raw_text(); + +This method will return the I text of the POD parse-tree +exactly as it appeared in the input. + +=cut + +sub raw_text { + my $self = shift; + my $text = ''; + for ( @$self ) { + $text .= (ref $_) ? $_->raw_text : $_; + } + return $text; +} + +##--------------------------------------------------------------------------- + +## Private routines to set/unset child->parent links + +sub _unset_child2parent_links { + my $self = shift; + local *ptree = $self; + for (@ptree) { + next unless (defined and length and ref and ref ne 'SCALAR'); + $_->_unset_child2parent_links() + if UNIVERSAL::isa($_, 'Pod::InteriorSequence'); + } +} + +sub _set_child2parent_links { + ## nothing to do, Pod::ParseTrees cant have parent pointers +} + +=head2 Pod::ParseTree::B + +This method performs any necessary cleanup for the parse-tree. +If you override this method then it is B +that you invoke the parent method from within your own method, +otherwise I + +=cut + +sub DESTROY { + ## We need to get rid of all child->parent pointers throughout the + ## tree so their reference counts will go to zero and they can be + ## garbage-collected + _unset_child2parent_links(@_); +} + +############################################################################# + +=head1 SEE ALSO + +B is part of the L distribution. + +See L, L + +=head1 AUTHOR + +Please report bugs using L. + +Brad Appleton Ebradapp@enteract.comE + +=cut + +1; diff --git a/cpan/Pod-Usage/t/inc/Pod/Parser.pm b/cpan/Pod-Usage/t/inc/Pod/Parser.pm new file mode 100644 index 0000000..4b4fecf --- /dev/null +++ b/cpan/Pod-Usage/t/inc/Pod/Parser.pm @@ -0,0 +1,1836 @@ +############################################################################# +# Pod/Parser.pm -- package which defines a base class for parsing POD docs. +# +# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved. +# This file is part of "PodParser". PodParser is free software; +# you can redistribute it and/or modify it under the same terms +# as Perl itself. +############################################################################# + +package Pod::Parser; +use strict; + +## These "variables" are used as local "glob aliases" for performance +use vars qw($VERSION @ISA %myData %myOpts @input_stack); +$VERSION = '1.60'; ## Current version of this package +require 5.005; ## requires this Perl version or later + +############################################################################# + +=head1 NAME + +Pod::Parser - base class for creating POD filters and translators + +=head1 SYNOPSIS + + use Pod::Parser; + + package MyParser; + @ISA = qw(Pod::Parser); + + sub command { + my ($parser, $command, $paragraph, $line_num) = @_; + ## Interpret the command and its text; sample actions might be: + if ($command eq 'head1') { ... } + elsif ($command eq 'head2') { ... } + ## ... other commands and their actions + my $out_fh = $parser->output_handle(); + my $expansion = $parser->interpolate($paragraph, $line_num); + print $out_fh $expansion; + } + + sub verbatim { + my ($parser, $paragraph, $line_num) = @_; + ## Format verbatim paragraph; sample actions might be: + my $out_fh = $parser->output_handle(); + print $out_fh $paragraph; + } + + sub textblock { + my ($parser, $paragraph, $line_num) = @_; + ## Translate/Format this block of text; sample actions might be: + my $out_fh = $parser->output_handle(); + my $expansion = $parser->interpolate($paragraph, $line_num); + print $out_fh $expansion; + } + + sub interior_sequence { + my ($parser, $seq_command, $seq_argument) = @_; + ## Expand an interior sequence; sample actions might be: + return "*$seq_argument*" if ($seq_command eq 'B'); + return "`$seq_argument'" if ($seq_command eq 'C'); + return "_${seq_argument}_'" if ($seq_command eq 'I'); + ## ... other sequence commands and their resulting text + } + + package main; + + ## Create a parser object and have it parse file whose name was + ## given on the command-line (use STDIN if no files were given). + $parser = new MyParser(); + $parser->parse_from_filehandle(\*STDIN) if (@ARGV == 0); + for (@ARGV) { $parser->parse_from_file($_); } + +=head1 REQUIRES + +perl5.005, Pod::InputObjects, Exporter, Symbol, Carp + +=head1 EXPORTS + +Nothing. + +=head1 DESCRIPTION + +B is a base class for creating POD filters and translators. +It handles most of the effort involved with parsing the POD sections +from an input stream, leaving subclasses free to be concerned only with +performing the actual translation of text. + +B parses PODs, and makes method calls to handle the various +components of the POD. Subclasses of B override these methods +to translate the POD into whatever output format they desire. + +Note: This module is considered as legacy; modern Perl releases (5.18 and +higher) are going to remove Pod::Parser from core and use L +for all things POD. + +=head1 QUICK OVERVIEW + +To create a POD filter for translating POD documentation into some other +format, you create a subclass of B which typically overrides +just the base class implementation for the following methods: + +=over 2 + +=item * + +B + +=item * + +B + +=item * + +B + +=item * + +B + +=back + +You may also want to override the B and B +methods for your subclass (to perform any needed per-file and/or +per-document initialization or cleanup). + +If you need to perform any preprocessing of input before it is parsed +you may want to override one or more of B and/or +B. + +Sometimes it may be necessary to make more than one pass over the input +files. If this is the case you have several options. You can make the +first pass using B and override your methods to store the +intermediate results in memory somewhere for the B method to +process. You could use B for several passes with an +appropriate state variable to control the operation for each pass. If +your input source can't be reset to start at the beginning, you can +store it in some other structure as a string or an array and have that +structure implement a B method (which is all that +B uses to read input). + +Feel free to add any member data fields you need to keep track of things +like current font, indentation, horizontal or vertical position, or +whatever else you like. Be sure to read L<"PRIVATE METHODS AND DATA"> +to avoid name collisions. + +For the most part, the B base class should be able to +do most of the input parsing for you and leave you free to worry about +how to interpret the commands and translate the result. + +Note that all we have described here in this quick overview is the +simplest most straightforward use of B to do stream-based +parsing. It is also possible to use the B function +to do more sophisticated tree-based parsing. See L<"TREE-BASED PARSING">. + +=head1 PARSING OPTIONS + +A I is simply a named option of B with a +value that corresponds to a certain specified behavior. These various +behaviors of B may be enabled/disabled by setting +or unsetting one or more I using the B method. +The set of currently accepted parse-options is as follows: + +=over 3 + +=item B<-want_nonPODs> (default: unset) + +Normally (by default) B will only provide access to +the POD sections of the input. Input paragraphs that are not part +of the POD-format documentation are not made available to the caller +(not even using B). Setting this option to a +non-empty, non-zero value will allow B to see +non-POD sections of the input as well as POD sections. The B +method can be used to determine if the corresponding paragraph is a POD +paragraph, or some other input paragraph. + +=item B<-process_cut_cmd> (default: unset) + +Normally (by default) B handles the C<=cut> POD directive +by itself and does not pass it on to the caller for processing. Setting +this option to a non-empty, non-zero value will cause B to +pass the C<=cut> directive to the caller just like any other POD command +(and hence it may be processed by the B method). + +B will still interpret the C<=cut> directive to mean that +"cutting mode" has been (re)entered, but the caller will get a chance +to capture the actual C<=cut> paragraph itself for whatever purpose +it desires. + +=item B<-warnings> (default: unset) + +Normally (by default) B recognizes a bare minimum of +pod syntax errors and warnings and issues diagnostic messages +for errors, but not for warnings. (Use B to do more +thorough checking of POD syntax.) Setting this option to a non-empty, +non-zero value will cause B to issue diagnostics for +the few warnings it recognizes as well as the errors. + +=back + +Please see L<"parseopts()"> for a complete description of the interface +for the setting and unsetting of parse-options. + +=cut + +############################################################################# + +#use diagnostics; +use Pod::InputObjects; +use Carp; +use Exporter; +BEGIN { + if ($] < 5.006) { + require Symbol; + import Symbol; + } +} +@ISA = qw(Exporter); + +############################################################################# + +=head1 RECOMMENDED SUBROUTINE/METHOD OVERRIDES + +B provides several methods which most subclasses will probably +want to override. These methods are as follows: + +=cut + +##--------------------------------------------------------------------------- + +=head1 B + + $parser->command($cmd,$text,$line_num,$pod_para); + +This method should be overridden by subclasses to take the appropriate +action when a POD command paragraph (denoted by a line beginning with +"=") is encountered. When such a POD directive is seen in the input, +this method is called and is passed: + +=over 3 + +=item C<$cmd> + +the name of the command for this POD paragraph + +=item C<$text> + +the paragraph text for the given POD paragraph command. + +=item C<$line_num> + +the line-number of the beginning of the paragraph + +=item C<$pod_para> + +a reference to a C object which contains further +information about the paragraph command (see L +for details). + +=back + +B that this method I called for C<=pod> paragraphs. + +The base class implementation of this method simply treats the raw POD +command as normal block of paragraph text (invoking the B +method with the command paragraph). + +=cut + +sub command { + my ($self, $cmd, $text, $line_num, $pod_para) = @_; + ## Just treat this like a textblock + $self->textblock($pod_para->raw_text(), $line_num, $pod_para); +} + +##--------------------------------------------------------------------------- + +=head1 B + + $parser->verbatim($text,$line_num,$pod_para); + +This method may be overridden by subclasses to take the appropriate +action when a block of verbatim text is encountered. It is passed the +following parameters: + +=over 3 + +=item C<$text> + +the block of text for the verbatim paragraph + +=item C<$line_num> + +the line-number of the beginning of the paragraph + +=item C<$pod_para> + +a reference to a C object which contains further +information about the paragraph (see L +for details). + +=back + +The base class implementation of this method simply prints the textblock +(unmodified) to the output filehandle. + +=cut + +sub verbatim { + my ($self, $text, $line_num, $pod_para) = @_; + my $out_fh = $self->{_OUTPUT}; + print $out_fh $text; +} + +##--------------------------------------------------------------------------- + +=head1 B + + $parser->textblock($text,$line_num,$pod_para); + +This method may be overridden by subclasses to take the appropriate +action when a normal block of POD text is encountered (although the base +class method will usually do what you want). It is passed the following +parameters: + +=over 3 + +=item C<$text> + +the block of text for the a POD paragraph + +=item C<$line_num> + +the line-number of the beginning of the paragraph + +=item C<$pod_para> + +a reference to a C object which contains further +information about the paragraph (see L +for details). + +=back + +In order to process interior sequences, subclasses implementations of +this method will probably want to invoke either B or +B, passing it the text block C<$text>, and the corresponding +line number in C<$line_num>, and then perform any desired processing upon +the returned result. + +The base class implementation of this method simply prints the text block +as it occurred in the input stream). + +=cut + +sub textblock { + my ($self, $text, $line_num, $pod_para) = @_; + my $out_fh = $self->{_OUTPUT}; + print $out_fh $self->interpolate($text, $line_num); +} + +##--------------------------------------------------------------------------- + +=head1 B + + $parser->interior_sequence($seq_cmd,$seq_arg,$pod_seq); + +This method should be overridden by subclasses to take the appropriate +action when an interior sequence is encountered. An interior sequence is +an embedded command within a block of text which appears as a command +name (usually a single uppercase character) followed immediately by a +string of text which is enclosed in angle brackets. This method is +passed the sequence command C<$seq_cmd> and the corresponding text +C<$seq_arg>. It is invoked by the B method for each interior +sequence that occurs in the string that it is passed. It should return +the desired text string to be used in place of the interior sequence. +The C<$pod_seq> argument is a reference to a C +object which contains further information about the interior sequence. +Please see L for details if you need to access this +additional information. + +Subclass implementations of this method may wish to invoke the +B method of C<$pod_seq> to see if it is nested inside +some other interior-sequence (and if so, which kind). + +The base class implementation of the B method +simply returns the raw text of the interior sequence (as it occurred +in the input) to the caller. + +=cut + +sub interior_sequence { + my ($self, $seq_cmd, $seq_arg, $pod_seq) = @_; + ## Just return the raw text of the interior sequence + return $pod_seq->raw_text(); +} + +############################################################################# + +=head1 OPTIONAL SUBROUTINE/METHOD OVERRIDES + +B provides several methods which subclasses may want to override +to perform any special pre/post-processing. These methods do I have to +be overridden, but it may be useful for subclasses to take advantage of them. + +=cut + +##--------------------------------------------------------------------------- + +=head1 B + + my $parser = Pod::Parser->new(); + +This is the constructor for B and its subclasses. You +I need to override this method! It is capable of constructing +subclass objects as well as base class objects, provided you use +any of the following constructor invocation styles: + + my $parser1 = MyParser->new(); + my $parser2 = new MyParser(); + my $parser3 = $parser2->new(); + +where C is some subclass of B. + +Using the syntax C to invoke the constructor is I +recommended, but if you insist on being able to do this, then the +subclass I need to override the B constructor method. If +you do override the constructor, you I be sure to invoke the +B method of the newly blessed object. + +Using any of the above invocations, the first argument to the +constructor is always the corresponding package name (or object +reference). No other arguments are required, but if desired, an +associative array (or hash-table) my be passed to the B +constructor, as in: + + my $parser1 = MyParser->new( MYDATA => $value1, MOREDATA => $value2 ); + my $parser2 = new MyParser( -myflag => 1 ); + +All arguments passed to the B constructor will be treated as +key/value pairs in a hash-table. The newly constructed object will be +initialized by copying the contents of the given hash-table (which may +have been empty). The B constructor for this class and all of its +subclasses returns a blessed reference to the initialized object (hash-table). + +=cut + +sub new { + ## Determine if we were called via an object-ref or a classname + my ($this,%params) = @_; + my $class = ref($this) || $this; + ## Any remaining arguments are treated as initial values for the + ## hash that is used to represent this object. + my $self = { %params }; + ## Bless ourselves into the desired class and perform any initialization + bless $self, $class; + $self->initialize(); + return $self; +} + +##--------------------------------------------------------------------------- + +=head1 B + + $parser->initialize(); + +This method performs any necessary object initialization. It takes no +arguments (other than the object instance of course, which is typically +copied to a local variable named C<$self>). If subclasses override this +method then they I be sure to invoke C<$self-ESUPER::initialize()>. + +=cut + +sub initialize { + #my $self = shift; + #return; +} + +##--------------------------------------------------------------------------- + +=head1 B + + $parser->begin_pod(); + +This method is invoked at the beginning of processing for each POD +document that is encountered in the input. Subclasses should override +this method to perform any per-document initialization. + +=cut + +sub begin_pod { + #my $self = shift; + #return; +} + +##--------------------------------------------------------------------------- + +=head1 B + + $parser->begin_input(); + +This method is invoked by B immediately I +processing input from a filehandle. The base class implementation does +nothing, however, subclasses may override it to perform any per-file +initializations. + +Note that if multiple files are parsed for a single POD document +(perhaps the result of some future C<=include> directive) this method +is invoked for every file that is parsed. If you wish to perform certain +initializations once per document, then you should use B. + +=cut + +sub begin_input { + #my $self = shift; + #return; +} + +##--------------------------------------------------------------------------- + +=head1 B + + $parser->end_input(); + +This method is invoked by B immediately I +processing input from a filehandle. The base class implementation does +nothing, however, subclasses may override it to perform any per-file +cleanup actions. + +Please note that if multiple files are parsed for a single POD document +(perhaps the result of some kind of C<=include> directive) this method +is invoked for every file that is parsed. If you wish to perform certain +cleanup actions once per document, then you should use B. + +=cut + +sub end_input { + #my $self = shift; + #return; +} + +##--------------------------------------------------------------------------- + +=head1 B + + $parser->end_pod(); + +This method is invoked at the end of processing for each POD document +that is encountered in the input. Subclasses should override this method +to perform any per-document finalization. + +=cut + +sub end_pod { + #my $self = shift; + #return; +} + +##--------------------------------------------------------------------------- + +=head1 B + + $textline = $parser->preprocess_line($text, $line_num); + +This method should be overridden by subclasses that wish to perform +any kind of preprocessing for each I of input (I it has +been determined whether or not it is part of a POD paragraph). The +parameter C<$text> is the input line; and the parameter C<$line_num> is +the line number of the corresponding text line. + +The value returned should correspond to the new text to use in its +place. If the empty string or an undefined value is returned then no +further processing will be performed for this line. + +Please note that the B method is invoked I +the B method. After all (possibly preprocessed) +lines in a paragraph have been assembled together and it has been +determined that the paragraph is part of the POD documentation from one +of the selected sections, then B is invoked. + +The base class implementation of this method returns the given text. + +=cut + +sub preprocess_line { + my ($self, $text, $line_num) = @_; + return $text; +} + +##--------------------------------------------------------------------------- + +=head1 B + + $textblock = $parser->preprocess_paragraph($text, $line_num); + +This method should be overridden by subclasses that wish to perform any +kind of preprocessing for each block (paragraph) of POD documentation +that appears in the input stream. The parameter C<$text> is the POD +paragraph from the input file; and the parameter C<$line_num> is the +line number for the beginning of the corresponding paragraph. + +The value returned should correspond to the new text to use in its +place If the empty string is returned or an undefined value is +returned, then the given C<$text> is ignored (not processed). + +This method is invoked after gathering up all the lines in a paragraph +and after determining the cutting state of the paragraph, +but before trying to further parse or interpret them. After +B returns, the current cutting state (which +is returned by C<$self-Ecutting()>) is examined. If it evaluates +to true then input text (including the given C<$text>) is cut (not +processed) until the next POD directive is encountered. + +Please note that the B method is invoked I +the B method. After all (possibly preprocessed) +lines in a paragraph have been assembled together and either it has been +determined that the paragraph is part of the POD documentation from one +of the selected sections or the C<-want_nonPODs> option is true, +then B is invoked. + +The base class implementation of this method returns the given text. + +=cut + +sub preprocess_paragraph { + my ($self, $text, $line_num) = @_; + return $text; +} + +############################################################################# + +=head1 METHODS FOR PARSING AND PROCESSING + +B provides several methods to process input text. These +methods typically won't need to be overridden (and in some cases they +can't be overridden), but subclasses may want to invoke them to exploit +their functionality. + +=cut + +##--------------------------------------------------------------------------- + +=head1 B + + $ptree1 = $parser->parse_text($text, $line_num); + $ptree2 = $parser->parse_text({%opts}, $text, $line_num); + $ptree3 = $parser->parse_text(\%opts, $text, $line_num); + +This method is useful if you need to perform your own interpolation +of interior sequences and can't rely upon B to expand +them in simple bottom-up order. + +The parameter C<$text> is a string or block of text to be parsed +for interior sequences; and the parameter C<$line_num> is the +line number corresponding to the beginning of C<$text>. + +B will parse the given text into a parse-tree of "nodes." +and interior-sequences. Each "node" in the parse tree is either a +text-string, or a B. The result returned is a +parse-tree of type B. Please see L +for more information about B and B. + +If desired, an optional hash-ref may be specified as the first argument +to customize certain aspects of the parse-tree that is created and +returned. The set of recognized option keywords are: + +=over 3 + +=item B<-expand_seq> =E I|I + +Normally, the parse-tree returned by B will contain an +unexpanded C object for each interior-sequence +encountered. Specifying B<-expand_seq> tells B to "expand" +every interior-sequence it sees by invoking the referenced function +(or named method of the parser object) and using the return value as the +expanded result. + +If a subroutine reference was given, it is invoked as: + + &$code_ref( $parser, $sequence ) + +and if a method-name was given, it is invoked as: + + $parser->method_name( $sequence ) + +where C<$parser> is a reference to the parser object, and C<$sequence> +is a reference to the interior-sequence object. +[I: If the B method is specified, then it is +invoked according to the interface specified in L<"interior_sequence()">]. + +=item B<-expand_text> =E I|I + +Normally, the parse-tree returned by B will contain a +text-string for each contiguous sequence of characters outside of an +interior-sequence. Specifying B<-expand_text> tells B to +"preprocess" every such text-string it sees by invoking the referenced +function (or named method of the parser object) and using the return value +as the preprocessed (or "expanded") result. [Note that if the result is +an interior-sequence, then it will I be expanded as specified by the +B<-expand_seq> option; Any such recursive expansion needs to be handled by +the specified callback routine.] + +If a subroutine reference was given, it is invoked as: + + &$code_ref( $parser, $text, $ptree_node ) + +and if a method-name was given, it is invoked as: + + $parser->method_name( $text, $ptree_node ) + +where C<$parser> is a reference to the parser object, C<$text> is the +text-string encountered, and C<$ptree_node> is a reference to the current +node in the parse-tree (usually an interior-sequence object or else the +top-level node of the parse-tree). + +=item B<-expand_ptree> =E I|I + +Rather than returning a C, pass the parse-tree as an +argument to the referenced subroutine (or named method of the parser +object) and return the result instead of the parse-tree object. + +If a subroutine reference was given, it is invoked as: + + &$code_ref( $parser, $ptree ) + +and if a method-name was given, it is invoked as: + + $parser->method_name( $ptree ) + +where C<$parser> is a reference to the parser object, and C<$ptree> +is a reference to the parse-tree object. + +=back + +=cut + +sub parse_text { + my $self = shift; + local $_ = ''; + + ## Get options and set any defaults + my %opts = (ref $_[0]) ? %{ shift() } : (); + my $expand_seq = $opts{'-expand_seq'} || undef; + my $expand_text = $opts{'-expand_text'} || undef; + my $expand_ptree = $opts{'-expand_ptree'} || undef; + + my $text = shift; + my $line = shift; + my $file = $self->input_file(); + my $cmd = ""; + + ## Convert method calls into closures, for our convenience + my $xseq_sub = $expand_seq; + my $xtext_sub = $expand_text; + my $xptree_sub = $expand_ptree; + if (defined $expand_seq and $expand_seq eq 'interior_sequence') { + ## If 'interior_sequence' is the method to use, we have to pass + ## more than just the sequence object, we also need to pass the + ## sequence name and text. + $xseq_sub = sub { + my ($sself, $iseq) = @_; + my $args = join('', $iseq->parse_tree->children); + return $sself->interior_sequence($iseq->name, $args, $iseq); + }; + } + ref $xseq_sub or $xseq_sub = sub { shift()->$expand_seq(@_) }; + ref $xtext_sub or $xtext_sub = sub { shift()->$expand_text(@_) }; + ref $xptree_sub or $xptree_sub = sub { shift()->$expand_ptree(@_) }; + + ## Keep track of the "current" interior sequence, and maintain a stack + ## of "in progress" sequences. + ## + ## NOTE that we push our own "accumulator" at the very beginning of the + ## stack. It's really a parse-tree, not a sequence; but it implements + ## the methods we need so we can use it to gather-up all the sequences + ## and strings we parse. Thus, by the end of our parsing, it should be + ## the only thing left on our stack and all we have to do is return it! + ## + my $seq = Pod::ParseTree->new(); + my @seq_stack = ($seq); + my ($ldelim, $rdelim) = ('', ''); + + ## Iterate over all sequence starts text (NOTE: split with + ## capturing parens keeps the delimiters) + $_ = $text; + my @tokens = split /([A-Z]<(?:<+(?:\r?\n|[ \t]))?)/; + while ( @tokens ) { + $_ = shift @tokens; + ## Look for the beginning of a sequence + if ( /^([A-Z])(<(?:<+(?:\r?\n|[ \t]))?)$/ ) { + ## Push a new sequence onto the stack of those "in-progress" + my $ldelim_orig; + ($cmd, $ldelim_orig) = ($1, $2); + ($ldelim = $ldelim_orig) =~ s/\s+$//; + ($rdelim = $ldelim) =~ tr//; + $seq = Pod::InteriorSequence->new( + -name => $cmd, + -ldelim => $ldelim_orig, -rdelim => $rdelim, + -file => $file, -line => $line + ); + (@seq_stack > 1) and $seq->nested($seq_stack[-1]); + push @seq_stack, $seq; + } + ## Look for sequence ending + elsif ( @seq_stack > 1 ) { + ## Make sure we match the right kind of closing delimiter + my ($seq_end, $post_seq) = ('', ''); + if ( ($ldelim eq '<' and /\A(.*?)(>)/s) + or /\A(.*?)(\s+$rdelim)/s ) + { + ## Found end-of-sequence, capture the interior and the + ## closing the delimiter, and put the rest back on the + ## token-list + $post_seq = substr($_, length($1) + length($2)); + ($_, $seq_end) = ($1, $2); + (length $post_seq) and unshift @tokens, $post_seq; + } + if (length) { + ## In the middle of a sequence, append this text to it, and + ## dont forget to "expand" it if that's what the caller wanted + $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_); + $_ .= $seq_end; + } + if (length $seq_end) { + ## End of current sequence, record terminating delimiter + $seq->rdelim($seq_end); + ## Pop it off the stack of "in progress" sequences + pop @seq_stack; + ## Append result to its parent in current parse tree + $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq) + : $seq); + ## Remember the current cmd-name and left-delimiter + if(@seq_stack > 1) { + $cmd = $seq_stack[-1]->name; + $ldelim = $seq_stack[-1]->ldelim; + $rdelim = $seq_stack[-1]->rdelim; + } else { + $cmd = $ldelim = $rdelim = ''; + } + } + } + elsif (length) { + ## In the middle of a sequence, append this text to it, and + ## dont forget to "expand" it if that's what the caller wanted + $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_); + } + ## Keep track of line count + $line += /\n/; + ## Remember the "current" sequence + $seq = $seq_stack[-1]; + } + + ## Handle unterminated sequences + my $errorsub = (@seq_stack > 1) ? $self->errorsub() : undef; + while (@seq_stack > 1) { + ($cmd, $file, $line) = ($seq->name, $seq->file_line); + $ldelim = $seq->ldelim; + ($rdelim = $ldelim) =~ tr//; + $rdelim =~ s/^(\S+)(\s*)$/$2$1/; + pop @seq_stack; + my $errmsg = "*** ERROR: unterminated ${cmd}${ldelim}...${rdelim}". + " at line $line in file $file\n"; + (ref $errorsub) and &{$errorsub}($errmsg) + or (defined $errorsub) and $self->$errorsub($errmsg) + or carp($errmsg); + $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq) : $seq); + $seq = $seq_stack[-1]; + } + + ## Return the resulting parse-tree + my $ptree = (pop @seq_stack)->parse_tree; + return $expand_ptree ? &$xptree_sub($self, $ptree) : $ptree; +} + +##--------------------------------------------------------------------------- + +=head1 B + + $textblock = $parser->interpolate($text, $line_num); + +This method translates all text (including any embedded interior sequences) +in the given text string C<$text> and returns the interpolated result. The +parameter C<$line_num> is the line number corresponding to the beginning +of C<$text>. + +B merely invokes a private method to recursively expand +nested interior sequences in bottom-up order (innermost sequences are +expanded first). If there is a need to expand nested sequences in +some alternate order, use B instead. + +=cut + +sub interpolate { + my($self, $text, $line_num) = @_; + my %parse_opts = ( -expand_seq => 'interior_sequence' ); + my $ptree = $self->parse_text( \%parse_opts, $text, $line_num ); + return join '', $ptree->children(); +} + +##--------------------------------------------------------------------------- + +=begin __PRIVATE__ + +=head1 B + + $parser->parse_paragraph($text, $line_num); + +This method takes the text of a POD paragraph to be processed, along +with its corresponding line number, and invokes the appropriate method +(one of B, B, or B). + +For performance reasons, this method is invoked directly without any +dynamic lookup; Hence subclasses may I override it! + +=end __PRIVATE__ + +=cut + +sub parse_paragraph { + my ($self, $text, $line_num) = @_; + local *myData = $self; ## alias to avoid deref-ing overhead + local *myOpts = ($myData{_PARSEOPTS} ||= {}); ## get parse-options + local $_; + + ## See if we want to preprocess nonPOD paragraphs as well as POD ones. + my $wantNonPods = $myOpts{'-want_nonPODs'}; + + ## Update cutting status + $myData{_CUTTING} = 0 if $text =~ /^={1,2}\S/; + + ## Perform any desired preprocessing if we wanted it this early + $wantNonPods and $text = $self->preprocess_paragraph($text, $line_num); + + ## Ignore up until next POD directive if we are cutting + return if $myData{_CUTTING}; + + ## Now we know this is block of text in a POD section! + + ##----------------------------------------------------------------- + ## This is a hook (hack ;-) for Pod::Select to do its thing without + ## having to override methods, but also without Pod::Parser assuming + ## $self is an instance of Pod::Select (if the _SELECTED_SECTIONS + ## field exists then we assume there is an is_selected() method for + ## us to invoke (calling $self->can('is_selected') could verify this + ## but that is more overhead than I want to incur) + ##----------------------------------------------------------------- + + ## Ignore this block if it isnt in one of the selected sections + if (exists $myData{_SELECTED_SECTIONS}) { + $self->is_selected($text) or return ($myData{_CUTTING} = 1); + } + + ## If we havent already, perform any desired preprocessing and + ## then re-check the "cutting" state + unless ($wantNonPods) { + $text = $self->preprocess_paragraph($text, $line_num); + return 1 unless ((defined $text) and (length $text)); + return 1 if ($myData{_CUTTING}); + } + + ## Look for one of the three types of paragraphs + my ($pfx, $cmd, $arg, $sep) = ('', '', '', ''); + my $pod_para = undef; + if ($text =~ /^(={1,2})(?=\S)/) { + ## Looks like a command paragraph. Capture the command prefix used + ## ("=" or "=="), as well as the command-name, its paragraph text, + ## and whatever sequence of characters was used to separate them + $pfx = $1; + $_ = substr($text, length $pfx); + ($cmd, $sep, $text) = split /(\s+)/, $_, 2; + $sep = '' unless defined $sep; + $text = '' unless defined $text; + ## If this is a "cut" directive then we dont need to do anything + ## except return to "cutting" mode. + if ($cmd eq 'cut') { + $myData{_CUTTING} = 1; + return unless $myOpts{'-process_cut_cmd'}; + } + } + ## Save the attributes indicating how the command was specified. + $pod_para = new Pod::Paragraph( + -name => $cmd, + -text => $text, + -prefix => $pfx, + -separator => $sep, + -file => $myData{_INFILE}, + -line => $line_num + ); + # ## Invoke appropriate callbacks + # if (exists $myData{_CALLBACKS}) { + # ## Look through the callback list, invoke callbacks, + # ## then see if we need to do the default actions + # ## (invoke_callbacks will return true if we do). + # return 1 unless $self->invoke_callbacks($cmd, $text, $line_num, $pod_para); + # } + + # If the last paragraph ended in whitespace, and we're not between verbatim blocks, carp + if ($myData{_WHITESPACE} and $myOpts{'-warnings'} + and not ($text =~ /^\s+/ and ($myData{_PREVIOUS}||"") eq "verbatim")) { + my $errorsub = $self->errorsub(); + my $line = $line_num - 1; + my $errmsg = "*** WARNING: line containing nothing but whitespace". + " in paragraph at line $line in file $myData{_INFILE}\n"; + (ref $errorsub) and &{$errorsub}($errmsg) + or (defined $errorsub) and $self->$errorsub($errmsg) + or carp($errmsg); + } + + if (length $cmd) { + ## A command paragraph + $self->command($cmd, $text, $line_num, $pod_para); + $myData{_PREVIOUS} = $cmd; + } + elsif ($text =~ /^\s+/) { + ## Indented text - must be a verbatim paragraph + $self->verbatim($text, $line_num, $pod_para); + $myData{_PREVIOUS} = "verbatim"; + } + else { + ## Looks like an ordinary block of text + $self->textblock($text, $line_num, $pod_para); + $myData{_PREVIOUS} = "textblock"; + } + + # Update the whitespace for the next time around + #$myData{_WHITESPACE} = $text =~ /^[^\S\r\n]+\Z/m ? 1 : 0; + $myData{_WHITESPACE} = $text =~ /^[^\S\r\n]+\r*\Z/m ? 1 : 0; + + return 1; +} + +##--------------------------------------------------------------------------- + +=head1 B + + $parser->parse_from_filehandle($in_fh,$out_fh); + +This method takes an input filehandle (which is assumed to already be +opened for reading) and reads the entire input stream looking for blocks +(paragraphs) of POD documentation to be processed. If no first argument +is given the default input filehandle C is used. + +The C<$in_fh> parameter may be any object that provides a B +method to retrieve a single line of input text (hence, an appropriate +wrapper object could be used to parse PODs from a single string or an +array of strings). + +Using C<$in_fh-Egetline()>, input is read line-by-line and assembled +into paragraphs or "blocks" (which are separated by lines containing +nothing but whitespace). For each block of POD documentation +encountered it will invoke a method to parse the given paragraph. + +If a second argument is given then it should correspond to a filehandle where +output should be sent (otherwise the default output filehandle is +C if no output filehandle is currently in use). + +B For performance reasons, this method caches the input stream at +the top of the stack in a local variable. Any attempts by clients to +change the stack contents during processing when in the midst executing +of this method I the input stream used by the current +invocation of this method. + +This method does I usually need to be overridden by subclasses. + +=cut + +sub parse_from_filehandle { + my $self = shift; + my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : (); + my ($in_fh, $out_fh) = @_; + $in_fh = \*STDIN unless ($in_fh); + local *myData = $self; ## alias to avoid deref-ing overhead + local *myOpts = ($myData{_PARSEOPTS} ||= {}); ## get parse-options + local $_; + + ## Put this stream at the top of the stack and do beginning-of-input + ## processing. NOTE that $in_fh might be reset during this process. + my $topstream = $self->_push_input_stream($in_fh, $out_fh); + (exists $opts{-cutting}) and $self->cutting( $opts{-cutting} ); + + ## Initialize line/paragraph + my ($textline, $paragraph) = ('', ''); + my ($nlines, $plines) = (0, 0); + + ## Use <$fh> instead of $fh->getline where possible (for speed) + $_ = ref $in_fh; + my $tied_fh = (/^(?:GLOB|FileHandle|IO::\w+)$/ or tied $in_fh); + + ## Read paragraphs line-by-line + while (defined ($textline = $tied_fh ? <$in_fh> : $in_fh->getline)) { + $textline = $self->preprocess_line($textline, ++$nlines); + next unless ((defined $textline) && (length $textline)); + + if ((! length $paragraph) && ($textline =~ /^==/)) { + ## '==' denotes a one-line command paragraph + $paragraph = $textline; + $plines = 1; + $textline = ''; + } else { + ## Append this line to the current paragraph + $paragraph .= $textline; + ++$plines; + } + + ## See if this line is blank and ends the current paragraph. + ## If it isnt, then keep iterating until it is. + next unless (($textline =~ /^[^\S\r\n]*[\r\n]*$/) + && (length $paragraph)); + + ## Now process the paragraph + parse_paragraph($self, $paragraph, ($nlines - $plines) + 1); + $paragraph = ''; + $plines = 0; + } + ## Dont forget about the last paragraph in the file + if (length $paragraph) { + parse_paragraph($self, $paragraph, ($nlines - $plines) + 1) + } + + ## Now pop the input stream off the top of the input stack. + $self->_pop_input_stream(); +} + +##--------------------------------------------------------------------------- + +=head1 B + + $parser->parse_from_file($filename,$outfile); + +This method takes a filename and does the following: + +=over 2 + +=item * + +opens the input and output files for reading +(creating the appropriate filehandles) + +=item * + +invokes the B method passing it the +corresponding input and output filehandles. + +=item * + +closes the input and output files. + +=back + +If the special input filename "-" or "<&STDIN" is given then the STDIN +filehandle is used for input (and no open or close is performed). If no +input filename is specified then "-" is implied. Filehandle references, +or objects that support the regular IO operations (like C$fhE> +or C<$fh-getline>) are also accepted; the handles must already be +opened. + +If a second argument is given then it should be the name of the desired +output file. If the special output filename "-" or ">&STDOUT" is given +then the STDOUT filehandle is used for output (and no open or close is +performed). If the special output filename ">&STDERR" is given then the +STDERR filehandle is used for output (and no open or close is +performed). If no output filehandle is currently in use and no output +filename is specified, then "-" is implied. +Alternatively, filehandle references or objects that support the regular +IO operations (like C, e.g. L) are also accepted; +the object must already be opened. + +This method does I usually need to be overridden by subclasses. + +=cut + +sub parse_from_file { + my $self = shift; + my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : (); + my ($infile, $outfile) = @_; + my ($in_fh, $out_fh); + if ($] < 5.006) { + ($in_fh, $out_fh) = (gensym(), gensym()); + } + my ($close_input, $close_output) = (0, 0); + local *myData = $self; + local *_; + + ## Is $infile a filename or a (possibly implied) filehandle + if (defined $infile && ref $infile) { + if (ref($infile) =~ /^(SCALAR|ARRAY|HASH|CODE|REF)$/) { + croak "Input from $1 reference not supported!\n"; + } + ## Must be a filehandle-ref (or else assume its a ref to an object + ## that supports the common IO read operations). + $myData{_INFILE} = ${$infile}; + $in_fh = $infile; + } + elsif (!defined($infile) || !length($infile) || ($infile eq '-') + || ($infile =~ /^<&(?:STDIN|0)$/i)) + { + ## Not a filename, just a string implying STDIN + $infile ||= '-'; + $myData{_INFILE} = ''; + $in_fh = \*STDIN; + } + else { + ## We have a filename, open it for reading + $myData{_INFILE} = $infile; + open($in_fh, "< $infile") or + croak "Can't open $infile for reading: $!\n"; + $close_input = 1; + } + + ## NOTE: we need to be *very* careful when "defaulting" the output + ## file. We only want to use a default if this is the beginning of + ## the entire document (but *not* if this is an included file). We + ## determine this by seeing if the input stream stack has been set-up + ## already + + ## Is $outfile a filename, a (possibly implied) filehandle, maybe a ref? + if (ref $outfile) { + ## we need to check for ref() first, as other checks involve reading + if (ref($outfile) =~ /^(ARRAY|HASH|CODE)$/) { + croak "Output to $1 reference not supported!\n"; + } + elsif (ref($outfile) eq 'SCALAR') { +# # NOTE: IO::String isn't a part of the perl distribution, +# # so probably we shouldn't support this case... +# require IO::String; +# $myData{_OUTFILE} = "$outfile"; +# $out_fh = IO::String->new($outfile); + croak "Output to SCALAR reference not supported!\n"; + } + else { + ## Must be a filehandle-ref (or else assume its a ref to an + ## object that supports the common IO write operations). + $myData{_OUTFILE} = ${$outfile}; + $out_fh = $outfile; + } + } + elsif (!defined($outfile) || !length($outfile) || ($outfile eq '-') + || ($outfile =~ /^>&?(?:STDOUT|1)$/i)) + { + if (defined $myData{_TOP_STREAM}) { + $out_fh = $myData{_OUTPUT}; + } + else { + ## Not a filename, just a string implying STDOUT + $outfile ||= '-'; + $myData{_OUTFILE} = ''; + $out_fh = \*STDOUT; + } + } + elsif ($outfile =~ /^>&(STDERR|2)$/i) { + ## Not a filename, just a string implying STDERR + $myData{_OUTFILE} = ''; + $out_fh = \*STDERR; + } + else { + ## We have a filename, open it for writing + $myData{_OUTFILE} = $outfile; + (-d $outfile) and croak "$outfile is a directory, not POD input!\n"; + open($out_fh, "> $outfile") or + croak "Can't open $outfile for writing: $!\n"; + $close_output = 1; + } + + ## Whew! That was a lot of work to set up reasonably/robust behavior + ## in the case of a non-filename for reading and writing. Now we just + ## have to parse the input and close the handles when we're finished. + $self->parse_from_filehandle(\%opts, $in_fh, $out_fh); + + $close_input and + close($in_fh) || croak "Can't close $infile after reading: $!\n"; + $close_output and + close($out_fh) || croak "Can't close $outfile after writing: $!\n"; +} + +############################################################################# + +=head1 ACCESSOR METHODS + +Clients of B should use the following methods to access +instance data fields: + +=cut + +##--------------------------------------------------------------------------- + +=head1 B + + $parser->errorsub("method_name"); + $parser->errorsub(\&warn_user); + $parser->errorsub(sub { print STDERR, @_ }); + +Specifies the method or subroutine to use when printing error messages +about POD syntax. The supplied method/subroutine I return TRUE upon +successful printing of the message. If C is given, then the B +builtin is used to issue error messages (this is the default behavior). + + my $errorsub = $parser->errorsub() + my $errmsg = "This is an error message!\n" + (ref $errorsub) and &{$errorsub}($errmsg) + or (defined $errorsub) and $parser->$errorsub($errmsg) + or carp($errmsg); + +Returns a method name, or else a reference to the user-supplied subroutine +used to print error messages. Returns C if the B builtin +is used to issue error messages (this is the default behavior). + +=cut + +sub errorsub { + return (@_ > 1) ? ($_[0]->{_ERRORSUB} = $_[1]) : $_[0]->{_ERRORSUB}; +} + +##--------------------------------------------------------------------------- + +=head1 B + + $boolean = $parser->cutting(); + +Returns the current C state: a boolean-valued scalar which +evaluates to true if text from the input file is currently being "cut" +(meaning it is I considered part of the POD document). + + $parser->cutting($boolean); + +Sets the current C state to the given value and returns the +result. + +=cut + +sub cutting { + return (@_ > 1) ? ($_[0]->{_CUTTING} = $_[1]) : $_[0]->{_CUTTING}; +} + +##--------------------------------------------------------------------------- + +##--------------------------------------------------------------------------- + +=head1 B + +When invoked with no additional arguments, B returns a hashtable +of all the current parsing options. + + ## See if we are parsing non-POD sections as well as POD ones + my %opts = $parser->parseopts(); + $opts{'-want_nonPODs}' and print "-want_nonPODs\n"; + +When invoked using a single string, B treats the string as the +name of a parse-option and returns its corresponding value if it exists +(returns C if it doesn't). + + ## Did we ask to see '=cut' paragraphs? + my $want_cut = $parser->parseopts('-process_cut_cmd'); + $want_cut and print "-process_cut_cmd\n"; + +When invoked with multiple arguments, B treats them as +key/value pairs and the specified parse-option names are set to the +given values. Any unspecified parse-options are unaffected. + + ## Set them back to the default + $parser->parseopts(-warnings => 0); + +When passed a single hash-ref, B uses that hash to completely +reset the existing parse-options, all previous parse-option values +are lost. + + ## Reset all options to default + $parser->parseopts( { } ); + +See L<"PARSING OPTIONS"> for more information on the name and meaning of each +parse-option currently recognized. + +=cut + +sub parseopts { + local *myData = shift; + local *myOpts = ($myData{_PARSEOPTS} ||= {}); + return %myOpts if (@_ == 0); + if (@_ == 1) { + local $_ = shift; + return ref($_) ? $myData{_PARSEOPTS} = $_ : $myOpts{$_}; + } + my @newOpts = (%myOpts, @_); + $myData{_PARSEOPTS} = { @newOpts }; +} + +##--------------------------------------------------------------------------- + +=head1 B + + $fname = $parser->output_file(); + +Returns the name of the output file being written. + +=cut + +sub output_file { + return $_[0]->{_OUTFILE}; +} + +##--------------------------------------------------------------------------- + +=head1 B + + $fhandle = $parser->output_handle(); + +Returns the output filehandle object. + +=cut + +sub output_handle { + return $_[0]->{_OUTPUT}; +} + +##--------------------------------------------------------------------------- + +=head1 B + + $fname = $parser->input_file(); + +Returns the name of the input file being read. + +=cut + +sub input_file { + return $_[0]->{_INFILE}; +} + +##--------------------------------------------------------------------------- + +=head1 B + + $fhandle = $parser->input_handle(); + +Returns the current input filehandle object. + +=cut + +sub input_handle { + return $_[0]->{_INPUT}; +} + +##--------------------------------------------------------------------------- + +=begin __PRIVATE__ + +=head1 B + + $listref = $parser->input_streams(); + +Returns a reference to an array which corresponds to the stack of all +the input streams that are currently in the middle of being parsed. + +While parsing an input stream, it is possible to invoke +B or B to parse a new input +stream and then return to parsing the previous input stream. Each input +stream to be parsed is pushed onto the end of this input stack +before any of its input is read. The input stream that is currently +being parsed is always at the end (or top) of the input stack. When an +input stream has been exhausted, it is popped off the end of the +input stack. + +Each element on this input stack is a reference to C +object. Please see L for more details. + +This method might be invoked when printing diagnostic messages, for example, +to obtain the name and line number of the all input files that are currently +being processed. + +=end __PRIVATE__ + +=cut + +sub input_streams { + return $_[0]->{_INPUT_STREAMS}; +} + +##--------------------------------------------------------------------------- + +=begin __PRIVATE__ + +=head1 B + + $hashref = $parser->top_stream(); + +Returns a reference to the hash-table that represents the element +that is currently at the top (end) of the input stream stack +(see L<"input_streams()">). The return value will be the C +if the input stack is empty. + +This method might be used when printing diagnostic messages, for example, +to obtain the name and line number of the current input file. + +=end __PRIVATE__ + +=cut + +sub top_stream { + return $_[0]->{_TOP_STREAM} || undef; +} + +############################################################################# + +=head1 PRIVATE METHODS AND DATA + +B makes use of several internal methods and data fields +which clients should not need to see or use. For the sake of avoiding +name collisions for client data and methods, these methods and fields +are briefly discussed here. Determined hackers may obtain further +information about them by reading the B source code. + +Private data fields are stored in the hash-object whose reference is +returned by the B constructor for this class. The names of all +private methods and data-fields used by B begin with a +prefix of "_" and match the regular expression C. + +=cut + +##--------------------------------------------------------------------------- + +=begin _PRIVATE_ + +=head1 B<_push_input_stream()> + + $hashref = $parser->_push_input_stream($in_fh,$out_fh); + +This method will push the given input stream on the input stack and +perform any necessary beginning-of-document or beginning-of-file +processing. The argument C<$in_fh> is the input stream filehandle to +push, and C<$out_fh> is the corresponding output filehandle to use (if +it is not given or is undefined, then the current output stream is used, +which defaults to standard output if it doesnt exist yet). + +The value returned will be reference to the hash-table that represents +the new top of the input stream stack. I that it is +possible for this method to use default values for the input and output +file handles. If this happens, you will need to look at the C +and C instance data members to determine their new values. + +=end _PRIVATE_ + +=cut + +sub _push_input_stream { + my ($self, $in_fh, $out_fh) = @_; + local *myData = $self; + + ## Initialize stuff for the entire document if this is *not* + ## an included file. + ## + ## NOTE: we need to be *very* careful when "defaulting" the output + ## filehandle. We only want to use a default value if this is the + ## beginning of the entire document (but *not* if this is an included + ## file). + unless (defined $myData{_TOP_STREAM}) { + $out_fh = \*STDOUT unless (defined $out_fh); + $myData{_CUTTING} = 1; ## current "cutting" state + $myData{_INPUT_STREAMS} = []; ## stack of all input streams + } + + ## Initialize input indicators + $myData{_OUTFILE} = '(unknown)' unless (defined $myData{_OUTFILE}); + $myData{_OUTPUT} = $out_fh if (defined $out_fh); + $in_fh = \*STDIN unless (defined $in_fh); + $myData{_INFILE} = '(unknown)' unless (defined $myData{_INFILE}); + $myData{_INPUT} = $in_fh; + my $input_top = $myData{_TOP_STREAM} + = new Pod::InputSource( + -name => $myData{_INFILE}, + -handle => $in_fh, + -was_cutting => $myData{_CUTTING} + ); + local *input_stack = $myData{_INPUT_STREAMS}; + push(@input_stack, $input_top); + + ## Perform beginning-of-document and/or beginning-of-input processing + $self->begin_pod() if (@input_stack == 1); + $self->begin_input(); + + return $input_top; +} + +##--------------------------------------------------------------------------- + +=begin _PRIVATE_ + +=head1 B<_pop_input_stream()> + + $hashref = $parser->_pop_input_stream(); + +This takes no arguments. It will perform any necessary end-of-file or +end-of-document processing and then pop the current input stream from +the top of the input stack. + +The value returned will be reference to the hash-table that represents +the new top of the input stream stack. + +=end _PRIVATE_ + +=cut + +sub _pop_input_stream { + my ($self) = @_; + local *myData = $self; + local *input_stack = $myData{_INPUT_STREAMS}; + + ## Perform end-of-input and/or end-of-document processing + $self->end_input() if (@input_stack > 0); + $self->end_pod() if (@input_stack == 1); + + ## Restore cutting state to whatever it was before we started + ## parsing this file. + my $old_top = pop(@input_stack); + $myData{_CUTTING} = $old_top->was_cutting(); + + ## Dont forget to reset the input indicators + my $input_top = undef; + if (@input_stack > 0) { + $input_top = $myData{_TOP_STREAM} = $input_stack[-1]; + $myData{_INFILE} = $input_top->name(); + $myData{_INPUT} = $input_top->handle(); + } else { + delete $myData{_TOP_STREAM}; + delete $myData{_INPUT_STREAMS}; + } + + return $input_top; +} + +############################################################################# + +=head1 TREE-BASED PARSING + +If straightforward stream-based parsing wont meet your needs (as is +likely the case for tasks such as translating PODs into structured +markup languages like HTML and XML) then you may need to take the +tree-based approach. Rather than doing everything in one pass and +calling the B method to expand sequences into text, it +may be desirable to instead create a parse-tree using the B +method to return a tree-like structure which may contain an ordered +list of children (each of which may be a text-string, or a similar +tree-like structure). + +Pay special attention to L<"METHODS FOR PARSING AND PROCESSING"> and +to the objects described in L. The former describes +the gory details and parameters for how to customize and extend the +parsing behavior of B. B provides +several objects that may all be used interchangeably as parse-trees. The +most obvious one is the B object. It defines the basic +interface and functionality that all things trying to be a POD parse-tree +should do. A B is defined such that each "node" may be a +text-string, or a reference to another parse-tree. Each B +object and each B object also supports the basic +parse-tree interface. + +The B method takes a given paragraph of text, and +returns a parse-tree that contains one or more children, each of which +may be a text-string, or an InteriorSequence object. There are also +callback-options that may be passed to B to customize +the way it expands or transforms interior-sequences, as well as the +returned result. These callbacks can be used to create a parse-tree +with custom-made objects (which may or may not support the parse-tree +interface, depending on how you choose to do it). + +If you wish to turn an entire POD document into a parse-tree, that process +is fairly straightforward. The B method is the key to doing +this successfully. Every paragraph-callback (i.e. the polymorphic methods +for B, B, and B paragraphs) takes +a B object as an argument. Each paragraph object has a +B method that can be used to get or set a corresponding +parse-tree. So for each of those paragraph-callback methods, simply call +B with the options you desire, and then use the returned +parse-tree to assign to the given paragraph object. + +That gives you a parse-tree for each paragraph - so now all you need is +an ordered list of paragraphs. You can maintain that yourself as a data +element in the object/hash. The most straightforward way would be simply +to use an array-ref, with the desired set of custom "options" for each +invocation of B. Let's assume the desired option-set is +given by the hash C<%options>. Then we might do something like the +following: + + package MyPodParserTree; + + @ISA = qw( Pod::Parser ); + + ... + + sub begin_pod { + my $self = shift; + $self->{'-paragraphs'} = []; ## initialize paragraph list + } + + sub command { + my ($parser, $command, $paragraph, $line_num, $pod_para) = @_; + my $ptree = $parser->parse_text({%options}, $paragraph, ...); + $pod_para->parse_tree( $ptree ); + push @{ $self->{'-paragraphs'} }, $pod_para; + } + + sub verbatim { + my ($parser, $paragraph, $line_num, $pod_para) = @_; + push @{ $self->{'-paragraphs'} }, $pod_para; + } + + sub textblock { + my ($parser, $paragraph, $line_num, $pod_para) = @_; + my $ptree = $parser->parse_text({%options}, $paragraph, ...); + $pod_para->parse_tree( $ptree ); + push @{ $self->{'-paragraphs'} }, $pod_para; + } + + ... + + package main; + ... + my $parser = new MyPodParserTree(...); + $parser->parse_from_file(...); + my $paragraphs_ref = $parser->{'-paragraphs'}; + +Of course, in this module-author's humble opinion, I'd be more inclined to +use the existing B object than a simple array. That way +everything in it, paragraphs and sequences, all respond to the same core +interface for all parse-tree nodes. The result would look something like: + + package MyPodParserTree2; + + ... + + sub begin_pod { + my $self = shift; + $self->{'-ptree'} = new Pod::ParseTree; ## initialize parse-tree + } + + sub parse_tree { + ## convenience method to get/set the parse-tree for the entire POD + (@_ > 1) and $_[0]->{'-ptree'} = $_[1]; + return $_[0]->{'-ptree'}; + } + + sub command { + my ($parser, $command, $paragraph, $line_num, $pod_para) = @_; + my $ptree = $parser->parse_text({<>}, $paragraph, ...); + $pod_para->parse_tree( $ptree ); + $parser->parse_tree()->append( $pod_para ); + } + + sub verbatim { + my ($parser, $paragraph, $line_num, $pod_para) = @_; + $parser->parse_tree()->append( $pod_para ); + } + + sub textblock { + my ($parser, $paragraph, $line_num, $pod_para) = @_; + my $ptree = $parser->parse_text({<>}, $paragraph, ...); + $pod_para->parse_tree( $ptree ); + $parser->parse_tree()->append( $pod_para ); + } + + ... + + package main; + ... + my $parser = new MyPodParserTree2(...); + $parser->parse_from_file(...); + my $ptree = $parser->parse_tree; + ... + +Now you have the entire POD document as one great big parse-tree. You +can even use the B<-expand_seq> option to B to insert +whole different kinds of objects. Just don't expect B +to know what to do with them after that. That will need to be in your +code. Or, alternatively, you can insert any object you like so long as +it conforms to the B interface. + +One could use this to create subclasses of B and +B for specific commands (or to create your own +custom node-types in the parse-tree) and add some kind of B +method to each custom node/subclass object in the tree. Then all you'd +need to do is recursively walk the tree in the desired order, processing +the children (most likely from left to right) by formatting them if +they are text-strings, or by calling their B method if they +are objects/references. + +=head1 CAVEATS + +Please note that POD has the notion of "paragraphs": this is something +starting I a blank (read: empty) line, with the single exception +of the file start, which is also starting a paragraph. That means that +especially a command (e.g. C<=head1>) I be preceded with a blank +line; C<__END__> is I a blank line. + +=head1 SEE ALSO + +L, L + +B defines POD input objects corresponding to +command paragraphs, parse-trees, and interior-sequences. + +B is a subclass of B which provides the ability +to selectively include and/or exclude sections of a POD document from being +translated based upon the current heading, subheading, subsubheading, etc. + +=for __PRIVATE__ +B is a subclass of B which gives its users +the ability the employ I instead of, or in addition +to, overriding methods of the base class. + +=for __PRIVATE__ +B and B do not override any +methods nor do they define any new methods with the same name. Because +of this, they may I be used (in combination) as a base class of +the same subclass in order to combine their functionality without +causing any namespace clashes due to multiple inheritance. + +=head1 AUTHOR + +Please report bugs using L. + +Brad Appleton Ebradapp@enteract.comE + +Based on code for B written by +Tom Christiansen Etchrist@mox.perl.comE + +=head1 LICENSE + +Pod-Parser is free software; you can redistribute it and/or modify it +under the terms of the Artistic License distributed with Perl version +5.000 or (at your option) any later version. Please refer to the +Artistic License that came with your Perl distribution for more +details. If your version of Perl was not distributed under the +terms of the Artistic License, than you may distribute PodParser +under the same terms as Perl itself. + +=cut + +1; +# vim: ts=4 sw=4 et diff --git a/cpan/Pod-Usage/t/inc/Pod/PlainText.pm b/cpan/Pod-Usage/t/inc/Pod/PlainText.pm new file mode 100644 index 0000000..e8dc001 --- /dev/null +++ b/cpan/Pod-Usage/t/inc/Pod/PlainText.pm @@ -0,0 +1,744 @@ +# Pod::PlainText -- Convert POD data to formatted ASCII text. +# $Id: Text.pm,v 2.1 1999/09/20 11:53:33 eagle Exp $ +# +# Copyright 1999-2000 by Russ Allbery +# +# This program is free software; you can redistribute it and/or modify it +# under the same terms as Perl itself. +# +# This module is intended to be a replacement for Pod::Text, and attempts to +# match its output except for some specific circumstances where other +# decisions seemed to produce better output. It uses Pod::Parser and is +# designed to be very easy to subclass. + +############################################################################ +# Modules and declarations +############################################################################ + +package Pod::PlainText; +use strict; + +require 5.005; + +use Carp qw(carp croak); +use Pod::Select (); + +use vars qw(@ISA %ESCAPES $VERSION); + +# We inherit from Pod::Select instead of Pod::Parser so that we can be used +# by Pod::Usage. +@ISA = qw(Pod::Select); + +$VERSION = '2.06'; + +BEGIN { + if ($] < 5.006) { + require Symbol; + import Symbol; + } +} + +############################################################################ +# Table of supported E<> escapes +############################################################################ + +# This table is taken near verbatim from Pod::PlainText in Pod::Parser, +# which got it near verbatim from the original Pod::Text. It is therefore +# credited to Tom Christiansen, and I'm glad I didn't have to write it. :) +%ESCAPES = ( + 'amp' => '&', # ampersand + 'lt' => '<', # left chevron, less-than + 'gt' => '>', # right chevron, greater-than + 'quot' => '"', # double quote + + "Aacute" => "\xC1", # capital A, acute accent + "aacute" => "\xE1", # small a, acute accent + "Acirc" => "\xC2", # capital A, circumflex accent + "acirc" => "\xE2", # small a, circumflex accent + "AElig" => "\xC6", # capital AE diphthong (ligature) + "aelig" => "\xE6", # small ae diphthong (ligature) + "Agrave" => "\xC0", # capital A, grave accent + "agrave" => "\xE0", # small a, grave accent + "Aring" => "\xC5", # capital A, ring + "aring" => "\xE5", # small a, ring + "Atilde" => "\xC3", # capital A, tilde + "atilde" => "\xE3", # small a, tilde + "Auml" => "\xC4", # capital A, dieresis or umlaut mark + "auml" => "\xE4", # small a, dieresis or umlaut mark + "Ccedil" => "\xC7", # capital C, cedilla + "ccedil" => "\xE7", # small c, cedilla + "Eacute" => "\xC9", # capital E, acute accent + "eacute" => "\xE9", # small e, acute accent + "Ecirc" => "\xCA", # capital E, circumflex accent + "ecirc" => "\xEA", # small e, circumflex accent + "Egrave" => "\xC8", # capital E, grave accent + "egrave" => "\xE8", # small e, grave accent + "ETH" => "\xD0", # capital Eth, Icelandic + "eth" => "\xF0", # small eth, Icelandic + "Euml" => "\xCB", # capital E, dieresis or umlaut mark + "euml" => "\xEB", # small e, dieresis or umlaut mark + "Iacute" => "\xCD", # capital I, acute accent + "iacute" => "\xED", # small i, acute accent + "Icirc" => "\xCE", # capital I, circumflex accent + "icirc" => "\xEE", # small i, circumflex accent + "Igrave" => "\xCD", # capital I, grave accent + "igrave" => "\xED", # small i, grave accent + "Iuml" => "\xCF", # capital I, dieresis or umlaut mark + "iuml" => "\xEF", # small i, dieresis or umlaut mark + "Ntilde" => "\xD1", # capital N, tilde + "ntilde" => "\xF1", # small n, tilde + "Oacute" => "\xD3", # capital O, acute accent + "oacute" => "\xF3", # small o, acute accent + "Ocirc" => "\xD4", # capital O, circumflex accent + "ocirc" => "\xF4", # small o, circumflex accent + "Ograve" => "\xD2", # capital O, grave accent + "ograve" => "\xF2", # small o, grave accent + "Oslash" => "\xD8", # capital O, slash + "oslash" => "\xF8", # small o, slash + "Otilde" => "\xD5", # capital O, tilde + "otilde" => "\xF5", # small o, tilde + "Ouml" => "\xD6", # capital O, dieresis or umlaut mark + "ouml" => "\xF6", # small o, dieresis or umlaut mark + "szlig" => "\xDF", # small sharp s, German (sz ligature) + "THORN" => "\xDE", # capital THORN, Icelandic + "thorn" => "\xFE", # small thorn, Icelandic + "Uacute" => "\xDA", # capital U, acute accent + "uacute" => "\xFA", # small u, acute accent + "Ucirc" => "\xDB", # capital U, circumflex accent + "ucirc" => "\xFB", # small u, circumflex accent + "Ugrave" => "\xD9", # capital U, grave accent + "ugrave" => "\xF9", # small u, grave accent + "Uuml" => "\xDC", # capital U, dieresis or umlaut mark + "uuml" => "\xFC", # small u, dieresis or umlaut mark + "Yacute" => "\xDD", # capital Y, acute accent + "yacute" => "\xFD", # small y, acute accent + "yuml" => "\xFF", # small y, dieresis or umlaut mark + + "lchevron" => "\xAB", # left chevron (double less than) + "rchevron" => "\xBB", # right chevron (double greater than) +); + + +############################################################################ +# Initialization +############################################################################ + +# Initialize the object. Must be sure to call our parent initializer. +sub initialize { + my $self = shift; + + $$self{alt} = 0 unless defined $$self{alt}; + $$self{indent} = 4 unless defined $$self{indent}; + $$self{loose} = 0 unless defined $$self{loose}; + $$self{sentence} = 0 unless defined $$self{sentence}; + $$self{width} = 76 unless defined $$self{width}; + + $$self{INDENTS} = []; # Stack of indentations. + $$self{MARGIN} = $$self{indent}; # Current left margin in spaces. + + return $self->SUPER::initialize; +} + + +############################################################################ +# Core overrides +############################################################################ + +# Called for each command paragraph. Gets the command, the associated +# paragraph, the line number, and a Pod::Paragraph object. Just dispatches +# the command to a method named the same as the command. =cut is handled +# internally by Pod::Parser. +sub command { + my $self = shift; + my $command = shift; + return if $command eq 'pod'; + return if ($$self{EXCLUDE} && $command ne 'end'); + if (defined $$self{ITEM}) { + $self->item ("\n"); + local $_ = "\n"; + $self->output($_) if($command eq 'back'); + } + $command = 'cmd_' . $command; + return $self->$command (@_); +} + +# Called for a verbatim paragraph. Gets the paragraph, the line number, and +# a Pod::Paragraph object. Just output it verbatim, but with tabs converted +# to spaces. +sub verbatim { + my $self = shift; + return if $$self{EXCLUDE}; + $self->item if defined $$self{ITEM}; + local $_ = shift; + return if /^\s*$/; + s/^(\s*\S+)/(' ' x $$self{MARGIN}) . $1/gme; + return $self->output($_); +} + +# Called for a regular text block. Gets the paragraph, the line number, and +# a Pod::Paragraph object. Perform interpolation and output the results. +sub textblock { + my $self = shift; + return if $$self{EXCLUDE}; + if($$self{VERBATIM}) { + $self->output($_[0]); + return; + } + local $_ = shift; + my $line = shift; + + # Perform a little magic to collapse multiple L<> references. This is + # here mostly for backwards-compatibility. We'll just rewrite the whole + # thing into actual text at this part, bypassing the whole internal + # sequence parsing thing. + s{ + ( + L< # A link of the form L. + / + ( + [:\w]+ # The item has to be a simple word... + (\(\))? # ...or simple function. + ) + > + ( + ,?\s+(and\s+)? # Allow lots of them, conjuncted. + L< + / + ( + [:\w]+ + (\(\))? + ) + > + )+ + ) + } { + local $_ = $1; + s%L]+)>%$1%g; + my @items = split /(?:,?\s+(?:and\s+)?)/; + my $string = "the "; + my $i; + for ($i = 0; $i < @items; $i++) { + $string .= $items[$i]; + $string .= ", " if @items > 2 && $i != $#items; + $string .= " and " if ($i == $#items - 1); + } + $string .= " entries elsewhere in this document"; + $string; + }gex; + + # Now actually interpolate and output the paragraph. + $_ = $self->interpolate ($_, $line); + s/\s*$/\n/s; + if (defined $$self{ITEM}) { + $self->item ($_ . "\n"); + } else { + $self->output ($self->reformat ($_ . "\n")); + } +} + +# Called for an interior sequence. Gets the command, argument, and a +# Pod::InteriorSequence object and is expected to return the resulting text. +# Calls code, bold, italic, file, and link to handle those types of +# sequences, and handles S<>, E<>, X<>, and Z<> directly. +sub interior_sequence { + my $self = shift; + my $command = shift; + local $_ = shift; + return '' if ($command eq 'X' || $command eq 'Z'); + + # Expand escapes into the actual character now, carping if invalid. + if ($command eq 'E') { + return $ESCAPES{$_} if defined $ESCAPES{$_}; + carp "Unknown escape: E<$_>"; + return "E<$_>"; + } + + # For all the other sequences, empty content produces no output. + return if $_ eq ''; + + # For S<>, compress all internal whitespace and then map spaces to \01. + # When we output the text, we'll map this back. + if ($command eq 'S') { + s/\s{2,}/ /g; + tr/ /\01/; + return $_; + } + + # Anything else needs to get dispatched to another method. + if ($command eq 'B') { return $self->seq_b ($_) } + elsif ($command eq 'C') { return $self->seq_c ($_) } + elsif ($command eq 'F') { return $self->seq_f ($_) } + elsif ($command eq 'I') { return $self->seq_i ($_) } + elsif ($command eq 'L') { return $self->seq_l ($_) } + else { carp "Unknown sequence $command<$_>" } +} + +# Called for each paragraph that's actually part of the POD. We take +# advantage of this opportunity to untabify the input. +sub preprocess_paragraph { + my $self = shift; + local $_ = shift; + 1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me; + return $_; +} + + +############################################################################ +# Command paragraphs +############################################################################ + +# All command paragraphs take the paragraph and the line number. + +# First level heading. +sub cmd_head1 { + my $self = shift; + local $_ = shift; + s/\s+$//s; + $_ = $self->interpolate ($_, shift); + if ($$self{alt}) { + $self->output ("\n==== $_ ====\n\n"); + } else { + $_ .= "\n" if $$self{loose}; + $self->output ($_ . "\n"); + } +} + +# Second level heading. +sub cmd_head2 { + my $self = shift; + local $_ = shift; + s/\s+$//s; + $_ = $self->interpolate ($_, shift); + if ($$self{alt}) { + $self->output ("\n== $_ ==\n\n"); + } else { + $_ .= "\n" if $$self{loose}; + $self->output (' ' x ($$self{indent} / 2) . $_ . "\n"); + } +} + +# third level heading - not strictly perlpodspec compliant +sub cmd_head3 { + my $self = shift; + local $_ = shift; + s/\s+$//s; + $_ = $self->interpolate ($_, shift); + if ($$self{alt}) { + $self->output ("\n= $_ =\n"); + } else { + $_ .= "\n" if $$self{loose}; + $self->output (' ' x ($$self{indent}) . $_ . "\n"); + } +} + +# fourth level heading - not strictly perlpodspec compliant +# just like head3 +*cmd_head4 = \&cmd_head3; + +# Start a list. +sub cmd_over { + my $self = shift; + local $_ = shift; + unless (/^[-+]?\d+\s+$/) { $_ = $$self{indent} } + push (@{ $$self{INDENTS} }, $$self{MARGIN}); + $$self{MARGIN} += ($_ + 0); +} + +# End a list. +sub cmd_back { + my $self = shift; + $$self{MARGIN} = pop @{ $$self{INDENTS} }; + unless (defined $$self{MARGIN}) { + carp 'Unmatched =back'; + $$self{MARGIN} = $$self{indent}; + } +} + +# An individual list item. +sub cmd_item { + my $self = shift; + if (defined $$self{ITEM}) { $self->item } + local $_ = shift; + s/\s+$//s; + $$self{ITEM} = $self->interpolate ($_); +} + +# Begin a block for a particular translator. Setting VERBATIM triggers +# special handling in textblock(). +sub cmd_begin { + my $self = shift; + local $_ = shift; + my ($kind) = /^(\S+)/ or return; + if ($kind eq 'text') { + $$self{VERBATIM} = 1; + } else { + $$self{EXCLUDE} = 1; + } +} + +# End a block for a particular translator. We assume that all =begin/=end +# pairs are properly closed. +sub cmd_end { + my $self = shift; + $$self{EXCLUDE} = 0; + $$self{VERBATIM} = 0; +} + +# One paragraph for a particular translator. Ignore it unless it's intended +# for text, in which case we treat it as a verbatim text block. +sub cmd_for { + my $self = shift; + local $_ = shift; + my $line = shift; + return unless s/^text\b[ \t]*\r?\n?//; + $self->verbatim ($_, $line); +} + +# just a dummy method for the time being +sub cmd_encoding { + return; +} + +############################################################################ +# Interior sequences +############################################################################ + +# The simple formatting ones. These are here mostly so that subclasses can +# override them and do more complicated things. +sub seq_b { return $_[0]{alt} ? "``$_[1]''" : $_[1] } +sub seq_c { return $_[0]{alt} ? "``$_[1]''" : "`$_[1]'" } +sub seq_f { return $_[0]{alt} ? "\"$_[1]\"" : $_[1] } +sub seq_i { return '*' . $_[1] . '*' } + +# The complicated one. Handle links. Since this is plain text, we can't +# actually make any real links, so this is all to figure out what text we +# print out. +sub seq_l { + my $self = shift; + local $_ = shift; + + # Smash whitespace in case we were split across multiple lines. + s/\s+/ /g; + + # If we were given any explicit text, just output it. + if (/^([^|]+)\|/) { return $1 } + + # Okay, leading and trailing whitespace isn't important; get rid of it. + s/^\s+//; + s/\s+$//; + + # Default to using the whole content of the link entry as a section + # name. Note that L forces a manpage interpretation, as does + # something looking like L. The latter is an + # enhancement over the original Pod::Text. + my ($manpage, $section) = ('', $_); + if (/^(?:https?|ftp|news):/) { + # a URL + return $_; + } elsif (/^"\s*(.*?)\s*"$/) { + $section = '"' . $1 . '"'; + } elsif (m/^[-:.\w]+(?:\(\S+\))?$/) { + ($manpage, $section) = ($_, ''); + } elsif (m{/}) { + ($manpage, $section) = split (/\s*\/\s*/, $_, 2); + } + + my $text = ''; + # Now build the actual output text. + if (!length $section) { + $text = "the $manpage manpage" if length $manpage; + } elsif ($section =~ /^[:\w]+(?:\(\))?/) { + $text .= 'the ' . $section . ' entry'; + $text .= (length $manpage) ? " in the $manpage manpage" + : ' elsewhere in this document'; + } else { + $section =~ s/^\"\s*//; + $section =~ s/\s*\"$//; + $text .= 'the section on "' . $section . '"'; + $text .= " in the $manpage manpage" if length $manpage; + } + return $text; +} + + +############################################################################ +# List handling +############################################################################ + +# This method is called whenever an =item command is complete (in other +# words, we've seen its associated paragraph or know for certain that it +# doesn't have one). It gets the paragraph associated with the item as an +# argument. If that argument is empty, just output the item tag; if it +# contains a newline, output the item tag followed by the newline. +# Otherwise, see if there's enough room for us to output the item tag in the +# margin of the text or if we have to put it on a separate line. +sub item { + my $self = shift; + local $_ = shift; + my $tag = $$self{ITEM}; + unless (defined $tag) { + carp 'item called without tag'; + return; + } + undef $$self{ITEM}; + my $indent = $$self{INDENTS}[-1]; + unless (defined $indent) { $indent = $$self{indent} } + my $space = ' ' x $indent; + $space =~ s/^ /:/ if $$self{alt}; + if (!$_ || /^\s+$/ || ($$self{MARGIN} - $indent < length ($tag) + 1)) { + my $margin = $$self{MARGIN}; + $$self{MARGIN} = $indent; + my $output = $self->reformat ($tag); + $output =~ s/[\r\n]*$/\n/; + $self->output ($output); + $$self{MARGIN} = $margin; + $self->output ($self->reformat ($_)) if /\S/; + } else { + $_ = $self->reformat ($_); + s/^ /:/ if ($$self{alt} && $indent > 0); + my $tagspace = ' ' x length $tag; + s/^($space)$tagspace/$1$tag/ or carp 'Bizarre space in item'; + $self->output ($_); + } +} + + +############################################################################ +# Output formatting +############################################################################ + +# Wrap a line, indenting by the current left margin. We can't use +# Text::Wrap because it plays games with tabs. We can't use formline, even +# though we'd really like to, because it screws up non-printing characters. +# So we have to do the wrapping ourselves. +sub wrap { + my $self = shift; + local $_ = shift; + my $output = ''; + my $spaces = ' ' x $$self{MARGIN}; + my $width = $$self{width} - $$self{MARGIN}; + while (length > $width) { + if (s/^([^\r\n]{0,$width})\s+// || s/^([^\r\n]{$width})//) { + $output .= $spaces . $1 . "\n"; + } else { + last; + } + } + $output .= $spaces . $_; + $output =~ s/\s+$/\n\n/; + return $output; +} + +# Reformat a paragraph of text for the current margin. Takes the text to +# reformat and returns the formatted text. +sub reformat { + my $self = shift; + local $_ = shift; + + # If we're trying to preserve two spaces after sentences, do some + # munging to support that. Otherwise, smash all repeated whitespace. + if ($$self{sentence}) { + s/ +$//mg; + s/\.\r?\n/. \n/g; + s/[\r\n]+/ /g; + s/ +/ /g; + } else { + s/\s+/ /g; + } + return $self->wrap($_); +} + +# Output text to the output device. +sub output { $_[1] =~ tr/\01/ /; print { $_[0]->output_handle } $_[1] } + + +############################################################################ +# Backwards compatibility +############################################################################ + +# The old Pod::Text module did everything in a pod2text() function. This +# tries to provide the same interface for legacy applications. +sub pod2text { + my @args; + + # This is really ugly; I hate doing option parsing in the middle of a + # module. But the old Pod::Text module supported passing flags to its + # entry function, so handle -a and -. + while ($_[0] =~ /^-/) { + my $flag = shift; + if ($flag eq '-a') { push (@args, alt => 1) } + elsif ($flag =~ /^-(\d+)$/) { push (@args, width => $1) } + else { + unshift (@_, $flag); + last; + } + } + + # Now that we know what arguments we're using, create the parser. + my $parser = Pod::PlainText->new (@args); + + # If two arguments were given, the second argument is going to be a file + # handle. That means we want to call parse_from_filehandle(), which + # means we need to turn the first argument into a file handle. Magic + # open will handle the <&STDIN case automagically. + if (defined $_[1]) { + my $infh; + if ($] < 5.006) { + $infh = gensym(); + } + unless (open ($infh, $_[0])) { + croak ("Can't open $_[0] for reading: $!\n"); + } + $_[0] = $infh; + return $parser->parse_from_filehandle (@_); + } else { + return $parser->parse_from_file (@_); + } +} + + +############################################################################ +# Module return value and documentation +############################################################################ + +1; +__END__ + +=head1 NAME + +Pod::PlainText - Convert POD data to formatted ASCII text + +=head1 SYNOPSIS + + use Pod::PlainText; + my $parser = Pod::PlainText->new (sentence => 0, width => 78); + + # Read POD from STDIN and write to STDOUT. + $parser->parse_from_filehandle; + + # Read POD from file.pod and write to file.txt. + $parser->parse_from_file ('file.pod', 'file.txt'); + +=head1 DESCRIPTION + +Pod::PlainText is a module that can convert documentation in the POD format (the +preferred language for documenting Perl) into formatted ASCII. It uses no +special formatting controls or codes whatsoever, and its output is therefore +suitable for nearly any device. + +As a derived class from Pod::Parser, Pod::PlainText supports the same methods and +interfaces. See L for all the details; briefly, one creates a +new parser with Cnew()> and then calls either +parse_from_filehandle() or parse_from_file(). + +new() can take options, in the form of key/value pairs, that control the +behavior of the parser. The currently recognized options are: + +=over 4 + +=item alt + +If set to a true value, selects an alternate output format that, among other +things, uses a different heading style and marks C<=item> entries with a +colon in the left margin. Defaults to false. + +=item indent + +The number of spaces to indent regular text, and the default indentation for +C<=over> blocks. Defaults to 4. + +=item loose + +If set to a true value, a blank line is printed after a C<=headN> headings. +If set to false (the default), no blank line is printed after C<=headN>. +This is the default because it's the expected formatting for manual pages; +if you're formatting arbitrary text documents, setting this to true may +result in more pleasing output. + +=item sentence + +If set to a true value, Pod::PlainText will assume that each sentence ends in two +spaces, and will try to preserve that spacing. If set to false, all +consecutive whitespace in non-verbatim paragraphs is compressed into a +single space. Defaults to true. + +=item width + +The column at which to wrap text on the right-hand side. Defaults to 76. + +=back + +The standard Pod::Parser method parse_from_filehandle() takes up to two +arguments, the first being the file handle to read POD from and the second +being the file handle to write the formatted output to. The first defaults +to STDIN if not given, and the second defaults to STDOUT. The method +parse_from_file() is almost identical, except that its two arguments are the +input and output disk files instead. See L for the specific +details. + +=head1 DIAGNOSTICS + +=over 4 + +=item Bizarre space in item + +(W) Something has gone wrong in internal C<=item> processing. This message +indicates a bug in Pod::PlainText; you should never see it. + +=item Can't open %s for reading: %s + +(F) Pod::PlainText was invoked via the compatibility mode pod2text() interface +and the input file it was given could not be opened. + +=item Unknown escape: %s + +(W) The POD source contained an CE> escape that Pod::PlainText didn't +know about. + +=item Unknown sequence: %s + +(W) The POD source contained a non-standard internal sequence (something of +the form CE>) that Pod::PlainText didn't know about. + +=item Unmatched =back + +(W) Pod::PlainText encountered a C<=back> command that didn't correspond to an +C<=over> command. + +=back + +=head1 RESTRICTIONS + +Embedded Ctrl-As (octal 001) in the input will be mapped to spaces on +output, due to an internal implementation detail. + +=head1 NOTES + +This is a replacement for an earlier Pod::Text module written by Tom +Christiansen. It has a revamped interface, since it now uses Pod::Parser, +but an interface roughly compatible with the old Pod::Text::pod2text() +function is still available. Please change to the new calling convention, +though. + +The original Pod::Text contained code to do formatting via termcap +sequences, although it wasn't turned on by default and it was problematic to +get it to work at all. This rewrite doesn't even try to do that, but a +subclass of it does. Look for L. + +=head1 SEE ALSO + +B is part of the L distribution. + +L, L, +pod2text(1) + +=head1 AUTHOR + +Please report bugs using L. + +Russ Allbery Erra@stanford.eduE, based I heavily on the +original Pod::Text by Tom Christiansen Etchrist@mox.perl.comE and +its conversion to Pod::Parser by Brad Appleton +Ebradapp@enteract.comE. + +=cut diff --git a/cpan/Pod-Usage/t/inc/Pod/Select.pm b/cpan/Pod-Usage/t/inc/Pod/Select.pm new file mode 100644 index 0000000..148b5d1 --- /dev/null +++ b/cpan/Pod-Usage/t/inc/Pod/Select.pm @@ -0,0 +1,748 @@ +############################################################################# +# Pod/Select.pm -- function to select portions of POD docs +# +# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved. +# This file is part of "PodParser". PodParser is free software; +# you can redistribute it and/or modify it under the same terms +# as Perl itself. +############################################################################# + +package Pod::Select; +use strict; + +use vars qw($VERSION @ISA @EXPORT $MAX_HEADING_LEVEL %myData @section_headings @selected_sections); +$VERSION = '1.60'; ## Current version of this package +require 5.005; ## requires this Perl version or later + +############################################################################# + +=head1 NAME + +Pod::Select, podselect() - extract selected sections of POD from input + +=head1 SYNOPSIS + + use Pod::Select; + + ## Select all the POD sections for each file in @filelist + ## and print the result on standard output. + podselect(@filelist); + + ## Same as above, but write to tmp.out + podselect({-output => "tmp.out"}, @filelist): + + ## Select from the given filelist, only those POD sections that are + ## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS. + podselect({-sections => ["NAME|SYNOPSIS", "OPTIONS"]}, @filelist): + + ## Select the "DESCRIPTION" section of the PODs from STDIN and write + ## the result to STDERR. + podselect({-output => ">&STDERR", -sections => ["DESCRIPTION"]}, \*STDIN); + +or + + use Pod::Select; + + ## Create a parser object for selecting POD sections from the input + $parser = new Pod::Select(); + + ## Select all the POD sections for each file in @filelist + ## and print the result to tmp.out. + $parser->parse_from_file("<&STDIN", "tmp.out"); + + ## Select from the given filelist, only those POD sections that are + ## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS. + $parser->select("NAME|SYNOPSIS", "OPTIONS"); + for (@filelist) { $parser->parse_from_file($_); } + + ## Select the "DESCRIPTION" and "SEE ALSO" sections of the PODs from + ## STDIN and write the result to STDERR. + $parser->select("DESCRIPTION"); + $parser->add_selection("SEE ALSO"); + $parser->parse_from_filehandle(\*STDIN, \*STDERR); + +=head1 REQUIRES + +perl5.005, Pod::Parser, Exporter, Carp + +=head1 EXPORTS + +podselect() + +=head1 DESCRIPTION + +B is a function which will extract specified sections of +pod documentation from an input stream. This ability is provided by the +B module which is a subclass of B. +B provides a method named B to specify the set of +POD sections to select for processing/printing. B merely +creates a B object and then invokes the B +followed by B. + +=head1 SECTION SPECIFICATIONS + +B and B may be given one or more +"section specifications" to restrict the text processed to only the +desired set of sections and their corresponding subsections. A section +specification is a string containing one or more Perl-style regular +expressions separated by forward slashes ("/"). If you need to use a +forward slash literally within a section title you can escape it with a +backslash ("\/"). + +The formal syntax of a section specification is: + +=over 4 + +=item * + +I/I/... + +=back + +Any omitted or empty regular expressions will default to ".*". +Please note that each regular expression given is implicitly +anchored by adding "^" and "$" to the beginning and end. Also, if a +given regular expression starts with a "!" character, then the +expression is I (so C would match anything I +C). + +Some example section specifications follow. + +=over 4 + +=item * + +Match the C and C sections and all of their subsections: + +C + +=item * + +Match only the C and C subsections of the C +section: + +C + +=item * + +Match the C subsection of I sections: + +C + +=item * + +Match all subsections of C I for C: + +C + +=item * + +Match the C section but do I match any of its subsections: + +C + +=item * + +Match all top level sections but none of their subsections: + +C + +=back + +=begin _NOT_IMPLEMENTED_ + +=head1 RANGE SPECIFICATIONS + +B and B may be given one or more +"range specifications" to restrict the text processed to only the +desired ranges of paragraphs in the desired set of sections. A range +specification is a string containing a single Perl-style regular +expression (a regex), or else two Perl-style regular expressions +(regexs) separated by a ".." (Perl's "range" operator is ".."). +The regexs in a range specification are delimited by forward slashes +("/"). If you need to use a forward slash literally within a regex you +can escape it with a backslash ("\/"). + +The formal syntax of a range specification is: + +=over 4 + +=item * + +/I/[../I/] + +=back + +Where each the item inside square brackets (the ".." followed by the +end-range-regex) is optional. Each "range-regex" is of the form: + + =cmd-expr text-expr + +Where I is intended to match the name of one or more POD +commands, and I is intended to match the paragraph text for +the command. If a range-regex is supposed to match a POD command, then +the first character of the regex (the one after the initial '/') +absolutely I be a single '=' character; it may not be anything +else (not even a regex meta-character) if it is supposed to match +against the name of a POD command. + +If no I<=cmd-expr> is given then the text-expr will be matched against +plain textblocks unless it is preceded by a space, in which case it is +matched against verbatim text-blocks. If no I is given then +only the command-portion of the paragraph is matched against. + +Note that these two expressions are each implicitly anchored. This +means that when matching against the command-name, there will be an +implicit '^' and '$' around the given I<=cmd-expr>; and when matching +against the paragraph text there will be an implicit '\A' and '\Z' +around the given I. + +Unlike with section-specs, the '!' character does I have any special +meaning (negation or otherwise) at the beginning of a range-spec! + +Some example range specifications follow. + +=over 4 + +=item +Match all C<=for html> paragraphs: + +C + +=item +Match all paragraphs between C<=begin html> and C<=end html> +(note that this will I work correctly if such sections +are nested): + +C + +=item +Match all paragraphs between the given C<=item> name until the end of the +current section: + +C + +=item +Match all paragraphs between the given C<=item> until the next item, or +until the end of the itemized list (note that this will I work as +desired if the item contains an itemized list nested within it): + +C + +=back + +=end _NOT_IMPLEMENTED_ + +=cut + +############################################################################# + +#use diagnostics; +use Carp; +use Pod::Parser 1.04; + +@ISA = qw(Pod::Parser); +@EXPORT = qw(&podselect); + +## Maximum number of heading levels supported for '=headN' directives +*MAX_HEADING_LEVEL = \3; + +############################################################################# + +=head1 OBJECT METHODS + +The following methods are provided in this module. Each one takes a +reference to the object itself as an implicit first parameter. + +=cut + +##--------------------------------------------------------------------------- + +## =begin _PRIVATE_ +## +## =head1 B<_init_headings()> +## +## Initialize the current set of active section headings. +## +## =cut +## +## =end _PRIVATE_ + +sub _init_headings { + my $self = shift; + local *myData = $self; + + ## Initialize current section heading titles if necessary + unless (defined $myData{_SECTION_HEADINGS}) { + local *section_headings = $myData{_SECTION_HEADINGS} = []; + for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) { + $section_headings[$i] = ''; + } + } +} + +##--------------------------------------------------------------------------- + +=head1 B + + ($head1, $head2, $head3, ...) = $parser->curr_headings(); + $head1 = $parser->curr_headings(1); + +This method returns a list of the currently active section headings and +subheadings in the document being parsed. The list of headings returned +corresponds to the most recently parsed paragraph of the input. + +If an argument is given, it must correspond to the desired section +heading number, in which case only the specified section heading is +returned. If there is no current section heading at the specified +level, then C is returned. + +=cut + +sub curr_headings { + my $self = shift; + $self->_init_headings() unless (defined $self->{_SECTION_HEADINGS}); + my @headings = @{ $self->{_SECTION_HEADINGS} }; + return (@_ > 0 and $_[0] =~ /^\d+$/) ? $headings[$_[0] - 1] : @headings; +} + +##--------------------------------------------------------------------------- + +=head1 B + + $parser->select($section_spec1,$section_spec2,...); + +This method is used to select the particular sections and subsections of +POD documentation that are to be printed and/or processed. The existing +set of selected sections is I with the given set of sections. +See B for adding to the current set of selected +sections. + +Each of the C<$section_spec> arguments should be a section specification +as described in L<"SECTION SPECIFICATIONS">. The section specifications +are parsed by this method and the resulting regular expressions are +stored in the invoking object. + +If no C<$section_spec> arguments are given, then the existing set of +selected sections is cleared out (which means C sections will be +processed). + +This method should I normally be overridden by subclasses. + +=cut + +sub select { + my ($self, @sections) = @_; + local *myData = $self; + local $_; + +### NEED TO DISCERN A SECTION-SPEC FROM A RANGE-SPEC (look for m{^/.+/$}?) + + ##--------------------------------------------------------------------- + ## The following is a blatant hack for backward compatibility, and for + ## implementing add_selection(). If the *first* *argument* is the + ## string "+", then the remaining section specifications are *added* + ## to the current set of selections; otherwise the given section + ## specifications will *replace* the current set of selections. + ## + ## This should probably be fixed someday, but for the present time, + ## it seems incredibly unlikely that "+" would ever correspond to + ## a legitimate section heading + ##--------------------------------------------------------------------- + my $add = ($sections[0] eq '+') ? shift(@sections) : ''; + + ## Reset the set of sections to use + unless (@sections) { + delete $myData{_SELECTED_SECTIONS} unless ($add); + return; + } + $myData{_SELECTED_SECTIONS} = [] + unless ($add && exists $myData{_SELECTED_SECTIONS}); + local *selected_sections = $myData{_SELECTED_SECTIONS}; + + ## Compile each spec + for my $spec (@sections) { + if ( defined($_ = _compile_section_spec($spec)) ) { + ## Store them in our sections array + push(@selected_sections, $_); + } + else { + carp qq{Ignoring section spec "$spec"!\n}; + } + } +} + +##--------------------------------------------------------------------------- + +=head1 B + + $parser->add_selection($section_spec1,$section_spec2,...); + +This method is used to add to the currently selected sections and +subsections of POD documentation that are to be printed and/or +processed. See for replacing the currently selected sections. + +Each of the C<$section_spec> arguments should be a section specification +as described in L<"SECTION SPECIFICATIONS">. The section specifications +are parsed by this method and the resulting regular expressions are +stored in the invoking object. + +This method should I normally be overridden by subclasses. + +=cut + +sub add_selection { + my $self = shift; + return $self->select('+', @_); +} + +##--------------------------------------------------------------------------- + +=head1 B + + $parser->clear_selections(); + +This method takes no arguments, it has the exact same effect as invoking + with no arguments. + +=cut + +sub clear_selections { + my $self = shift; + return $self->select(); +} + +##--------------------------------------------------------------------------- + +=head1 B + + $boolean = $parser->match_section($heading1,$heading2,...); + +Returns a value of true if the given section and subsection heading +titles match any of the currently selected section specifications in +effect from prior calls to B and B (or if +there are no explicitly selected/deselected sections). + +The arguments C<$heading1>, C<$heading2>, etc. are the heading titles of +the corresponding sections, subsections, etc. to try and match. If +C<$headingN> is omitted then it defaults to the current corresponding +section heading title in the input. + +This method should I normally be overridden by subclasses. + +=cut + +sub match_section { + my $self = shift; + my (@headings) = @_; + local *myData = $self; + + ## Return true if no restrictions were explicitly specified + my $selections = (exists $myData{_SELECTED_SECTIONS}) + ? $myData{_SELECTED_SECTIONS} : undef; + return 1 unless ((defined $selections) && @{$selections}); + + ## Default any unspecified sections to the current one + my @current_headings = $self->curr_headings(); + for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) { + (defined $headings[$i]) or $headings[$i] = $current_headings[$i]; + } + + ## Look for a match against the specified section expressions + for my $section_spec ( @{$selections} ) { + ##------------------------------------------------------ + ## Each portion of this spec must match in order for + ## the spec to be matched. So we will start with a + ## match-value of 'true' and logically 'and' it with + ## the results of matching a given element of the spec. + ##------------------------------------------------------ + my $match = 1; + for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) { + my $regex = $section_spec->[$i]; + my $negated = ($regex =~ s/^\!//); + $match &= ($negated ? ($headings[$i] !~ /${regex}/) + : ($headings[$i] =~ /${regex}/)); + last unless ($match); + } + return 1 if ($match); + } + return 0; ## no match +} + +##--------------------------------------------------------------------------- + +=head1 B + + $boolean = $parser->is_selected($paragraph); + +This method is used to determine if the block of text given in +C<$paragraph> falls within the currently selected set of POD sections +and subsections to be printed or processed. This method is also +responsible for keeping track of the current input section and +subsections. It is assumed that C<$paragraph> is the most recently read +(but not yet processed) input paragraph. + +The value returned will be true if the C<$paragraph> and the rest of the +text in the same section as C<$paragraph> should be selected (included) +for processing; otherwise a false value is returned. + +=cut + +sub is_selected { + my ($self, $paragraph) = @_; + local $_; + local *myData = $self; + + $self->_init_headings() unless (defined $myData{_SECTION_HEADINGS}); + + ## Keep track of current sections levels and headings + $_ = $paragraph; + if (/^=((?:sub)*)(?:head(?:ing)?|sec(?:tion)?)(\d*)\s+(.*?)\s*$/) + { + ## This is a section heading command + my ($level, $heading) = ($2, $3); + $level = 1 + (length($1) / 3) if ((! length $level) || (length $1)); + ## Reset the current section heading at this level + $myData{_SECTION_HEADINGS}->[$level - 1] = $heading; + ## Reset subsection headings of this one to empty + for (my $i = $level; $i < $MAX_HEADING_LEVEL; ++$i) { + $myData{_SECTION_HEADINGS}->[$i] = ''; + } + } + + return $self->match_section(); +} + +############################################################################# + +=head1 EXPORTED FUNCTIONS + +The following functions are exported by this module. Please note that +these are functions (not methods) and therefore C take an +implicit first argument. + +=cut + +##--------------------------------------------------------------------------- + +=head1 B + + podselect(\%options,@filelist); + +B will print the raw (untranslated) POD paragraphs of all +POD sections in the given input files specified by C<@filelist> +according to the given options. + +If any argument to B is a reference to a hash +(associative array) then the values with the following keys are +processed as follows: + +=over 4 + +=item B<-output> + +A string corresponding to the desired output file (or ">&STDOUT" +or ">&STDERR"). The default is to use standard output. + +=item B<-sections> + +A reference to an array of sections specifications (as described in +L<"SECTION SPECIFICATIONS">) which indicate the desired set of POD +sections and subsections to be selected from input. If no section +specifications are given, then all sections of the PODs are used. + +=begin _NOT_IMPLEMENTED_ + +=item B<-ranges> + +A reference to an array of range specifications (as described in +L<"RANGE SPECIFICATIONS">) which indicate the desired range of POD +paragraphs to be selected from the desired input sections. If no range +specifications are given, then all paragraphs of the desired sections +are used. + +=end _NOT_IMPLEMENTED_ + +=back + +All other arguments should correspond to the names of input files +containing POD sections. A file name of "-" or "<&STDIN" will +be interpreted to mean standard input (which is the default if no +filenames are given). + +=cut + +sub podselect { + my(@argv) = @_; + my %defaults = (); + my $pod_parser = new Pod::Select(%defaults); + my $num_inputs = 0; + my $output = '>&STDOUT'; + my %opts; + local $_; + for (@argv) { + if (ref($_)) { + next unless (ref($_) eq 'HASH'); + %opts = (%defaults, %{$_}); + + ##------------------------------------------------------------- + ## Need this for backward compatibility since we formerly used + ## options that were all uppercase words rather than ones that + ## looked like Unix command-line options. + ## to be uppercase keywords) + ##------------------------------------------------------------- + %opts = map { + my ($key, $val) = (lc $_, $opts{$_}); + $key =~ s/^(?=\w)/-/; + $key =~ /^-se[cl]/ and $key = '-sections'; + #! $key eq '-range' and $key .= 's'; + ($key => $val); + } (keys %opts); + + ## Process the options + (exists $opts{'-output'}) and $output = $opts{'-output'}; + + ## Select the desired sections + $pod_parser->select(@{ $opts{'-sections'} }) + if ( (defined $opts{'-sections'}) + && ((ref $opts{'-sections'}) eq 'ARRAY') ); + + #! ## Select the desired paragraph ranges + #! $pod_parser->select(@{ $opts{'-ranges'} }) + #! if ( (defined $opts{'-ranges'}) + #! && ((ref $opts{'-ranges'}) eq 'ARRAY') ); + } + else { + $pod_parser->parse_from_file($_, $output); + ++$num_inputs; + } + } + $pod_parser->parse_from_file('-') unless ($num_inputs > 0); +} + +############################################################################# + +=head1 PRIVATE METHODS AND DATA + +B makes uses a number of internal methods and data fields +which clients should not need to see or use. For the sake of avoiding +name collisions with client data and methods, these methods and fields +are briefly discussed here. Determined hackers may obtain further +information about them by reading the B source code. + +Private data fields are stored in the hash-object whose reference is +returned by the B constructor for this class. The names of all +private methods and data-fields used by B begin with a +prefix of "_" and match the regular expression C. + +=cut + +##--------------------------------------------------------------------------- + +=begin _PRIVATE_ + +=head1 B<_compile_section_spec()> + + $listref = $parser->_compile_section_spec($section_spec); + +This function (note it is a function and I a method) takes a +section specification (as described in L<"SECTION SPECIFICATIONS">) +given in C<$section_sepc>, and compiles it into a list of regular +expressions. If C<$section_spec> has no syntax errors, then a reference +to the list (array) of corresponding regular expressions is returned; +otherwise C is returned and an error message is printed (using +B) for each invalid regex. + +=end _PRIVATE_ + +=cut + +sub _compile_section_spec { + my ($section_spec) = @_; + my (@regexs, $negated); + + ## Compile the spec into a list of regexs + local $_ = $section_spec; + s{\\\\}{\001}g; ## handle escaped backward slashes + s{\\/}{\002}g; ## handle escaped forward slashes + + ## Parse the regexs for the heading titles + @regexs = split(/\//, $_, $MAX_HEADING_LEVEL); + + ## Set default regex for ommitted levels + for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) { + $regexs[$i] = '.*' unless ((defined $regexs[$i]) + && (length $regexs[$i])); + } + ## Modify the regexs as needed and validate their syntax + my $bad_regexs = 0; + for (@regexs) { + $_ .= '.+' if ($_ eq '!'); + s{\001}{\\\\}g; ## restore escaped backward slashes + s{\002}{\\/}g; ## restore escaped forward slashes + $negated = s/^\!//; ## check for negation + eval "m{$_}"; ## check regex syntax + if ($@) { + ++$bad_regexs; + carp qq{Bad regular expression /$_/ in "$section_spec": $@\n}; + } + else { + ## Add the forward and rear anchors (and put the negator back) + $_ = '^' . $_ unless (/^\^/); + $_ = $_ . '$' unless (/\$$/); + $_ = '!' . $_ if ($negated); + } + } + return (! $bad_regexs) ? [ @regexs ] : undef; +} + +##--------------------------------------------------------------------------- + +=begin _PRIVATE_ + +=head2 $self->{_SECTION_HEADINGS} + +A reference to an array of the current section heading titles for each +heading level (note that the first heading level title is at index 0). + +=end _PRIVATE_ + +=cut + +##--------------------------------------------------------------------------- + +=begin _PRIVATE_ + +=head2 $self->{_SELECTED_SECTIONS} + +A reference to an array of references to arrays. Each subarray is a list +of anchored regular expressions (preceded by a "!" if the expression is to +be negated). The index of the expression in the subarray should correspond +to the index of the heading title in C<$self-E{_SECTION_HEADINGS}> +that it is to be matched against. + +=end _PRIVATE_ + +=cut + +############################################################################# + +=head1 SEE ALSO + +L + +=head1 AUTHOR + +Please report bugs using L. + +Brad Appleton Ebradapp@enteract.comE + +Based on code for B written by +Tom Christiansen Etchrist@mox.perl.comE + +B is part of the L distribution. + +=cut + +1; +# vim: ts=4 sw=4 et diff --git a/cpan/Pod-Usage/t/pod/pod2usage2.t b/cpan/Pod-Usage/t/pod/pod2usage2.t index c0bbfdb..7eb5402 100644 --- a/cpan/Pod-Usage/t/pod/pod2usage2.t +++ b/cpan/Pod-Usage/t/pod/pod2usage2.t @@ -8,7 +8,7 @@ BEGIN { plan skip_all => "Not portable on Win32 or VMS\n"; } else { - plan tests => 34; + plan tests => 33; } use_ok ("Pod::Usage"); } @@ -217,14 +217,14 @@ ok (compare ($text, <<'EOT'), "Output test pod2usage with USAGE and verbose=99") # EOT -# test with pod_where -use_ok('Pod::Find', qw(pod_where)); +# test with self -($exit, $text) = getoutput( sub { pod2usage( -input => pod_where({-inc => 1}, 'Pod::Usage'), +my $src = File::Spec->catfile(qw(lib Pod Usage.pm)); +($exit, $text) = getoutput( sub { pod2usage( -input => $src, -exitval => 0, -verbose => 0) } ); $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR -is ($exit, 0, "Exit status pod2usage with Pod::Find"); -ok (compare ($text, <<'EOT'), "Output test pod2usage with Pod::Find") or diag "Got:\n$text\n"; +is ($exit, 0, "Exit status pod2usage with self"); +ok (compare ($text, <<'EOT'), "Output test pod2usage with self") or diag "Got:\n$text\n"; #Usage: # use Pod::Usage # diff --git a/cpan/Pod-Usage/t/pod/testp2pt.pl b/cpan/Pod-Usage/t/pod/testp2pt.pl index 308cd1c..cd31245 100644 --- a/cpan/Pod-Usage/t/pod/testp2pt.pl +++ b/cpan/Pod-Usage/t/pod/testp2pt.pl @@ -1,5 +1,7 @@ package TestPodIncPlainText; +my $PARENTDIR; + BEGIN { use File::Basename; use File::Spec; @@ -9,7 +11,7 @@ BEGIN { unshift @INC, $THISDIR; require "testcmp.pl"; import TestCompare; - my $PARENTDIR = dirname $THISDIR; + $PARENTDIR = dirname $THISDIR; push @INC, map { File::Spec->catfile($_, 'lib') } ($PARENTDIR, $THISDIR); } @@ -24,6 +26,10 @@ use vars qw($MYPKG @EXPORT @ISA); $MYPKG = eval { (caller)[0] }; @EXPORT = qw(&testpodplaintext); BEGIN { + # we want this for testing only + unshift(@INC, File::Spec->catfile($PARENTDIR, 'inc')); +print "INC=@INC\n"; + require Pod::PlainText; @ISA = qw( Pod::PlainText ); require VMS::Filespec if $^O eq 'VMS'; diff --git a/cpan/Test-Simple/lib/Test/Builder.pm b/cpan/Test-Simple/lib/Test/Builder.pm index 892d609..6e0c88e 100644 --- a/cpan/Test-Simple/lib/Test/Builder.pm +++ b/cpan/Test-Simple/lib/Test/Builder.pm @@ -4,7 +4,7 @@ use 5.006; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; BEGIN { if( $] < 5.008 ) { @@ -12,8 +12,6 @@ BEGIN { } } -use overload(); - use Scalar::Util qw/blessed reftype weaken/; use Test2::Util qw/USE_THREADS try get_tid/; @@ -40,16 +38,7 @@ use Test::Builder::Formatter; use Test::Builder::TodoDiag; our $Level = 1; -our $Test = Test::Builder->new; - -# Non-TB tools normally expect 0 added to the level. $Level is normally 1. So -# we only want the level to change if $Level != 1. -# TB->ctx compensates for this later. -Test2::API::test2_add_callback_context_aquire(sub {$_[0]->{level} += $Level - 1}); - -Test2::API::test2_add_callback_exit(sub { $Test->_ending(@_) }); - -Test2::API::test2_ipc()->set_no_fatal(1) if USE_THREADS; +our $Test = $ENV{TB_NO_EARLY_INIT} ? undef : Test::Builder->new; sub _add_ts_hooks { my $self = shift; @@ -102,6 +91,15 @@ sub new { my $ctx = context(); $Test = $class->create(singleton => 1); $ctx->release; + + # Non-TB tools normally expect 0 added to the level. $Level is normally 1. So + # we only want the level to change if $Level != 1. + # TB->ctx compensates for this later. + Test2::API::test2_add_callback_context_aquire(sub { $_[0]->{level} += $Level - 1 }); + + Test2::API::test2_add_callback_exit(sub { $Test->_ending(@_) }); + + Test2::API::test2_ipc()->set_no_fatal(1) if USE_THREADS; } return $Test; } @@ -304,7 +302,7 @@ sub subtest { ($err, $child_error) = ($@, $?); # They might have done 'BEGIN { skip_all => "whatever" }' - if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/) { + if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/ || (blessed($err) && blessed($err) eq 'Test::Builder::Exception')) { $ok = undef; $err = undef; } @@ -486,6 +484,12 @@ sub no_plan { my $ctx = $self->ctx; + if (defined $ctx->hub->plan) { + warn "Plan already set, no_plan() is a no-op, this will change to a hard failure in the future."; + $ctx->release; + return; + } + $ctx->alert("no_plan takes no arguments") if $arg; $ctx->hub->plan('NO PLAN'); @@ -685,6 +689,10 @@ sub _unoverload { return unless ref $$thing; return unless blessed($$thing) || scalar $self->_try(sub{ $$thing->isa('UNIVERSAL') }); + { + local ($!, $@); + require overload; + } my $string_meth = overload::Method( $$thing, $type ) || return; $$thing = $$thing->$string_meth(); } @@ -1731,9 +1739,9 @@ Ok, so there can be more than one Test::Builder object and this is how you get it. You might use this instead of C if you're testing a Test::Builder based module, but otherwise you probably want C. -B: the implementation is not complete. C, for example, is -still shared amongst B Test::Builder objects, even ones created using -this method. Also, the method name may change in the future. +B: the implementation is not complete. C, for example, is still +shared by B Test::Builder objects, even ones created using this method. +Also, the method name may change in the future. =item B @@ -1780,19 +1788,6 @@ will print the appropriate headers and take the appropriate actions. If you call C, don't call any of the other methods below. -If a child calls "skip_all" in the plan, a C is -thrown. Trap this error, call C and don't run any more tests on -the child. - - my $child = $Test->child('some child'); - eval { $child->plan( $condition ? ( skip_all => $reason ) : ( tests => 3 ) ) }; - if ( eval { $@->isa('Test::Builder::Exception') } ) { - $child->finalize; - return; - } - # run your tests - - =item B my $max = $Test->expected_tests; @@ -2020,7 +2015,7 @@ Takes a quoted regular expression produced by C, or a string representing a regular expression. Returns a Perl value which may be used instead of the corresponding -regular expression, or C if its argument is not recognised. +regular expression, or C if its argument is not recognized. For example, a version of C, sans the useful diagnostic messages, could be written as: @@ -2440,9 +2435,9 @@ If you fail more than 254 tests, it will be reported as 254. =head1 THREADS -In perl 5.8.1 and later, Test::Builder is thread-safe. The test -number is shared amongst all threads. This means if one thread sets -the test number using C they will all be effected. +In perl 5.8.1 and later, Test::Builder is thread-safe. The test number is +shared by all threads. This means if one thread sets the test number using +C they will all be effected. While versions earlier than 5.8.1 had threads they contain too many bugs to support. diff --git a/cpan/Test-Simple/lib/Test/Builder/Formatter.pm b/cpan/Test-Simple/lib/Test/Builder/Formatter.pm index f458f13..bfa429a 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Formatter.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Formatter.pm @@ -2,9 +2,9 @@ package Test::Builder::Formatter; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; -use base 'Test2::Formatter::TAP'; +BEGIN { require Test2::Formatter::TAP; our @ISA = qw(Test2::Formatter::TAP) } use Test2::Util::HashBase qw/no_header no_diag/; diff --git a/cpan/Test-Simple/lib/Test/Builder/Module.pm b/cpan/Test-Simple/lib/Test/Builder/Module.pm index 8f30974..fbdcdc2 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Module.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Module.pm @@ -2,12 +2,12 @@ package Test::Builder::Module; use strict; -use Test::Builder 1.00; +use Test::Builder; require Exporter; our @ISA = qw(Exporter); -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; =head1 NAME @@ -89,7 +89,8 @@ sub import { $test->plan(@_); - $class->export_to_level( 1, $class, @imports ); + local $Exporter::ExportLevel = $Exporter::ExportLevel + 1; + $class->Exporter::import(@imports); } sub _strip_imports { diff --git a/cpan/Test-Simple/lib/Test/Builder/Tester.pm b/cpan/Test-Simple/lib/Test/Builder/Tester.pm index 3b1f53e..3fcf665 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Tester.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Tester.pm @@ -1,9 +1,9 @@ package Test::Builder::Tester; use strict; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; -use Test::Builder 0.99; +use Test::Builder; use Symbol; use Carp; diff --git a/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm b/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm index 8913412..8ed6c50 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm @@ -1,7 +1,7 @@ package Test::Builder::Tester::Color; use strict; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; require Test::Builder::Tester; diff --git a/cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm b/cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm index d22fb33..379ec3b 100644 --- a/cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm +++ b/cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm @@ -2,9 +2,9 @@ package Test::Builder::TodoDiag; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; -use base 'Test2::Event::Diag'; +BEGIN { require Test2::Event::Diag; our @ISA = qw(Test2::Event::Diag) } sub diagnostics { 0 } diff --git a/cpan/Test-Simple/lib/Test/FAQ.pod b/cpan/Test-Simple/lib/Test/FAQ.pod index 2f81fe0..5de8d16 100644 --- a/cpan/Test-Simple/lib/Test/FAQ.pod +++ b/cpan/Test-Simple/lib/Test/FAQ.pod @@ -33,7 +33,7 @@ Yes, L allows you to write test methods while continuing to use all the usual CPAN testing modules. It is the best and most perlish way to do xUnit style testing. -L is a more direct port of XUnit to Perl, but it does not use +L is a more direct port of xUnit to Perl, but it does not use the Perl conventions and does not play well with other CPAN testing modules. As of this writing, it is abandoned. B. @@ -269,7 +269,7 @@ recall the Dummy Mode. could tell her to run naked across campus with a powercord rammed up her backside and she'd probably do it... Hmmm... -There seems to be a Dummy Mode WRT testing. An otherwise competent +There seems to be a Dummy Mode with respect to testing. An otherwise competent person goes to write a test and they suddenly forget all basic programming practice. diff --git a/cpan/Test-Simple/lib/Test/More.pm b/cpan/Test-Simple/lib/Test/More.pm index 89814bb..275de7a 100644 --- a/cpan/Test-Simple/lib/Test/More.pm +++ b/cpan/Test-Simple/lib/Test/More.pm @@ -17,9 +17,9 @@ sub _carp { return warn @_, " at $file line $line\n"; } -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; -use Test::Builder::Module 0.99; +use Test::Builder::Module; our @ISA = qw(Test::Builder::Module); our @EXPORT = qw(ok use_ok require_ok is isnt like unlike is_deeply @@ -175,12 +175,22 @@ sub import_extra { my @other = (); my $idx = 0; + my $import; while( $idx <= $#{$list} ) { my $item = $list->[$idx]; if( defined $item and $item eq 'no_diag' ) { $class->builder->no_diag(1); } + elsif( defined $item and $item eq 'import' ) { + if ($import) { + push @$import, @{$list->[ ++$idx ]}; + } + else { + $import = $list->[ ++$idx ]; + push @other, $item, $import; + } + } else { push @other, $item; } @@ -190,6 +200,18 @@ sub import_extra { @$list = @other; + if ($class eq __PACKAGE__ && (!$import || grep $_ eq '$TODO', @$import)) { + my $to = $class->builder->exported_to; + no strict 'refs'; + *{"$to\::TODO"} = \our $TODO; + if ($import) { + @$import = grep $_ ne '$TODO', @$import; + } + else { + push @$list, import => [grep $_ ne '$TODO', @EXPORT]; + } + } + return; } diff --git a/cpan/Test-Simple/lib/Test/Simple.pm b/cpan/Test-Simple/lib/Test/Simple.pm index f0a685f..d42f401 100644 --- a/cpan/Test-Simple/lib/Test/Simple.pm +++ b/cpan/Test-Simple/lib/Test/Simple.pm @@ -4,9 +4,9 @@ use 5.006; use strict; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; -use Test::Builder::Module 0.99; +use Test::Builder::Module; our @ISA = qw(Test::Builder::Module); our @EXPORT = qw(ok); diff --git a/cpan/Test-Simple/lib/Test/Tester.pm b/cpan/Test-Simple/lib/Test/Tester.pm index e8785b0..28a3acb 100644 --- a/cpan/Test-Simple/lib/Test/Tester.pm +++ b/cpan/Test-Simple/lib/Test/Tester.pm @@ -18,7 +18,7 @@ require Exporter; use vars qw( @ISA @EXPORT ); -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; @EXPORT = qw( run_tests check_tests check_test cmp_results show_space ); @ISA = qw( Exporter ); @@ -40,7 +40,7 @@ sub show_space my $colour = ''; my $reset = ''; -if (my $want_colour = $ENV{TESTTESTERCOLOUR} || $ENV{TESTTESTERCOLOUR}) +if (my $want_colour = $ENV{TESTTESTERCOLOUR} || $ENV{TESTTESTERCOLOR}) { if (eval "require Term::ANSIColor") { @@ -447,7 +447,7 @@ diagnostics output B the test result is declared. Note that Test::Builder ensures that any diagnostics end in a \n and it in earlier versions of Test::Tester it was essential that you have -the final \n in your expected diagnostics. From version 0.10 onwards, +the final \n in your expected diagnostics. From version 0.10 onward, Test::Tester will add the \n if you forgot it. It will not add a \n if you are expecting no diagnostics. See below for help tracking down hard to find space and tab related problems. @@ -496,7 +496,7 @@ are scratching your head trying to work out why Test::Tester is saying that your diagnostics are wrong when they look perfectly right then the answer is probably whitespace. From version 0.10 on, Test::Tester surrounds the expected and got diag values with single quotes to make it easier to spot -trailing whitesapce. So in this example +trailing whitespace. So in this example # Got diag (5 bytes): # 'abcd ' @@ -514,7 +514,7 @@ switch Test::Tester into a mode whereby all "tricky" characters are shown as \{xx}. Tricky characters are those with ASCII code less than 33 or higher than 126. This makes the output more difficult to read but much easier to find subtle differences between strings. To turn on this mode either call -show_space() in your test script or set the TESTTESTERSPACE environment +C in your test script or set the C environment variable to be a true value. The example above would then look like # Got diag (5 bytes): @@ -525,13 +525,13 @@ variable to be a true value. The example above would then look like =head1 COLOUR If you prefer to use colour as a means of finding tricky whitespace -characters then you can set the TESTTESTCOLOUR environment variable to a +characters then you can set the C environment variable to a comma separated pair of colours, the first for the foreground, the second for the background. For example "white,red" will print white text on a red background. This requires the Term::ANSIColor module. You can specify any colour that would be acceptable to the Term::ANSIColor::color function. -If you spell colour differently, that's no problem. The TESTTESTERCOLOR +If you spell colour differently, that's no problem. The C variable also works (if both are set then the British spelling wins out). =head1 EXPORTED FUNCTIONS diff --git a/cpan/Test-Simple/lib/Test/Tester/Capture.pm b/cpan/Test-Simple/lib/Test/Tester/Capture.pm index 0217e98..d486dca 100644 --- a/cpan/Test-Simple/lib/Test/Tester/Capture.pm +++ b/cpan/Test-Simple/lib/Test/Tester/Capture.pm @@ -2,7 +2,7 @@ use strict; package Test::Tester::Capture; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; use Test::Builder; diff --git a/cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm b/cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm index defd2f1..3b0d688 100644 --- a/cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm +++ b/cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm @@ -3,7 +3,7 @@ use strict; package Test::Tester::CaptureRunner; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; use Test::Tester::Capture; diff --git a/cpan/Test-Simple/lib/Test/Tester/Delegate.pm b/cpan/Test-Simple/lib/Test/Tester/Delegate.pm index 6bcfc54..8b1f167 100644 --- a/cpan/Test-Simple/lib/Test/Tester/Delegate.pm +++ b/cpan/Test-Simple/lib/Test/Tester/Delegate.pm @@ -3,7 +3,7 @@ use warnings; package Test::Tester::Delegate; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; use vars '$AUTOLOAD'; diff --git a/cpan/Test-Simple/lib/Test/use/ok.pm b/cpan/Test-Simple/lib/Test/use/ok.pm index 40b6690..769b30f 100644 --- a/cpan/Test-Simple/lib/Test/use/ok.pm +++ b/cpan/Test-Simple/lib/Test/use/ok.pm @@ -1,7 +1,7 @@ package Test::use::ok; use 5.005; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; __END__ diff --git a/cpan/Test-Simple/lib/Test2.pm b/cpan/Test-Simple/lib/Test2.pm index ac12b0e..3f4c819 100644 --- a/cpan/Test-Simple/lib/Test2.pm +++ b/cpan/Test-Simple/lib/Test2.pm @@ -2,7 +2,7 @@ package Test2; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; 1; @@ -25,7 +25,7 @@ completely refactoring it, adding many new features and capabilities. =head1 GETTING STARTED If you are interested in writing tests using new tools then you should look at -L. L is a seperate cpan distribution that contains +L. L is a separate cpan distribution that contains many tools implemented on Test2. If you are interested in writing new tools you should take a look at @@ -67,12 +67,12 @@ perls, or when non-essential modules have not been installed. =head2 Test2::Formatter:: Formatters live under this namespace. L is the only -formatter currently. It is acceptible for third party distributions to create +formatter currently. It is acceptable for third party distributions to create new formatters under this namespace. =head2 Test2::Event:: -Events live under this namespace. It is considered acceptible for third party +Events live under this namespace. It is considered acceptable for third party distributions to add new event types in this namespace. =head2 Test2::Hub:: @@ -102,8 +102,8 @@ This is for Test2 API and related packages. =head2 Test2:: -The Test2:: namespace is intended for extentions and frameworks. Tools, -Plugins, etc should not go directly into this namespace. However extentions +The Test2:: namespace is intended for extensions and frameworks. Tools, +Plugins, etc should not go directly into this namespace. However extensions that are used to build tools and plugins may go here. In short: If the module exports anything that should be run directly by a test diff --git a/cpan/Test-Simple/lib/Test2/API.pm b/cpan/Test-Simple/lib/Test2/API.pm index 32cd49a..55e359a 100644 --- a/cpan/Test-Simple/lib/Test2/API.pm +++ b/cpan/Test-Simple/lib/Test2/API.pm @@ -2,7 +2,7 @@ package Test2::API; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; my $INST; @@ -99,26 +99,7 @@ our @EXPORT_OK = qw{ test2_formatter_add test2_formatter_set }; -use base 'Exporter'; - -# There is a use-cycle between API and API/Context. Context needs to use some -# API functions as the package is compiling. Test2::API::context() needs -# Test2::API::Context to be loaded, but we cannot 'require' the module there as -# it causes a very noticable performance impact with how often context() is -# called. -# -# This will make sure that Context.pm is loaded the first time this module is -# imported, then the regular import method is swapped into place. -sub import { - require Test2::API::Context unless $INC{'Test2/API/Context.pm'}; - - { - no warnings 'redefine'; - *import = \&Exporter::import; - } - - goto &import; -} +BEGIN { require Exporter; our @ISA = qw(Exporter) } my $STACK = $INST->stack; my $CONTEXTS = $INST->contexts; @@ -293,7 +274,7 @@ sub context { delete $CONTEXTS->{$hid}; } - # Directly bless the object here, calling new is a noticable performance + # Directly bless the object here, calling new is a noticeable performance # hit with how often this needs to be called. my $trace = bless( { @@ -304,7 +285,7 @@ sub context { 'Test2::Util::Trace' ); - # Directly bless the object here, calling new is a noticable performance + # Directly bless the object here, calling new is a noticeable performance # hit with how often this needs to be called. my $aborted = 0; $current = bless( @@ -468,7 +449,7 @@ sub run_subtest { $err = $@; # They might have done 'BEGIN { skip_all => "whatever" }' - if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/) { + if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/ || (blessed($err) && blessed($err) eq 'Test::Builder::Exception')) { $ok = undef; $err = undef; } @@ -519,6 +500,13 @@ sub run_subtest { return $pass; } +# There is a use-cycle between API and API/Context. Context needs to use some +# API functions as the package is compiling. Test2::API::context() needs +# Test2::API::Context to be loaded, but we cannot 'require' the module there as +# it causes a very noticeable performance impact with how often context() is +# called. +require Test2::API::Context; + 1; __END__ @@ -534,7 +522,7 @@ Test2::API - Primary interface for writing Test2 based testing tools. =head1 ***INTERNALS NOTE*** B The public -methods provided will not change in backwords incompatible ways (once there is +methods provided will not change in backwards-incompatible ways (once there is a stable release), but the underlying implementation details might. B @@ -558,7 +546,7 @@ tools. Using these building blocks you can begin writing test tools very quickly. You are also provided with tools that help you to test the tools you write. -=head1 SYNOPSYS +=head1 SYNOPSIS =head2 WRITING A TOOL @@ -579,7 +567,7 @@ The C method is your primary interface into the Test2 framework. return $bool; } -See L for a list of methods avabilable on the context object. +See L for a list of methods available on the context object. =head2 TESTING YOUR TOOLS @@ -673,7 +661,7 @@ All parameters to C are optional. =item level => $int -If you must obtain a context in a sub deper than your entry point you can use +If you must obtain a context in a sub deeper than your entry point you can use this to tell it how many EXTRA stack frames to look back. If this option is not provided the default of C<0> is used. @@ -919,7 +907,7 @@ The code to run inside the subtest. =item $BUFFERED or \%PARAMS If this is a simple scalar then it will be treated as a boolean for the -'buffered' setting. If this is a hash reference then it wil be used as a +'buffered' setting. If this is a hash reference then it will be used as a parameters hash. The param hash will be used for hub construction (with the 'buffered' key removed). @@ -935,7 +923,7 @@ Any extra arguments you want passed into the subtest code. =head3 BUFFERED VS UNBUFFERED (OR STREAMED) Normally all events inside and outside a subtest are sent to the formatter -immedietly by the hub. Sometimes it is desirable to hold off sending events +immediately by the hub. Sometimes it is desirable to hold off sending events within a subtest until the subtest is complete. This usually depends on the formatter being used. @@ -966,7 +954,7 @@ C attribute. A formatter can specify by implementing the C method. If this method returns true then events generated inside a buffered subtest will not be -sent independantly of the final subtest event. +sent independently of the final subtest event. =back @@ -983,7 +971,7 @@ parallel, without it the subtests would be garbled. Exports in this section are not commonly needed. These all have the 'test2_' prefix to help ensure they stand out. You should look at the L section before looking here. This section is one where "Great power -comes with great responsiblity". It is possible to break things badly if you +comes with great responsibility". It is possible to break things badly if you are not careful with these. All exports are optional, you need to list which ones you want at import time: @@ -998,9 +986,9 @@ These provide access to internal state and object instances. =item $bool = test2_init_done() -This will return true if the stack and ipc instances have already been +This will return true if the stack and IPC instances have already been initialized. It will return false if they have not. Init happens as late as -possible, it happens as soon as a tool requests the ipc instance, the +possible, it happens as soon as a tool requests the IPC instance, the formatter, or the stack. =item $bool = test2_load_done() @@ -1071,7 +1059,7 @@ from C<$exit> Add a callback that will be called when Test2 is finished loading. This means the callback will be run once, the first time a context is obtained. -If Test2 has already finished loading then the callback will be run immedietly. +If Test2 has already finished loading then the callback will be run immediately. =item test2_add_callback_context_acquire(sub { ... }) @@ -1158,7 +1146,7 @@ Turn off IPC polling. =item test2_ipc_enable_shm() -Turn on IPC shm. Only some IPC drivers use this, and most will turn it on +Turn on IPC SHM. Only some IPC drivers use this, and most will turn it on themselves. =item test2_ipc_set_pending($uniq_val) diff --git a/cpan/Test-Simple/lib/Test2/API/Breakage.pm b/cpan/Test-Simple/lib/Test2/API/Breakage.pm index c0cbc24..7f99fa4 100644 --- a/cpan/Test-Simple/lib/Test2/API/Breakage.pm +++ b/cpan/Test-Simple/lib/Test2/API/Breakage.pm @@ -2,7 +2,7 @@ package Test2::API::Breakage; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; use Test2::Util qw/pkg_to_file/; @@ -12,7 +12,7 @@ our @EXPORT_OK = qw{ upgrade_required known_broken }; -use base 'Exporter'; +BEGIN { require Exporter; our @ISA = qw(Exporter) } sub upgrade_suggested { return ( @@ -139,6 +139,8 @@ version number. If the installed version of the module is at or below the specified one then the module will not work. A newer version may work, but is not tested or verified. +=back + =head1 SOURCE The source code repository for Test2 can be found at diff --git a/cpan/Test-Simple/lib/Test2/API/Context.pm b/cpan/Test-Simple/lib/Test2/API/Context.pm index 80f57b6..a7939e3 100644 --- a/cpan/Test-Simple/lib/Test2/API/Context.pm +++ b/cpan/Test-Simple/lib/Test2/API/Context.pm @@ -2,7 +2,7 @@ package Test2::API::Context; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; use Carp qw/confess croak longmess/; @@ -484,8 +484,8 @@ the current hub. =item $hub = $ctx->hub() -This will return the L instance the context recognises as -the current one to which all events should be sent. +This will return the L instance the context recognizes as the +current one to which all events should be sent. =item $dbg = $ctx->trace() @@ -508,7 +508,7 @@ will be affected. }); B The context will actually be cloned, the clone will be used instead of -the original. This allows the TID, PID, and error vars to be correct without +the original. This allows the thread id, process id, and error variables to be correct without modifying the original context. =item $ctx->restore_error_vars() @@ -676,7 +676,7 @@ new one is generated, or if an existing one is returned. This object consumes L which provides a consistent way for you to attach meta-data to instances of this class. This is useful for -tools, plugins, and other extentions. +tools, plugins, and other extensions. =head1 SOURCE diff --git a/cpan/Test-Simple/lib/Test2/API/Instance.pm b/cpan/Test-Simple/lib/Test2/API/Instance.pm index f73e399..8938040 100644 --- a/cpan/Test-Simple/lib/Test2/API/Instance.pm +++ b/cpan/Test-Simple/lib/Test2/API/Instance.pm @@ -2,7 +2,7 @@ package Test2::API::Instance; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; our @CARP_NOT = qw/Test2::API Test2::API::Instance Test2::IPC::Driver Test2::Formatter/; @@ -15,7 +15,7 @@ use Test2::Util::Trace(); use Test2::API::Stack(); use Test2::Util::HashBase qw{ - pid tid + _pid _tid no_wait finalized loaded ipc stack formatter @@ -35,6 +35,9 @@ use Test2::Util::HashBase qw{ context_release_callbacks }; +sub pid { $_[0]->{+_PID} ||= $$ } +sub tid { $_[0]->{+_TID} ||= get_tid() } + # Wrap around the getters that should call _finalize. BEGIN { for my $finalizer (IPC, FORMATTER) { @@ -63,8 +66,9 @@ sub init { $_[0]->reset } sub reset { my $self = shift; - $self->{+PID} = $$; - $self->{+TID} = get_tid(); + delete $self->{+_PID}; + delete $self->{+_TID}; + $self->{+CONTEXTS} = {}; $self->{+IPC_DRIVERS} = []; @@ -95,6 +99,9 @@ sub _finalize { $self->{+FINALIZED} = $caller; + $self->{+_PID} = $$ unless defined $self->{+_PID}; + $self->{+_TID} = get_tid() unless defined $self->{+_TID}; + unless ($self->{+FORMATTER}) { my ($formatter, $source); if ($ENV{T2_FORMATTER}) { @@ -129,7 +136,7 @@ sub _finalize { $self->{+FORMATTER} = $formatter; } - # Turn on IPC if threads are on, drivers are reigstered, or the Test2::IPC + # Turn on IPC if threads are on, drivers are registered, or the Test2::IPC # module is loaded. return unless USE_THREADS || $INC{'Test2/IPC.pm'} || @{$self->{+IPC_DRIVERS}}; @@ -220,6 +227,9 @@ sub add_post_load_callback { sub load { my $self = shift; unless ($self->{+LOADED}) { + $self->{+_PID} = $$ unless defined $self->{+_PID}; + $self->{+_TID} = get_tid() unless defined $self->{+_TID}; + # This is for https://github.com/Test-More/test-more/issues/16 # and https://rt.perl.org/Public/Bug/Display.html?id=127774 # END blocks run in reverse order. This insures the END block is loaded @@ -260,6 +270,9 @@ sub add_ipc_driver { sub enable_ipc_polling { my $self = shift; + $self->{+_PID} = $$ unless defined $self->{+_PID}; + $self->{+_TID} = get_tid() unless defined $self->{+_TID}; + $self->add_context_init_callback( # This is called every time a context is created, it needs to be fast. # $_[0] is a context object @@ -287,6 +300,9 @@ sub ipc_enable_shm { return 1 if defined $self->{+IPC_SHM_ID}; + $self->{+_PID} = $$ unless defined $self->{+_PID}; + $self->{+_TID} = get_tid() unless defined $self->{+_TID}; + my ($ok, $err) = try { require IPC::SysV; @@ -346,14 +362,16 @@ sub disable_ipc_polling { sub _ipc_wait { my $fail = 0; - while (CAN_FORK) { - my $pid = CORE::wait(); - my $err = $?; - last if $pid == -1; - next unless $err; - $fail++; - $err = $err >> 8; - warn "Process $pid did not exit cleanly (status: $err)\n"; + if (CAN_FORK) { + while (1) { + my $pid = CORE::wait(); + my $err = $?; + last if $pid == -1; + next unless $err; + $fail++; + $err = $err >> 8; + warn "Process $pid did not exit cleanly (status: $err)\n"; + } } if (USE_THREADS) { @@ -377,8 +395,8 @@ sub _ipc_wait { sub DESTROY { my $self = shift; - return unless $self->{+PID} == $$; - return unless $self->{+TID} == get_tid(); + return unless defined($self->{+_PID}) && $self->{+_PID} == $$; + return unless defined($self->{+_TID}) && $self->{+_TID} == get_tid(); shmctl($self->{+IPC_SHM_ID}, IPC::SysV::IPC_RMID(), 0) if defined $self->{+IPC_SHM_ID}; @@ -413,7 +431,7 @@ This is not a supported configuration, you will have problems. # Only worry about contexts in this PID my $trace = $ctx->trace || next; - next unless $trace->pid == $$; + next unless $trace->pid && $trace->pid == $$; # Do not worry about contexts that have no hub my $hub = $ctx->hub || next; @@ -429,7 +447,7 @@ This is not a supported configuration, you will have problems. $new_exit = 255; } - if ($self->{+PID} != $$ or $self->{+TID} != get_tid()) { + if (!defined($self->{+_PID}) or !defined($self->{+_TID}) or $self->{+_PID} != $$ or $self->{+_TID} != get_tid()) { $? = $exit; return; } @@ -475,8 +493,7 @@ This is not a supported configuration, you will have problems. $new_exit = 255 if $new_exit > 255; - if ($new_exit) { - require Test2::API::Breakage; + if ($new_exit && eval { require Test2::API::Breakage; 1 }) { my @warn = Test2::API::Breakage->report(); if (@warn) { @@ -547,7 +564,7 @@ Get the post-load callbacks. =item $obj->add_post_load_callback(sub { ... }) Add a post-load callback. If C has already been called then the callback will -be immedietly executed. If C has not been called then the callback will be +be immediately executed. If C has not been called then the callback will be stored and executed later when C is called. =item $hashref = $obj->contexts() diff --git a/cpan/Test-Simple/lib/Test2/API/Stack.pm b/cpan/Test-Simple/lib/Test2/API/Stack.pm index 0bc25ec..c6478d1 100644 --- a/cpan/Test-Simple/lib/Test2/API/Stack.pm +++ b/cpan/Test-Simple/lib/Test2/API/Stack.pm @@ -2,7 +2,7 @@ package Test2::API::Stack; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; use Test2::Hub(); @@ -110,7 +110,7 @@ instances. =head1 ***INTERNALS NOTE*** B The public -methods provided will not change in backwords incompatible ways, but the +methods provided will not change in backwards incompatible ways, but the underlying implementation details might. B =head1 DESCRIPTION @@ -146,10 +146,10 @@ If you specify the C<< 'class' => $class >> argument, the new hub will be an instance of the specified class. Unless your parameters specify C<'formatter'> or C<'ipc'> arguments, the -formatter and ipc instance will be inherited from the current top hub. You can -set the parameters to C to avoid having a formatter or ipc instance. +formatter and IPC instance will be inherited from the current top hub. You can +set the parameters to C to avoid having a formatter or IPC instance. -If there is no top hub, and you do not ask to leave ipc and formatter undef, +If there is no top hub, and you do not ask to leave IPC and formatter undef, then a new formatter will be created, and the IPC instance from L will be used. diff --git a/cpan/Test-Simple/lib/Test2/Event.pm b/cpan/Test-Simple/lib/Test2/Event.pm index 67e6f77..d350210 100644 --- a/cpan/Test-Simple/lib/Test2/Event.pm +++ b/cpan/Test-Simple/lib/Test2/Event.pm @@ -2,7 +2,7 @@ package Test2::Event; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; use Test2::Util::HashBase qw/trace nested in_subtest subtest_id/; @@ -109,7 +109,7 @@ thing to want, it is used by bail-out and skip_all to end testing. This is called B your event has been passed to the formatter. This should normally return undef, only change this if your event should cause the -test to exit immedietly. +test to exit immediately. If you want this event to cause the test to exit you should return the exit code here. Exit code of 0 means exit success, any other integer means exit with @@ -172,7 +172,7 @@ If the event is inside a subtest this should have the subtest ID. =item $id = $e->subtest_id -If the event is a final subtes event, this should contain the subtest ID. +If the event is a final subtest event, this should contain the subtest ID. =back @@ -180,7 +180,7 @@ If the event is a final subtes event, this should contain the subtest ID. This object consumes L which provides a consistent way for you to attach meta-data to instances of this class. This is useful for -tools, plugins, and other extentions. +tools, plugins, and other extensions. =head1 SOURCE diff --git a/cpan/Test-Simple/lib/Test2/Event/Bail.pm b/cpan/Test-Simple/lib/Test2/Event/Bail.pm index 875ba0a..4f8ae0f 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Bail.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Bail.pm @@ -2,10 +2,10 @@ package Test2::Event::Bail; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; -use base 'Test2::Event'; +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } use Test2::Util::HashBase qw{reason}; sub callback { diff --git a/cpan/Test-Simple/lib/Test2/Event/Diag.pm b/cpan/Test-Simple/lib/Test2/Event/Diag.pm index af5790c..c50e9a9 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Diag.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Diag.pm @@ -2,10 +2,10 @@ package Test2::Event::Diag; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; -use base 'Test2::Event'; +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } use Test2::Util::HashBase qw/message/; sub init { diff --git a/cpan/Test-Simple/lib/Test2/Event/Exception.pm b/cpan/Test-Simple/lib/Test2/Event/Exception.pm index 3504a24..1280ada 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Exception.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Exception.pm @@ -2,10 +2,10 @@ package Test2::Event::Exception; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; -use base 'Test2::Event'; +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } use Test2::Util::HashBase qw{error}; sub causes_fail { 1 } diff --git a/cpan/Test-Simple/lib/Test2/Event/Generic.pm b/cpan/Test-Simple/lib/Test2/Event/Generic.pm new file mode 100644 index 0000000..92b04fb --- /dev/null +++ b/cpan/Test-Simple/lib/Test2/Event/Generic.pm @@ -0,0 +1,263 @@ +package Test2::Event::Generic; +use strict; +use warnings; + +use Carp qw/croak/; +use Scalar::Util qw/reftype/; + +our $VERSION = '1.302026'; + +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } +use Test2::Util::HashBase; + +my @FIELDS = qw{ + causes_fail increments_count diagnostics no_display callback terminate + global sets_plan summary +}; +my %DEFAULTS = ( + causes_fail => 0, + increments_count => 0, + diagnostics => 0, + no_display => 0, +); + +sub init { + my $self = shift; + + for my $field (@FIELDS) { + my $val = defined $self->{$field} ? delete $self->{$field} : $DEFAULTS{$field}; + next unless defined $val; + + my $set = "set_$field"; + $self->$set($val); + } +} + +for my $field (@FIELDS) { + no strict 'refs'; + my $stash = \%{__PACKAGE__ . "::"}; + + *$field = sub { exists $_[0]->{$field} ? $_[0]->{$field} : () } + unless defined $stash->{$field} + && defined *{$stash->{$field}}{CODE}; + + *{"set_$field"} = sub { $_[0]->{$field} = $_[1] } + unless defined $stash->{"set_$field"} + && defined *{$stash->{"set_$field"}}{CODE}; +} + +sub summary { + my $self = shift; + return $self->{summary} if defined $self->{summary}; + $self->SUPER::summary(); +} + +sub sets_plan { + my $self = shift; + return unless $self->{sets_plan}; + return @{$self->{sets_plan}}; +} + +sub callback { + my $self = shift; + my $cb = $self->{callback} || return; + $self->$cb(@_); +} + +sub set_global { + my $self = shift; + my ($bool) = @_; + + if(!defined $bool) { + delete $self->{global}; + return undef; + } + + $self->{global} = $bool; +} + +sub set_callback { + my $self = shift; + my ($cb) = @_; + + if(!defined $cb) { + delete $self->{callback}; + return undef; + } + + croak "callback must be a code reference" + unless ref($cb) && reftype($cb) eq 'CODE'; + + $self->{callback} = $cb; +} + +sub set_terminate { + my $self = shift; + my ($exit) = @_; + + if(!defined $exit) { + delete $self->{terminate}; + return undef; + } + + croak "terminate must be a positive integer" + unless $exit =~ m/^\d+$/; + + $self->{terminate} = $exit; +} + +sub set_sets_plan { + my $self = shift; + my ($plan) = @_; + + if(!defined $plan) { + delete $self->{sets_plan}; + return undef; + } + + croak "'sets_plan' must be an array reference" + unless ref($plan) && reftype($plan) eq 'ARRAY'; + + $self->{sets_plan} = $plan; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Event::Generic - Generic event type. + +=head1 DESCRIPTION + +This is a generic event that lets you customize all fields in the event API. +This is useful if you have need for a custom event that does not make sense as +a published reusable event subclass. + +=head1 SYNOPSIS + + use Test2::API qw/context/; + + sub send_custom_fail { + my $ctx = shift; + + $ctx->send_event('Generic', causes_fail => 1, summary => 'The sky is falling'); + + $ctx->release; + } + + send_custom_fail(); + +=head1 METHODS + +=over 4 + +=item $e->callback($hub) + +Call the custom callback if one is set, otherwise this does nothing. + +=item $e->set_callback(sub { ... }) + +Set the custom callback. The custom callback must be a coderef. The first +argument to your callback will be the event itself, the second will be the +L that is using the callback. + +=item $bool = $e->causes_fail + +=item $e->set_causes_fail($bool) + +Get/Set the C attribute. This defaults to C<0>. + +=item $bool = $e->diagnostics + +=item $e->set_diagnostics($bool) + +Get/Set the C attribute. This defaults to C<0>. + +=item $bool_or_undef = $e->global + +=item @bool_or_empty = $e->global + +=item $e->set_global($bool_or_undef) + +Get/Set the C attribute. This defaults to an empty list which is +undef in scalar context. + +=item $bool = $e->increments_count + +=item $e->set_increments_count($bool) + +Get/Set the C attribute. This defaults to C<0>. + +=item $bool = $e->no_display + +=item $e->set_no_display($bool) + +Get/Set the C attribute. This defaults to C<0>. + +=item @plan = $e->sets_plan + +Get the plan if this event sets one. The plan is a list of up to 3 items: +C<($count, $directive, $reason)>. C<$count> must be defined, the others may be +undef, or may not exist at all. + +=item $e->set_sets_plan(\@plan) + +Set the plan. You must pass in an arrayref with up to 3 elements. + +=item $summary = $e->summary + +=item $e->set_summary($summary_or_undef) + +Get/Set the summary. This will default to the event package +C<'Test2::Event::Generic'>. You can set it to any value. Setting this to +C will reset it to the default. + +=item $int_or_undef = $e->terminate + +=item @int_or_empty = $e->terminate + +=item $e->set_terminate($int_or_undef) + +This will get/set the C attribute. This defaults to undef in scalar +context, or an empty list in list context. Setting this to undef will clear it +completely. This must be set to a positive integer (0 or larger). + +=back + +=head1 SOURCE + +The source code repository for Test2 can be found at +F. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum Eexodist@cpan.orgE + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum Eexodist@cpan.orgE + +=back + +=head1 COPYRIGHT + +Copyright 2016 Chad Granum Eexodist@cpan.orgE. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See F + +=cut diff --git a/cpan/Test-Simple/lib/Test2/Event/Note.pm b/cpan/Test-Simple/lib/Test2/Event/Note.pm index aea9951..b35a29a 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Note.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Note.pm @@ -2,10 +2,10 @@ package Test2::Event::Note; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; -use base 'Test2::Event'; +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } use Test2::Util::HashBase qw/message/; sub init { diff --git a/cpan/Test-Simple/lib/Test2/Event/Ok.pm b/cpan/Test-Simple/lib/Test2/Event/Ok.pm index b467f70..a3ea262 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Ok.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Ok.pm @@ -2,10 +2,10 @@ package Test2::Event::Ok; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; -use base 'Test2::Event'; +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } use Test2::Util::HashBase qw{ pass effective_pass name todo }; diff --git a/cpan/Test-Simple/lib/Test2/Event/Plan.pm b/cpan/Test-Simple/lib/Test2/Event/Plan.pm index 12f5d6b..599df67 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Plan.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Plan.pm @@ -2,10 +2,10 @@ package Test2::Event::Plan; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; -use base 'Test2::Event'; +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } use Test2::Util::HashBase qw{max directive reason}; use Carp qw/confess/; diff --git a/cpan/Test-Simple/lib/Test2/Event/Skip.pm b/cpan/Test-Simple/lib/Test2/Event/Skip.pm index 9f9ae92..ef08022 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Skip.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Skip.pm @@ -2,10 +2,10 @@ package Test2::Event::Skip; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; -use base 'Test2::Event::Ok'; +BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) } use Test2::Util::HashBase qw{reason}; sub init { diff --git a/cpan/Test-Simple/lib/Test2/Event/Subtest.pm b/cpan/Test-Simple/lib/Test2/Event/Subtest.pm index 1784f05..0d95424 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Subtest.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Subtest.pm @@ -2,10 +2,10 @@ package Test2::Event::Subtest; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; -use base 'Test2::Event::Ok'; +BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) } use Test2::Util::HashBase qw{subevents buffered subtest_id}; sub init { diff --git a/cpan/Test-Simple/lib/Test2/Event/Waiting.pm b/cpan/Test-Simple/lib/Test2/Event/Waiting.pm index c77891d..15d0b0a61 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Waiting.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Waiting.pm @@ -2,10 +2,10 @@ package Test2::Event::Waiting; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; -use base 'Test2::Event'; +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } sub global { 1 }; diff --git a/cpan/Test-Simple/lib/Test2/Formatter.pm b/cpan/Test-Simple/lib/Test2/Formatter.pm index 0c8a09f..7e1313a 100644 --- a/cpan/Test-Simple/lib/Test2/Formatter.pm +++ b/cpan/Test-Simple/lib/Test2/Formatter.pm @@ -2,7 +2,7 @@ package Test2::Formatter; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; my %ADDED; @@ -53,8 +53,8 @@ A formatter is any package or object with a C method. The C method is a method, so it either gets a class or instance. The 2 arguments are the C<$event> object it should record, and the C<$assert_num> which is the number of the current assertion (ok), or the last assertion if -this even is not itself an assertion. The assertion number may be any inyeger 0 -or greator, and may be undefined in some cases. +this even is not itself an assertion. The assertion number may be any integer 0 +or greater, and may be undefined in some cases. The C method must return a boolean. This is used to tell buffered subtests whether or not to send it events as they are being buffered. diff --git a/cpan/Test-Simple/lib/Test2/Formatter/TAP.pm b/cpan/Test-Simple/lib/Test2/Formatter/TAP.pm index 3020b8c..20086e1 100644 --- a/cpan/Test-Simple/lib/Test2/Formatter/TAP.pm +++ b/cpan/Test-Simple/lib/Test2/Formatter/TAP.pm @@ -2,7 +2,7 @@ package Test2::Formatter::TAP; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; use Test2::Util::HashBase qw{ @@ -14,7 +14,7 @@ sub OUT_ERR() { 1 } use Carp qw/croak/; -use base 'Test2::Formatter'; +BEGIN { require Test2::Formatter; our @ISA = qw(Test2::Formatter) } my %CONVERTERS = ( 'Test2::Event::Ok' => 'event_ok', @@ -234,7 +234,7 @@ sub event_subtest { # In a verbose harness we indent the diagnostics from the 'Ok' event since # they will appear inside the subtest braces. This helps readability. In a - # non-verbose harness we do nto do this because it is less readable. + # non-verbose harness we do not do this because it is less readable. if ($ENV{HARNESS_IS_VERBOSE}) { # index 0 is the filehandle, index 1 is the message we want to indent. $_->[1] =~ s/^(.*\S.*)$/ $1/mg for @diag; @@ -461,7 +461,7 @@ Process an L event. =item @out = $TAP->event_other($e, $num) -Fallback for unregistered event types. It uses the L api to +Fallback for unregistered event types. It uses the L API to convert the event to TAP. =back diff --git a/cpan/Test-Simple/lib/Test2/Hub.pm b/cpan/Test-Simple/lib/Test2/Hub.pm index 1d49977..0b0d33b 100644 --- a/cpan/Test-Simple/lib/Test2/Hub.pm +++ b/cpan/Test-Simple/lib/Test2/Hub.pm @@ -2,7 +2,7 @@ package Test2::Hub; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; use Carp qw/carp croak confess/; @@ -458,7 +458,7 @@ Test2::Hub - The conduit through which all events flow. =head1 DESCRIPTION The hub is the place where all events get processed and handed off to the -formatter. The hub also tracks test state, and provides everal hooks into the +formatter. The hub also tracks test state, and provides several hooks into the event pipeline. =head1 COMMON TASKS @@ -636,7 +636,7 @@ an END block. =item $sub = $hub->add_context_acquire(sub { ... }); Add a callback that will be called every time someone tries to acquire a -context. It gets a single argument, a reference the the hash of parameters +context. It gets a single argument, a reference of the hash of parameters being used the construct the context. This is your chance to change the parameters by directly altering the hash. @@ -757,7 +757,7 @@ Get or set the plan. The plan must be an integer larger than 0, the string =item $bool = $hub->check_plan Check if the plan and counts match, but only if the tests have ended. If tests -have not unded this will return undef, otherwise it will be a true/false. +have not ended this will return undef, otherwise it will be a true/false. =back @@ -765,7 +765,7 @@ have not unded this will return undef, otherwise it will be a true/false. This object consumes L which provides a consistent way for you to attach meta-data to instances of this class. This is useful for -tools, plugins, and other extentions. +tools, plugins, and other extensions. =head1 SOURCE diff --git a/cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm b/cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm index df6df86..006e3b6 100644 --- a/cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm +++ b/cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm @@ -2,12 +2,12 @@ package Test2::Hub::Interceptor; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; use Test2::Hub::Interceptor::Terminator(); -use base 'Test2::Hub'; +BEGIN { require Test2::Hub; our @ISA = qw(Test2::Hub) } use Test2::Util::HashBase; sub inherit { diff --git a/cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm b/cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm index c79f19c..98a1209 100644 --- a/cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm +++ b/cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm @@ -2,7 +2,7 @@ package Test2::Hub::Interceptor::Terminator; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; 1; diff --git a/cpan/Test-Simple/lib/Test2/Hub/Subtest.pm b/cpan/Test-Simple/lib/Test2/Hub/Subtest.pm index 071916a..4e3a8bc 100644 --- a/cpan/Test-Simple/lib/Test2/Hub/Subtest.pm +++ b/cpan/Test-Simple/lib/Test2/Hub/Subtest.pm @@ -2,10 +2,10 @@ package Test2::Hub::Subtest; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; -use base 'Test2::Hub'; +BEGIN { require Test2::Hub; our @ISA = qw(Test2::Hub) } use Test2::Util::HashBase qw/nested bailed_out exit_code manual_skip_all id/; use Test2::Util qw/get_tid/; diff --git a/cpan/Test-Simple/lib/Test2/IPC.pm b/cpan/Test-Simple/lib/Test2/IPC.pm index ff8a6da..d2626d9 100644 --- a/cpan/Test-Simple/lib/Test2/IPC.pm +++ b/cpan/Test-Simple/lib/Test2/IPC.pm @@ -2,7 +2,7 @@ package Test2::IPC; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; use Test2::API::Instance; @@ -19,13 +19,13 @@ use Test2::API qw{ use Carp qw/confess/; our @EXPORT_OK = qw/cull/; -use base 'Exporter'; +BEGIN { require Exporter; our @ISA = qw(Exporter) } sub import { goto &Exporter::import unless test2_init_done(); - confess "Cannot add IPC in a child process" if test2_pid() != $$; - confess "Cannot add IPC in a child thread" if test2_tid() != get_tid(); + confess "Cannot add IPC in a child process (" . test2_pid() . " vs $$)" if test2_pid() != $$; + confess "Cannot add IPC in a child thread (" . test2_tid() . " vs " . get_tid() . ")" if test2_tid() != get_tid(); Test2::API::_set_ipc(_make_ipc()); apply_ipc(test2_stack()); diff --git a/cpan/Test-Simple/lib/Test2/IPC/Driver.pm b/cpan/Test-Simple/lib/Test2/IPC/Driver.pm index d00fcea..4c29e42 100644 --- a/cpan/Test-Simple/lib/Test2/IPC/Driver.pm +++ b/cpan/Test-Simple/lib/Test2/IPC/Driver.pm @@ -2,7 +2,7 @@ package Test2::IPC::Driver; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; use Carp qw/confess longmess/; @@ -29,7 +29,7 @@ for my $meth (qw/send cull add_hub drop_hub waiting is_viable/) { } # Print the error and call exit. We are not using 'die' cause this is a -# catastophic error that should never be caught. If we get here it +# catastrophic error that should never be caught. If we get here it # means some serious shit has happened in a child process, the only way # to inform the parent may be to exit false. @@ -254,7 +254,7 @@ True if you want to make use of the L/L SHM. =item $bites = $ipc->shm_size() -Use this to customize the size of the shm space. There are no guarantees about +Use this to customize the size of the SHM space. There are no guarantees about what the size will be if you do not implement this. =back diff --git a/cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm b/cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm index a449a7d..53530d7 100644 --- a/cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm +++ b/cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm @@ -2,10 +2,10 @@ package Test2::IPC::Driver::Files; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; -use base 'Test2::IPC::Driver'; +BEGIN { require Test2::IPC::Driver; our @ISA = qw(Test2::IPC::Driver) } use Test2::Util::HashBase qw{tempdir event_id tid pid globals}; @@ -13,8 +13,9 @@ use Scalar::Util qw/blessed/; use File::Temp(); use Storable(); use File::Spec(); +use POSIX(); -use Test2::Util qw/try get_tid pkg_to_file/; +use Test2::Util qw/try get_tid pkg_to_file IS_WIN32/; use Test2::API qw/test2_ipc_set_pending/; sub use_shm { 1 } @@ -52,7 +53,7 @@ sub hub_file { my $self = shift; my ($hid) = @_; my $tdir = $self->{+TEMPDIR}; - return File::Spec->canonpath("$tdir/HUB-$hid"); + return File::Spec->catfile($tdir, "HUB-$hid"); } sub event_file { @@ -68,7 +69,7 @@ sub event_file { my @type = split '::', $type; my $name = join('-', $hid, $$, get_tid(), $self->{+EVENT_ID}++, @type); - return File::Spec->canonpath("$tempdir/$name"); + return File::Spec->catfile($tempdir, $name); } sub add_hub { @@ -151,11 +152,31 @@ do so if Test::Builder is loaded for legacy reasons. $self->{+GLOBALS}->{$hid}->{$name}++; } + my ($old, $blocked); + unless(IS_WIN32) { + my $to_block = POSIX::SigSet->new( + POSIX::SIGINT(), + POSIX::SIGALRM(), + POSIX::SIGHUP(), + POSIX::SIGTERM(), + POSIX::SIGUSR1(), + POSIX::SIGUSR2(), + ); + $old = POSIX::SigSet->new; + $blocked = POSIX::sigprocmask(POSIX::SIG_BLOCK(), $to_block, $old); + # Silently go on if we failed to log signals, not much we can do. + } + + # Write and rename the file. my ($ok, $err) = try { Storable::store($e, $file); rename($file, $ready) or $self->abort("Could not rename file '$file' -> '$ready'"); test2_ipc_set_pending(substr($file, -(shm_size))); }; + + # If our block was successful we want to restore the old mask. + POSIX::sigprocmask(POSIX::SIG_SETMASK(), $old, POSIX::SigSet->new()) if defined $blocked; + if (!$ok) { my $src_file = __FILE__; $err =~ s{ at \Q$src_file\E.*$}{}; @@ -207,7 +228,7 @@ sub cull { next if $global && $self->{+GLOBALS}->{$hid}->{$file}++; # Untaint the path. - my $full = File::Spec->canonpath("$tempdir/$file"); + my $full = File::Spec->catfile($tempdir, $file); ($full) = ($full =~ m/^(.*)$/gs); my $obj = $self->read_event_file($full); @@ -279,7 +300,7 @@ sub DESTROY { while(my $file = readdir($dh)) { next if $file =~ m/^\.+$/; next if $file =~ m/\.complete$/; - my $full = File::Spec->canonpath("$tempdir/$file"); + my $full = File::Spec->catfile($tempdir, $file); if ($file =~ m/^(GLOBAL|HUB-)/) { $full =~ m/^(.*)$/; diff --git a/cpan/Test-Simple/lib/Test2/Transition.pod b/cpan/Test-Simple/lib/Test2/Transition.pod index aceb381..a14f22e 100644 --- a/cpan/Test-Simple/lib/Test2/Transition.pod +++ b/cpan/Test-Simple/lib/Test2/Transition.pod @@ -7,7 +7,7 @@ Test2::Transition - Transition notes when upgrading to Test2 =head1 DESCRIPTION This is where gotchas and breakages related to the Test2 upgrade are -documented. The upgrade causes Test::Builder to defer to Test2 uner the hood. +documented. The upgrade causes Test::Builder to defer to Test2 under the hood. This transition is mostly transparent, but there are a few cases that can trip you up. @@ -24,14 +24,14 @@ Confusingly these were called Test::Builder2 and Test::Builder1.5, in that order. Many people put conditionals in their code to check the Test::Builder version number and adapt their code accordingly. -The Test::Builder2/1.5 projects both died out. Now the conditional code poeple +The Test::Builder2/1.5 projects both died out. Now the conditional code people added has become a mine field. A vast majority of modules broken by Test2 fall into this category. =head3 The Fix The fix is to remove all Test::Builder1.5/2 related code. Either use the -lagacy Test::Builder API, or use Test2 directly. +legacy Test::Builder API, or use Test2 directly. =head2 Replacing the Test::Builder singleton @@ -77,7 +77,7 @@ as needed. An early change, in fact the change that made Test2 an idea, was a change to the indentation of the subtest note. IT was decided it would be more readable -to outdent the subtest note instead of having it inline withthe subtest: +to outdent the subtest note instead of having it inline with the subtest: # subtest foo ok 1 - blah @@ -132,7 +132,7 @@ Known broken in versions: 1.0.9 and older =item Test::Kit This actually works fine, but will not install because L is in -the dep chain. +the dependency chain. See the L info below for additional information. diff --git a/cpan/Test-Simple/lib/Test2/Util.pm b/cpan/Test-Simple/lib/Test2/Util.pm index ed6382d..a903b6c 100644 --- a/cpan/Test-Simple/lib/Test2/Util.pm +++ b/cpan/Test-Simple/lib/Test2/Util.pm @@ -2,7 +2,7 @@ package Test2::Util; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; use Config qw/%Config/; @@ -16,8 +16,14 @@ our @EXPORT_OK = qw{ CAN_THREAD CAN_REALLY_FORK CAN_FORK + + IS_WIN32 }; -use base 'Exporter'; +BEGIN { require Exporter; our @ISA = qw(Exporter) } + +BEGIN { + *IS_WIN32 = ($^O eq 'MSWin32') ? sub() { 1 } : sub() { 0 }; +} sub _can_thread { return 0 unless $] >= 5.008001; @@ -26,7 +32,7 @@ sub _can_thread { # Threads are broken on perl 5.10.0 built with gcc 4.8+ if ($] == 5.010000 && $Config{'ccname'} eq 'gcc' && $Config{'gccversion'}) { my @parts = split /\./, $Config{'gccversion'}; - return 0 if $parts[0] >= 4 && $parts[1] >= 8; + return 0 if $parts[0] > 4 || ($parts[0] == 4 && $parts[1] >= 8); } # Change to a version check if this ever changes @@ -36,7 +42,7 @@ sub _can_thread { sub _can_fork { return 1 if $Config{d_fork}; - return 0 unless $^O eq 'MSWin32' || $^O eq 'NetWare'; + return 0 unless IS_WIN32 || $^O eq 'NetWare'; return 0 unless $Config{useithreads}; return 0 unless $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/; @@ -45,9 +51,25 @@ sub _can_fork { BEGIN { no warnings 'once'; - *CAN_REALLY_FORK = $Config{d_fork} ? sub() { 1 } : sub() { 0 }; *CAN_THREAD = _can_thread() ? sub() { 1 } : sub() { 0 }; - *CAN_FORK = _can_fork() ? sub() { 1 } : sub() { 0 }; +} +my $can_fork; +sub CAN_FORK () { + return $can_fork + if defined $can_fork; + $can_fork = !!_can_fork(); + no warnings 'redefine'; + *CAN_FORK = $can_fork ? sub() { 1 } : sub() { 0 }; + $can_fork; +} +my $can_really_fork; +sub CAN_REALLY_FORK () { + return $can_really_fork + if defined $can_really_fork; + $can_really_fork = !!$Config{d_fork}; + no warnings 'redefine'; + *CAN_REALLY_FORK = $can_really_fork ? sub() { 1 } : sub() { 0 }; + $can_really_fork; } sub _manual_try(&;@) { @@ -80,7 +102,7 @@ sub _local_try(&;@) { # before forking or starting a new thread. So for those systems we use the # non-local form. When possible though we use the faster 'local' form. BEGIN { - if ($^O eq 'MSWin32' && $] < 5.020002) { + if (IS_WIN32 && $] < 5.020002) { *try = \&_manual_try; } else { @@ -89,17 +111,17 @@ BEGIN { } BEGIN { - if(CAN_THREAD) { + if (CAN_THREAD) { if ($INC{'threads.pm'}) { # Threads are already loaded, so we do not need to check if they # are loaded each time *USE_THREADS = sub() { 1 }; - *get_tid = sub { threads->tid() }; + *get_tid = sub() { threads->tid() }; } else { # :-( Need to check each time to see if they have been loaded. - *USE_THREADS = sub { $INC{'threads.pm'} ? 1 : 0 }; - *get_tid = sub { $INC{'threads.pm'} ? threads->tid() : 0 }; + *USE_THREADS = sub() { $INC{'threads.pm'} ? 1 : 0 }; + *get_tid = sub() { $INC{'threads.pm'} ? threads->tid() : 0 }; } } else { @@ -154,7 +176,7 @@ be restored, but $@ will contain the exception being thrown. =item CAN_FORK -True if this system is capable of true or psuedo-fork. +True if this system is capable of true or pseudo-fork. =item CAN_REALLY_FORK diff --git a/cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm b/cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm index 51c1253..1083ace 100644 --- a/cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm +++ b/cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm @@ -2,7 +2,7 @@ package Test2::Util::ExternalMeta; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; use Carp qw/croak/; @@ -10,7 +10,7 @@ use Carp qw/croak/; sub META_KEY() { '_meta' } our @EXPORT = qw/meta set_meta get_meta delete_meta/; -use base 'Exporter'; +BEGIN { require Exporter; our @ISA = qw(Exporter) } sub set_meta { my $self = shift; @@ -91,7 +91,7 @@ tools to attach meta-data to your instances. If your object consumes this package, and imports its methods, then third party meta-data has a safe place to live. -=head1 SYNOPSYS +=head1 SYNOPSIS package My::Object; use strict; @@ -124,7 +124,7 @@ hash, then there is a conflict and you cannot use this package. =item $val = $obj->meta($key, $default) This will get the value for a specified meta C<$key>. Normally this will return -C when there is no value for the C<$key>, however you can specfi a +C when there is no value for the C<$key>, however you can specify a C<$default> value to set when no value is already set. =item $val = $obj->get_meta($key) @@ -143,7 +143,7 @@ Set the value of a specified meta C<$key>. =back -=head1 META-KEY RESTICTIONS +=head1 META-KEY RESTRICTIONS Meta keys must be defined, and must be true when used as a boolean. Keys may not be references. You are free to stringify a reference C<"$ref"> for use as a diff --git a/cpan/Test-Simple/lib/Test2/Util/HashBase.pm b/cpan/Test-Simple/lib/Test2/Util/HashBase.pm index 42f04d9..d3583a4 100644 --- a/cpan/Test-Simple/lib/Test2/Util/HashBase.pm +++ b/cpan/Test-Simple/lib/Test2/Util/HashBase.pm @@ -2,54 +2,43 @@ package Test2::Util::HashBase; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; require Carp; $Carp::Internal{+__PACKAGE__} = 1; -my %ATTRS; -my %META; - -sub _get_inherited_attrs { - no strict 'refs'; - my @todo = map @{"$_\::ISA"}, @_; - my %seen; - my @all; - while (my $pkg = shift @todo) { - next if $seen{$pkg}++; - my $found = $META{$pkg}; - push @all => %$found if $found; - - my $isa = \@{"$pkg\::ISA"}; - push @todo => @$isa if @$isa; +my %ATTR_SUBS; + +BEGIN { + # these are not strictly equivalent, but for out use we don't care + # about order + *_isa = ($] >= 5.010 && require mro) ? \&mro::get_linear_isa : sub { + no strict 'refs'; + my @packages = ($_[0]); + my %seen; + for my $package (@packages) { + push @packages, grep !$seen{$_}++, @{"$package\::ISA"}; + } + return \@packages; } - - return \@all; -} - -sub _make_subs { - my ($str) = @_; - return $ATTRS{$str} ||= { - uc($str) => sub() { $str }, - $str => sub { $_[0]->{$str} }, - "set_$str" => sub { $_[0]->{$str} = $_[1] }, - }; } sub import { my $class = shift; my $into = caller; - my %attrs = map %{_make_subs($_)}, @_; - - my @meta = map uc, @_; - @{$META{$into}}{@meta} = map $attrs{$_}, @meta; - + my $isa = _isa($into); + my $attr_subs = $ATTR_SUBS{$into} ||= {}; my %subs = ( - %attrs, - @{_get_inherited_attrs($into)}, - $into->can('new') ? () : (new => \&_new) + ($into->can('new') ? () : (new => \&_new)), + (map %{ $ATTR_SUBS{$_}||{} }, @{$isa}[1 .. $#$isa]), + (map { + my ($sub, $attr) = (uc $_, $_); + $sub => ($attr_subs->{$sub} = sub() { $attr }), + $attr => sub { $_[0]->{$attr} }, + "set_$attr" => sub { $_[0]->{$attr} = $_[1] }, + } @_), ); no strict 'refs'; @@ -146,7 +135,7 @@ This package is used to generate classes based on hashrefs. Using this class will give you a C method, as well as generating accessors you request. Generated accessors will be getters, C setters will also be generated for you. You also get constants for each accessor (all caps) which -return the key into the hash for that accessor. Single inheritence is also +return the key into the hash for that accessor. Single inheritance is also supported. =head1 METHODS @@ -160,7 +149,7 @@ supported. Create a new instance using key/value pairs. HashBase will not export C if there is already a C method in your -packages inheritence chain. +packages inheritance chain. B you just have to declare it before loading L. diff --git a/cpan/Test-Simple/lib/Test2/Util/Trace.pm b/cpan/Test-Simple/lib/Test2/Util/Trace.pm index 7fcfcef..5afeccf 100644 --- a/cpan/Test-Simple/lib/Test2/Util/Trace.pm +++ b/cpan/Test-Simple/lib/Test2/Util/Trace.pm @@ -2,7 +2,7 @@ package Test2::Util::Trace; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302026'; use Test2::Util qw/get_tid/; @@ -87,7 +87,7 @@ C<< at line >> when calling C<< $trace->debug >>. =item $str = $trace->debug Typically returns the string C<< at line >>. If C is set -then its value wil be returned instead. +then its value will be returned instead. =item $trace->alert($MESSAGE) diff --git a/cpan/Test-Simple/lib/ok.pm b/cpan/Test-Simple/lib/ok.pm index b632a49..8670163 100644 --- a/cpan/Test-Simple/lib/ok.pm +++ b/cpan/Test-Simple/lib/ok.pm @@ -1,5 +1,5 @@ package ok; -$ok::VERSION = '1.302015'; +$ok::VERSION = '1.302026'; use strict; use Test::More (); diff --git a/cpan/Test-Simple/t/00compile.t b/cpan/Test-Simple/t/00compile.t deleted file mode 100644 index 281021b..0000000 --- a/cpan/Test-Simple/t/00compile.t +++ /dev/null @@ -1,43 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} -chdir 't'; - -use Test::More; - -my $Has_Test_Pod; -BEGIN { - $Has_Test_Pod = eval 'use Test::Pod 0.95; 1'; -} - -chdir ".."; -my $manifest = "MANIFEST"; -open(my $manifest_fh, "<", $manifest) or plan(skip_all => "Can't open $manifest: $!"); -my @modules = map { m{^lib/(\S+)}; $1 } - grep { m{^lib/Test/\S*\.pm} } - grep { !m{/t/} } <$manifest_fh>; - -chomp @modules; -close $manifest_fh; - -chdir 'lib'; -plan tests => scalar @modules * 2; -foreach my $file (@modules) { - # Make sure we look at the local files and do not reload them if - # they're already loaded. This avoids recompilation warnings. - local @INC = @INC; - unshift @INC, "."; - ok eval { require($file); 1 } or diag "require $file failed.\n$@"; - - SKIP: { - skip "Test::Pod not installed", 1 unless $Has_Test_Pod; - pod_file_ok($file); - } -} diff --git a/cpan/Test-Simple/t/Legacy/Regression/637.t b/cpan/Test-Simple/t/Legacy/Regression/637.t index 149b64d..c3aaf44 100644 --- a/cpan/Test-Simple/t/Legacy/Regression/637.t +++ b/cpan/Test-Simple/t/Legacy/Regression/637.t @@ -1,14 +1,22 @@ use strict; use warnings; +use Test2::Util qw/CAN_THREAD/; BEGIN { - my $skip = !eval { require threads; 1 }; - if ($skip) { - require Test::More; - Test::More::plan(skip_all => 'no threads'); + unless(CAN_THREAD) { + print "1..0 # Skip threads are not supported.\n"; + exit 0; } } +BEGIN { + unless ( $ENV{AUTHOR_TESTING} ) { + print "1..0 # Skip many perls have broken threads. Enable with AUTHOR_TESTING.\n"; + exit 0; + } +} + +use Test2::IPC; use threads; use Test::More; diff --git a/cpan/Test-Simple/t/Legacy/Tester/tbt_06errormess.t b/cpan/Test-Simple/t/Legacy/Tester/tbt_06errormess.t index b02b617..ec3abc6 100644 --- a/cpan/Test-Simple/t/Legacy/Tester/tbt_06errormess.t +++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_06errormess.t @@ -9,7 +9,7 @@ use strict; # argh! now we need to test the thing we're testing. Basically we need # to pretty much reimplement the whole code again. This is very -# annoying but can't be avoided. And onwards with the cut and paste +# annoying but can't be avoided. And onward with the cut and paste # My brain is melting. My brain is melting. ETOOMANYLAYERSOFTESTING diff --git a/cpan/Test-Simple/t/Legacy/Tester/tbt_07args.t b/cpan/Test-Simple/t/Legacy/Tester/tbt_07args.t index 9542d75..9b631ab 100644 --- a/cpan/Test-Simple/t/Legacy/Tester/tbt_07args.t +++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_07args.t @@ -9,7 +9,7 @@ use strict; # argh! now we need to test the thing we're testing. Basically we need # to pretty much reimplement the whole code again. This is very -# annoying but can't be avoided. And onwards with the cut and paste +# annoying but can't be avoided. And onward with the cut and paste # My brain is melting. My brain is melting. ETOOMANYLAYERSOFTESTING diff --git a/cpan/Test-Simple/t/Test2/acceptance/try_it_todo.t b/cpan/Test-Simple/t/Test2/acceptance/try_it_todo.t index 5c5f694..7a7d7a1 100644 --- a/cpan/Test-Simple/t/Test2/acceptance/try_it_todo.t +++ b/cpan/Test-Simple/t/Test2/acceptance/try_it_todo.t @@ -47,6 +47,5 @@ diag "should be a note"; test2_stack->top->unfilter($filter); ok(1, "Third"); -diag "should be a diag"; done_testing; diff --git a/cpan/Test-Simple/t/Test2/modules/API/Instance.t b/cpan/Test-Simple/t/Test2/modules/API/Instance.t index 45e739f..294224c 100644 --- a/cpan/Test-Simple/t/Test2/modules/API/Instance.t +++ b/cpan/Test-Simple/t/Test2/modules/API/Instance.t @@ -11,8 +11,6 @@ my $one = $CLASS->new; is_deeply( $one, { - pid => $$, - tid => get_tid(), contexts => {}, finalized => undef, @@ -45,8 +43,6 @@ $one->reset; is_deeply( $one, { - pid => $$, - tid => get_tid(), contexts => {}, ipc_polling => undef, @@ -201,7 +197,7 @@ if (CAN_THREAD && $] ge '5.010') { { $one->reset(); - $one->set_tid(1); + $one->set__tid(1); local $? = 0; $one->set_exit; is($?, 0, "no errors on exit"); @@ -226,6 +222,7 @@ if (CAN_THREAD && $] ge '5.010') { { $one->reset(); + $one->load(); $one->stack->top->set_failed(2); local $? = 0; $one->set_exit; @@ -234,6 +231,7 @@ if (CAN_THREAD && $] ge '5.010') { { $one->reset(); + $one->load(); local $? = 500; $one->set_exit; is($?, 255, "set exit code to a sane number"); @@ -243,6 +241,7 @@ if (CAN_THREAD && $] ge '5.010') { local %INC = %INC; delete $INC{'Test2/IPC.pm'}; $one->reset(); + $one->load(); my @events; $one->stack->top->filter(sub { push @events => $_[1]; undef}); $one->stack->new_hub; @@ -287,6 +286,7 @@ This is not a supported configuration, you will have problems. local *Test2::API::Breakage::report = sub { $ran++; return "foo" }; use warnings qw/redefine once/; $one->reset(); + $one->load(); my $stderr = ""; { @@ -308,6 +308,7 @@ foo { $one->reset(); + $one->load(); my @events; $one->stack->top->filter(sub { push @events => $_[1]; undef}); $one->stack->new_hub; @@ -427,6 +428,7 @@ if (CAN_REALLY_FORK) { { $one->reset; + ok(!@{$one->context_init_callbacks}, "no callbacks"); is($one->ipc_polling, undef, "no polling, undef"); @@ -440,6 +442,8 @@ if (CAN_REALLY_FORK) { use warnings; $one->enable_ipc_polling; + ok(defined($one->{_pid}), "pid is defined"); + ok(defined($one->{_tid}), "tid is defined"); is(@{$one->context_init_callbacks}, 1, "added the callback"); is($one->ipc_polling, 1, "polling on"); $one->set_ipc_shm_last('abc1'); diff --git a/cpan/Test-Simple/t/Test2/modules/Event/Generic.t b/cpan/Test-Simple/t/Test2/modules/Event/Generic.t new file mode 100644 index 0000000..4838d55 --- /dev/null +++ b/cpan/Test-Simple/t/Test2/modules/Event/Generic.t @@ -0,0 +1,129 @@ +use strict; +use warnings; + +BEGIN { require "t/tools.pl" }; +use Test2::Util::Trace; + +use Test2::API qw/context intercept/; + +sub tool { + my $ctx = context(); + my $e = $ctx->send_event('Generic', @_); + $ctx->release; + return $e; +} + +my $e; +intercept { $e = tool() }; + +ok($e, "got event"); +ok($e->isa('Test2::Event'), "It is an event"); +ok($e->isa('Test2::Event::Generic'), "It is an event"); +delete $e->{trace}; +is_deeply( + $e, + { + causes_fail => 0, + increments_count => 0, + diagnostics => 0, + no_display => 0, + }, + "Defaults" +); + +for my $f (qw/causes_fail increments_count diagnostics no_display/) { + is($e->$f, 0, "'$f' is 0"); + is_deeply([$e->$f], [0], "'$f' is 0 is list context as well"); + + my $set = "set_$f"; + $e->$set(1); + is($e->$f, 1, "'$f' was set to 1"); +} + +for my $f (qw/callback terminate global sets_plan/) { + is($e->$f, undef, "no $f"); + is_deeply([$e->$f], [], "$f is empty in list context"); +} + +like($e->summary, qr/Test2::Event::Generic/, "Got base class summary"); + +like( + exception { $e->set_sets_plan('bad') }, + qr/'sets_plan' must be an array reference/, + "Must provide an arrayref" +); + +$e->set_sets_plan([0, skip => 'cause']); +is_deeply([$e->sets_plan], [0, skip => 'cause'], "sets_plan returns a list, not a ref"); +$e->set_sets_plan(undef); +ok(!exists $e->{sets_plan}, "Removed sets_plan key"); +ok(!$e->sets_plan, "sets_plan is cleared"); + +$e->set_global(0); +is($e->global, 0, "global is off"); +$e->set_global(1); +is($e->global, 1, "global is on"); +$e->set_global(0); +is($e->global, 0, "global is again"); +$e->set_global(undef); +ok(!exists $e->{global}, "removed global key"); +is($e->global, undef, "global is not defined"); + +like( + exception { $e->set_callback('dogfood') }, + qr/callback must be a code reference/, + "Callback must be code" +); + +my $ran = 0; +$e->set_callback(sub { + $ran++; + my $self = shift; + is($self, $e, "got self"); + is_deeply( \@_, ['a', 'b', 'c'], "Got args" ); + return 'foo'; +}); +is($e->callback('a', 'b', 'c'), 'foo', "got callback's return"); +ok($ran, "ran callback"); + +$e->set_callback(undef); +ok(!$e->callback, "no callback"); +ok(!exists $e->{callback}, "no callback key"); + +like( + exception { $e->set_terminate('1.1') }, + qr/terminate must be a positive integer/, + "terminate only takes integers" +); + +like( + exception { $e->set_terminate('foo') }, + qr/terminate must be a positive integer/, + "terminate only takes numbers" +); + +like( + exception { $e->set_terminate('-1') }, + qr/terminate must be a positive integer/, + "terminate only takes positive integers" +); + +$e->set_terminate(0), +is($e->terminate, 0, "set to 0, 0 is valid"); +$e->set_terminate(1), +is($e->terminate, 1, "set to 1"); +$e->set_terminate(123), +is($e->terminate, 123, "set to 123"); +$e->set_terminate(0), +is($e->terminate, 0, "set to 0, 0 is valid"); + +$e->set_terminate(undef); +is($e->terminate, undef, "terminate is not defined"); +ok(!exists $e->{terminate}, "no terminate key"); + +# Test constructor args +intercept { $e = tool(causes_fail => 1, increments_count => 'a') }; +is($e->causes_fail, 1, "attr from constructor"); +is($e->increments_count, 'a', "attr from constructor"); + +done_testing; diff --git a/cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t b/cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t index 368bbf2..5cda691 100644 --- a/cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t +++ b/cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t @@ -1,6 +1,7 @@ BEGIN { require "t/tools.pl" }; use Test2::Util qw/get_tid USE_THREADS try/; use File::Temp qw/tempfile/; +use File::Spec qw/catfile/; use strict; use warnings; @@ -42,8 +43,9 @@ is($ipc->tid, get_tid(), "stored the tid"); my $hid = '12345'; $ipc->add_hub($hid); -ok(-f $ipc->tempdir . '/HUB-' . $hid, "wrote hub file"); -if(ok(open(my $fh, '<', $ipc->tempdir . '/HUB-' . $hid), "opened hub file")) { +my $hubfile = File::Spec->catfile($ipc->tempdir, "HUB-$hid"); +ok(-f $hubfile, "wrote hub file"); +if(ok(open(my $fh, '<', $hubfile), "opened hub file")) { my @lines = <$fh>; close($fh); is_deeply( @@ -62,7 +64,7 @@ $ipc->send($hid, bless({ foo => 1 }, 'Foo')); $ipc->send($hid, bless({ bar => 1 }, 'Foo')); opendir(my $dh, $ipc->tempdir) || die "Could not open tempdir: !?"; -my @files = grep { $_ !~ m/^\.+$/ && $_ ne "HUB-$hid" } readdir($dh); +my @files = grep { $_ !~ m/^\.+$/ && $_ !~ m/^HUB-$hid/ } readdir($dh); closedir($dh); is(@files, 2, "2 files added to the IPC directory"); @@ -74,7 +76,7 @@ is_deeply( ); opendir($dh, $ipc->tempdir) || die "Could not open tempdir: !?"; -@files = grep { $_ !~ m/^\.+$/ && $_ ne "HUB-$hid" } readdir($dh); +@files = grep { $_ !~ m/^\.+$/ && $_ !~ m/^HUB-$hid/ } readdir($dh); closedir($dh); is(@files, 0, "All files collected"); @@ -152,6 +154,18 @@ ok(!-d $tmpdir, "cleaned up temp dir"); 1; }; + my $cleanup = sub { + if (opendir(my $d, $tmpdir)) { + for my $f (readdir($d)) { + next if $f =~ m/^\.+$/; + next unless -f "$tmpdir/$f"; + unlink("$tmpdir/$f"); + } + } + rmdir($tmpdir) or warn "Could not remove temp dir '$tmpdir': $!"; + }; + $cleanup->(); + is($out->{STDOUT}, "not ok - IPC Fatal Error\nnot ok - IPC Fatal Error\n", "printed "); like($out->{STDERR}, qr/IPC Temp Dir: \Q$tmpdir\E/m, "Got temp dir path"); @@ -186,12 +200,14 @@ ok(!-d $tmpdir, "cleaned up temp dir"); $out = capture { my $ipc = Test2::IPC::Driver::Files->new(); + $tmpdir = $ipc->tempdir; $ipc->add_hub($hid); $ipc->send($hid, bless({ foo => 1 }, 'Foo')); local $@; eval { $ipc->drop_hub($hid) }; print STDERR $@ unless $@ =~ m/^255/; }; + $cleanup->(); like($out->{STDERR}, qr/IPC Fatal Error: Not all files from hub '12345' have been collected/, "Leftover files"); like($out->{STDERR}, qr/IPC Fatal Error: Leftover files in the directory \(.*\.ready\)/, "What file"); diff --git a/cpan/Test-Simple/t/Test2/modules/Util.t b/cpan/Test-Simple/t/Test2/modules/Util.t index 1632a95..da44ba1 100644 --- a/cpan/Test-Simple/t/Test2/modules/Util.t +++ b/cpan/Test-Simple/t/Test2/modules/Util.t @@ -12,6 +12,8 @@ use Test2::Util qw/ CAN_FORK CAN_THREAD CAN_REALLY_FORK + + IS_WIN32 /; { @@ -33,5 +35,8 @@ is(pkg_to_file('A::Package::Name'), 'A/Package/Name.pm', "Converted package to f CAN_THREAD(); CAN_FORK(); CAN_REALLY_FORK(); +IS_WIN32(); + +is(IS_WIN32(), ($^O eq 'MSWin32') ? 1 : 0, "IS_WIN32 is correct ($^O)"); done_testing; diff --git a/cpan/Test-Simple/t/regression/662-tbt-no-plan.t b/cpan/Test-Simple/t/regression/662-tbt-no-plan.t new file mode 100644 index 0000000..acc9c9f --- /dev/null +++ b/cpan/Test-Simple/t/regression/662-tbt-no-plan.t @@ -0,0 +1,25 @@ +use Test::Builder::Tester; +use Test::More tests => 1; +use strict; +use warnings; + +BEGIN { + package Example::Tester; + + use base 'Test::Builder::Module'; + $INC{'Example/Tester.pm'} = 1; + + sub import { + my $package = shift; + my %args = @_; + my $callerpack = caller; + my $tb = __PACKAGE__->builder; + $tb->exported_to($callerpack); + local $SIG{__WARN__} = sub { }; + $tb->no_plan; + } +} + +test_out('ok 1 - use Example::Tester;'); +use_ok('Example::Tester'); +test_test("use Example::Tester;"); diff --git a/cpan/Test-Simple/t/tools.t b/cpan/Test-Simple/t/tools.t index 3a87a00..a71aff1 100644 --- a/cpan/Test-Simple/t/tools.t +++ b/cpan/Test-Simple/t/tools.t @@ -30,7 +30,7 @@ isnt("foo", undef, "'isnt' undef test 1"); isnt(undef, "foo", "'isnt' undef test 2"); like("foo", qr/o/, "'like' test"); unlike("foo", qr/a/, "'unlike' test"); -diag("Testing Diag"); + note("Testing Note"); my $str = "abc"; diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm index 32d74e1..3da2edd 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm @@ -11,7 +11,7 @@ use Symbol; our $VERSION; BEGIN { - $VERSION = '3.31'; + $VERSION = '3.32'; } use ExtUtils::ParseXS::Constants $VERSION; use ExtUtils::ParseXS::CountLines $VERSION; diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pod b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pod index 6bec014..80bf13f 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pod +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pod @@ -20,7 +20,7 @@ ExtUtils::ParseXS - converts Perl XS code into C code optimize => 1, prototypes => 1, ); - + # Legacy non-OO interface using a singleton: use ExtUtils::ParseXS qw(process_file); process_file( filename => 'foo.xs' ); diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm index 2319a24..8aaf3bd 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm @@ -3,7 +3,7 @@ use strict; use warnings; use Symbol; -our $VERSION = '3.31'; +our $VERSION = '3.32'; =head1 NAME diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm index 222a95c..8c41140 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm @@ -1,7 +1,7 @@ package ExtUtils::ParseXS::CountLines; use strict; -our $VERSION = '3.31'; +our $VERSION = '3.32'; our $SECTION_END_MARKER; diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm index 7315332..ae53b8e 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm @@ -2,7 +2,7 @@ package ExtUtils::ParseXS::Eval; use strict; use warnings; -our $VERSION = '3.31'; +our $VERSION = '3.32'; =head1 NAME diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm index 41a9f6d..c4334de 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm @@ -5,7 +5,7 @@ use Exporter; use File::Spec; use ExtUtils::ParseXS::Constants (); -our $VERSION = '3.31'; +our $VERSION = '3.32'; our (@ISA, @EXPORT_OK); @ISA = qw(Exporter); diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm index 48d623e..01b7e30 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm @@ -2,7 +2,7 @@ package ExtUtils::Typemaps; use 5.006001; use strict; use warnings; -our $VERSION = '3.31'; +our $VERSION = '3.32'; require ExtUtils::ParseXS; require ExtUtils::ParseXS::Constants; @@ -22,7 +22,7 @@ ExtUtils::Typemaps - Read/Write/Modify Perl/XS typemap files # $typemap = ExtUtils::Typemaps->new(); # alternatively create an in-memory typemap by parsing a string # $typemap = ExtUtils::Typemaps->new(string => $sometypemap); - + # add a mapping $typemap->add_typemap(ctype => 'NV', xstype => 'T_NV'); $typemap->add_inputmap( @@ -33,13 +33,13 @@ ExtUtils::Typemaps - Read/Write/Modify Perl/XS typemap files ); $typemap->add_string(string => $typemapstring); # will be parsed and merged - + # remove a mapping (same for remove_typemap and remove_outputmap...) $typemap->remove_inputmap(xstype => 'SomeType'); - + # save a typemap to a file $typemap->write(file => 'anotherfile.map'); - + # merge the other typemap into this one $typemap->merge(typemap => $another_typemap); @@ -536,7 +536,7 @@ sub get_outputmap { Write the typemap to a file. Optionally takes a C argument. If given, the typemap will be written to the specified file. If not, the typemap is written -to the currently stored file name (see C<-Efile> above, this defaults to the file +to the currently stored file name (see L above, this defaults to the file it was read from if any). =cut diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm index ffed504..ca787a5 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm @@ -2,7 +2,7 @@ package ExtUtils::Typemaps::Cmd; use 5.006001; use strict; use warnings; -our $VERSION = '3.31'; +our $VERSION = '3.32'; use ExtUtils::Typemaps; diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm index 86c646d..4b17a7b 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm @@ -2,7 +2,7 @@ package ExtUtils::Typemaps::InputMap; use 5.006001; use strict; use warnings; -our $VERSION = '3.31'; +our $VERSION = '3.32'; =head1 NAME diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm index 32cf9f9..3462b45 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm @@ -2,7 +2,7 @@ package ExtUtils::Typemaps::OutputMap; use 5.006001; use strict; use warnings; -our $VERSION = '3.31'; +our $VERSION = '3.32'; =head1 NAME diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm index abe93cb..cf6443e 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm @@ -4,7 +4,7 @@ use strict; use warnings; require ExtUtils::Typemaps; -our $VERSION = '3.31'; +our $VERSION = '3.32'; =head1 NAME diff --git a/dist/Module-CoreList/Changes b/dist/Module-CoreList/Changes index 0724dad..b106654 100644 --- a/dist/Module-CoreList/Changes +++ b/dist/Module-CoreList/Changes @@ -1,3 +1,6 @@ +5.20160620 + - Updated for v5.25.2 + 5.20160520 - fixed edge-case checking in is_core() (checking for a specific version of a module returned false for the first perl release diff --git a/dist/Module-CoreList/lib/Module/CoreList.pm b/dist/Module-CoreList/lib/Module/CoreList.pm index 10d3b2d..bdc4636 100644 --- a/dist/Module-CoreList/lib/Module/CoreList.pm +++ b/dist/Module-CoreList/lib/Module/CoreList.pm @@ -4,7 +4,7 @@ use vars qw/$VERSION %released %version %families %upstream %bug_tracker %deprecated %delta/; use Module::CoreList::TieHashDelta; use version; -$VERSION = '5.20160520'; +$VERSION = '5.20160620'; sub _released_order { # Sort helper, to make '?' sort after everything else (substr($released{$a}, 0, 1) eq "?") @@ -295,6 +295,7 @@ sub changes_between { 5.024000 => '2016-05-09', 5.025000 => '2016-05-09', 5.025001 => '2016-05-20', + 5.025002 => '2016-06-20', ); for my $version ( sort { $a <=> $b } keys %released ) { @@ -12535,6 +12536,172 @@ for my $version ( sort { $a <=> $b } keys %released ) { removed => { } }, + 5.025002 => { + delta_from => 5.025001, + changed => { + 'App::Cpan' => '1.64', + 'B::Op_private' => '5.025002', + 'CPAN' => '2.14', + 'CPAN::Distribution' => '2.12', + 'CPAN::FTP' => '5.5007', + 'CPAN::FirstTime' => '5.5309', + 'CPAN::HandleConfig' => '5.5007', + 'CPAN::Index' => '2.12', + 'CPAN::Mirrors' => '2.12', + 'CPAN::Plugin' => '0.96', + 'CPAN::Shell' => '5.5006', + 'Config' => '5.025002', + 'Cwd' => '3.64', + 'Devel::Peek' => '1.24', + 'DynaLoader' => '1.39', + 'ExtUtils::Command' => '7.18', + 'ExtUtils::Command::MM' => '7.18', + 'ExtUtils::Liblist' => '7.18', + 'ExtUtils::Liblist::Kid'=> '7.18', + 'ExtUtils::MM' => '7.18', + 'ExtUtils::MM_AIX' => '7.18', + 'ExtUtils::MM_Any' => '7.18', + 'ExtUtils::MM_BeOS' => '7.18', + 'ExtUtils::MM_Cygwin' => '7.18', + 'ExtUtils::MM_DOS' => '7.18', + 'ExtUtils::MM_Darwin' => '7.18', + 'ExtUtils::MM_MacOS' => '7.18', + 'ExtUtils::MM_NW5' => '7.18', + 'ExtUtils::MM_OS2' => '7.18', + 'ExtUtils::MM_QNX' => '7.18', + 'ExtUtils::MM_UWIN' => '7.18', + 'ExtUtils::MM_Unix' => '7.18', + 'ExtUtils::MM_VMS' => '7.18', + 'ExtUtils::MM_VOS' => '7.18', + 'ExtUtils::MM_Win32' => '7.18', + 'ExtUtils::MM_Win95' => '7.18', + 'ExtUtils::MY' => '7.18', + 'ExtUtils::MakeMaker' => '7.18', + 'ExtUtils::MakeMaker::Config'=> '7.18', + 'ExtUtils::MakeMaker::Locale'=> '7.18', + 'ExtUtils::MakeMaker::version'=> '7.18', + 'ExtUtils::MakeMaker::version::regex'=> '7.18', + 'ExtUtils::Miniperl' => '1.06', + 'ExtUtils::Mkbootstrap' => '7.18', + 'ExtUtils::Mksymlists' => '7.18', + 'ExtUtils::ParseXS' => '3.32', + 'ExtUtils::ParseXS::Constants'=> '3.32', + 'ExtUtils::ParseXS::CountLines'=> '3.32', + 'ExtUtils::ParseXS::Eval'=> '3.32', + 'ExtUtils::ParseXS::Utilities'=> '3.32', + 'ExtUtils::Typemaps' => '3.32', + 'ExtUtils::Typemaps::Cmd'=> '3.32', + 'ExtUtils::Typemaps::InputMap'=> '3.32', + 'ExtUtils::Typemaps::OutputMap'=> '3.32', + 'ExtUtils::Typemaps::Type'=> '3.32', + 'ExtUtils::testlib' => '7.18', + 'File::Copy' => '2.32', + 'File::Glob' => '1.27', + 'File::Spec' => '3.64', + 'File::Spec::Cygwin' => '3.64', + 'File::Spec::Epoc' => '3.64', + 'File::Spec::Functions' => '3.64', + 'File::Spec::Mac' => '3.64', + 'File::Spec::OS2' => '3.64', + 'File::Spec::Unix' => '3.64', + 'File::Spec::VMS' => '3.64', + 'File::Spec::Win32' => '3.64', + 'FileHandle' => '2.03', + 'Getopt::Long' => '2.49', + 'HTTP::Tiny' => '0.058', + 'JSON::PP' => '2.27400', + 'Locale::Codes' => '3.39', + 'Locale::Codes::Constants'=> '3.39', + 'Locale::Codes::Country'=> '3.39', + 'Locale::Codes::Country_Codes'=> '3.39', + 'Locale::Codes::Country_Retired'=> '3.39', + 'Locale::Codes::Currency'=> '3.39', + 'Locale::Codes::Currency_Codes'=> '3.39', + 'Locale::Codes::Currency_Retired'=> '3.39', + 'Locale::Codes::LangExt'=> '3.39', + 'Locale::Codes::LangExt_Codes'=> '3.39', + 'Locale::Codes::LangExt_Retired'=> '3.39', + 'Locale::Codes::LangFam'=> '3.39', + 'Locale::Codes::LangFam_Codes'=> '3.39', + 'Locale::Codes::LangFam_Retired'=> '3.39', + 'Locale::Codes::LangVar'=> '3.39', + 'Locale::Codes::LangVar_Codes'=> '3.39', + 'Locale::Codes::LangVar_Retired'=> '3.39', + 'Locale::Codes::Language'=> '3.39', + 'Locale::Codes::Language_Codes'=> '3.39', + 'Locale::Codes::Language_Retired'=> '3.39', + 'Locale::Codes::Script' => '3.39', + 'Locale::Codes::Script_Codes'=> '3.39', + 'Locale::Codes::Script_Retired'=> '3.39', + 'Locale::Country' => '3.39', + 'Locale::Currency' => '3.39', + 'Locale::Language' => '3.39', + 'Locale::Script' => '3.39', + 'Module::CoreList' => '5.20160620', + 'Module::CoreList::TieHashDelta'=> '5.20160620', + 'Module::CoreList::Utils'=> '5.20160620', + 'Opcode' => '1.35', + 'POSIX' => '1.70', + 'Pod::Checker' => '1.73', + 'Pod::Functions' => '1.11', + 'Pod::Functions::Functions'=> '1.11', + 'Pod::Usage' => '1.69', + 'Test2' => '1.302026', + 'Test2::API' => '1.302026', + 'Test2::API::Breakage' => '1.302026', + 'Test2::API::Context' => '1.302026', + 'Test2::API::Instance' => '1.302026', + 'Test2::API::Stack' => '1.302026', + 'Test2::Event' => '1.302026', + 'Test2::Event::Bail' => '1.302026', + 'Test2::Event::Diag' => '1.302026', + 'Test2::Event::Exception'=> '1.302026', + 'Test2::Event::Generic' => '1.302026', + 'Test2::Event::Note' => '1.302026', + 'Test2::Event::Ok' => '1.302026', + 'Test2::Event::Plan' => '1.302026', + 'Test2::Event::Skip' => '1.302026', + 'Test2::Event::Subtest' => '1.302026', + 'Test2::Event::Waiting' => '1.302026', + 'Test2::Formatter' => '1.302026', + 'Test2::Formatter::TAP' => '1.302026', + 'Test2::Hub' => '1.302026', + 'Test2::Hub::Interceptor'=> '1.302026', + 'Test2::Hub::Interceptor::Terminator'=> '1.302026', + 'Test2::Hub::Subtest' => '1.302026', + 'Test2::IPC' => '1.302026', + 'Test2::IPC::Driver' => '1.302026', + 'Test2::IPC::Driver::Files'=> '1.302026', + 'Test2::Util' => '1.302026', + 'Test2::Util::ExternalMeta'=> '1.302026', + 'Test2::Util::HashBase' => '1.302026', + 'Test2::Util::Trace' => '1.302026', + 'Test::Builder' => '1.302026', + 'Test::Builder::Formatter'=> '1.302026', + 'Test::Builder::Module' => '1.302026', + 'Test::Builder::Tester' => '1.302026', + 'Test::Builder::Tester::Color'=> '1.302026', + 'Test::Builder::TodoDiag'=> '1.302026', + 'Test::More' => '1.302026', + 'Test::Simple' => '1.302026', + 'Test::Tester' => '1.302026', + 'Test::Tester::Capture' => '1.302026', + 'Test::Tester::CaptureRunner'=> '1.302026', + 'Test::Tester::Delegate'=> '1.302026', + 'Test::use::ok' => '1.302026', + 'Thread::Queue' => '3.11', + 'Time::HiRes' => '1.9734', + 'Unicode::UCD' => '0.65', + 'VMS::DCLsym' => '1.07', + 'XS::APItest' => '0.82', + 'diagnostics' => '1.35', + 'feature' => '1.44', + 'ok' => '1.302026', + 'threads' => '2.09', + }, + removed => { + } + }, ); sub is_core @@ -13202,6 +13369,13 @@ for my $version (sort { $a <=> $b } keys %delta) { removed => { } }, + 5.025002 => { + delta_from => 5.025001, + changed => { + }, + removed => { + } + }, ); for my $version (sort { $a <=> $b } keys %deprecated) { @@ -13574,6 +13748,7 @@ for my $version (sort { $a <=> $b } keys %deprecated) { 'Test2::Event::Bail' => 'cpan', 'Test2::Event::Diag' => 'cpan', 'Test2::Event::Exception'=> 'cpan', + 'Test2::Event::Generic' => 'cpan', 'Test2::Event::Note' => 'cpan', 'Test2::Event::Ok' => 'cpan', 'Test2::Event::Plan' => 'cpan', @@ -14009,6 +14184,7 @@ for my $version (sort { $a <=> $b } keys %deprecated) { 'Test2::Event::Bail' => 'http://github.com/Test-More/test-more/issues', 'Test2::Event::Diag' => 'http://github.com/Test-More/test-more/issues', 'Test2::Event::Exception'=> 'http://github.com/Test-More/test-more/issues', + 'Test2::Event::Generic' => 'http://github.com/Test-More/test-more/issues', 'Test2::Event::Note' => 'http://github.com/Test-More/test-more/issues', 'Test2::Event::Ok' => 'http://github.com/Test-More/test-more/issues', 'Test2::Event::Plan' => 'http://github.com/Test-More/test-more/issues', diff --git a/dist/Module-CoreList/lib/Module/CoreList/TieHashDelta.pm b/dist/Module-CoreList/lib/Module/CoreList/TieHashDelta.pm index b9e39fb..69f994e 100644 --- a/dist/Module-CoreList/lib/Module/CoreList/TieHashDelta.pm +++ b/dist/Module-CoreList/lib/Module/CoreList/TieHashDelta.pm @@ -3,7 +3,7 @@ package Module::CoreList::TieHashDelta; use strict; use vars qw($VERSION); -$VERSION = '5.20160520'; +$VERSION = '5.20160620'; sub TIEHASH { my ($class, $changed, $removed, $parent) = @_; diff --git a/dist/Module-CoreList/lib/Module/CoreList/Utils.pm b/dist/Module-CoreList/lib/Module/CoreList/Utils.pm index 24a11a9..62ea8c2 100644 --- a/dist/Module-CoreList/lib/Module/CoreList/Utils.pm +++ b/dist/Module-CoreList/lib/Module/CoreList/Utils.pm @@ -6,7 +6,7 @@ use vars qw[$VERSION %utilities]; use Module::CoreList; use Module::CoreList::TieHashDelta; -$VERSION = '5.20160520'; +$VERSION = '5.20160620'; sub utilities { my $perl = shift; @@ -1164,6 +1164,13 @@ my %delta = ( removed => { } }, + 5.025002 => { + delta_from => 5.025001, + changed => { + }, + removed => { + } + }, ); for my $version (sort { $a <=> $b } keys %delta) { diff --git a/dist/PathTools/Changes b/dist/PathTools/Changes index 09e977a..b85984e 100644 --- a/dist/PathTools/Changes +++ b/dist/PathTools/Changes @@ -1,5 +1,8 @@ Revision history for Perl distribution PathTools. +3.64 - Tue May 24 10:00:19 MST 2016 +- just minor pod changes to silence Pod::Checker + 3.62 - Mon Jan 11 08:39:19 EST 2016 - ensure File::Spec::canonpath() preserves taint (CVE-2015-8607) diff --git a/dist/PathTools/Cwd.pm b/dist/PathTools/Cwd.pm index e8b9f19..e181219 100644 --- a/dist/PathTools/Cwd.pm +++ b/dist/PathTools/Cwd.pm @@ -3,7 +3,7 @@ use strict; use Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); -$VERSION = '3.63'; +$VERSION = '3.64'; my $xs_version = $VERSION; $VERSION =~ tr/_//d; diff --git a/dist/PathTools/lib/File/Spec.pm b/dist/PathTools/lib/File/Spec.pm index 32b987e..41b0936 100644 --- a/dist/PathTools/lib/File/Spec.pm +++ b/dist/PathTools/lib/File/Spec.pm @@ -3,7 +3,7 @@ package File::Spec; use strict; use vars qw(@ISA $VERSION); -$VERSION = '3.63'; +$VERSION = '3.64'; $VERSION =~ tr/_//d; my %module = (MacOS => 'Mac', diff --git a/dist/PathTools/lib/File/Spec/Cygwin.pm b/dist/PathTools/lib/File/Spec/Cygwin.pm index 2092eb8..d8d532e 100644 --- a/dist/PathTools/lib/File/Spec/Cygwin.pm +++ b/dist/PathTools/lib/File/Spec/Cygwin.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.63'; +$VERSION = '3.64'; $VERSION =~ tr/_//d; @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Epoc.pm b/dist/PathTools/lib/File/Spec/Epoc.pm index 22f0192..422cc44 100644 --- a/dist/PathTools/lib/File/Spec/Epoc.pm +++ b/dist/PathTools/lib/File/Spec/Epoc.pm @@ -3,7 +3,7 @@ package File::Spec::Epoc; use strict; use vars qw($VERSION @ISA); -$VERSION = '3.63'; +$VERSION = '3.64'; $VERSION =~ tr/_//d; require File::Spec::Unix; diff --git a/dist/PathTools/lib/File/Spec/Functions.pm b/dist/PathTools/lib/File/Spec/Functions.pm index af2c498..896de3f 100644 --- a/dist/PathTools/lib/File/Spec/Functions.pm +++ b/dist/PathTools/lib/File/Spec/Functions.pm @@ -5,7 +5,7 @@ use strict; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); -$VERSION = '3.63'; +$VERSION = '3.64'; $VERSION =~ tr/_//d; require Exporter; diff --git a/dist/PathTools/lib/File/Spec/Mac.pm b/dist/PathTools/lib/File/Spec/Mac.pm index 52c3bfe..0d969f2 100644 --- a/dist/PathTools/lib/File/Spec/Mac.pm +++ b/dist/PathTools/lib/File/Spec/Mac.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.63'; +$VERSION = '3.64'; $VERSION =~ tr/_//d; @ISA = qw(File::Spec::Unix); @@ -121,7 +121,7 @@ doesn't alter the path, i.e. these arguments are ignored. (When a "" is passed as the first argument, it has a special meaning, see (6)). This way, a colon ":" is handled like a "." (curdir) on Unix, while an empty string "" is generally ignored (see -Ccanonpath()> ). Likewise, a "::" is handled like a ".." +L ). Likewise, a "::" is handled like a ".." (updir), and a ":::" is handled like a "../.." etc. E.g. catdir("a",":",":","b") = ":a:b:" @@ -168,7 +168,7 @@ their Unix counterparts: # (e.g. "HD:a:") However, this approach is limited to the first arguments following -"root" (again, see Ccanonpath()> ). If there are more +"root" (again, see L. If there are more arguments that move up the directory tree, an invalid path going beyond root can be created. diff --git a/dist/PathTools/lib/File/Spec/OS2.pm b/dist/PathTools/lib/File/Spec/OS2.pm index 804ecdb..d5bf5c6 100644 --- a/dist/PathTools/lib/File/Spec/OS2.pm +++ b/dist/PathTools/lib/File/Spec/OS2.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.63'; +$VERSION = '3.64'; $VERSION =~ tr/_//d; @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Unix.pm b/dist/PathTools/lib/File/Spec/Unix.pm index 3916a11..4fb58d0 100644 --- a/dist/PathTools/lib/File/Spec/Unix.pm +++ b/dist/PathTools/lib/File/Spec/Unix.pm @@ -3,7 +3,7 @@ package File::Spec::Unix; use strict; use vars qw($VERSION); -$VERSION = '3.63'; +$VERSION = '3.64'; my $xs_version = $VERSION; $VERSION =~ tr/_//d; diff --git a/dist/PathTools/lib/File/Spec/VMS.pm b/dist/PathTools/lib/File/Spec/VMS.pm index 02cc0b0..a4b1d89 100644 --- a/dist/PathTools/lib/File/Spec/VMS.pm +++ b/dist/PathTools/lib/File/Spec/VMS.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.63'; +$VERSION = '3.64'; $VERSION =~ tr/_//d; @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Win32.pm b/dist/PathTools/lib/File/Spec/Win32.pm index 1105b67..280e8ec 100644 --- a/dist/PathTools/lib/File/Spec/Win32.pm +++ b/dist/PathTools/lib/File/Spec/Win32.pm @@ -5,7 +5,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.63'; +$VERSION = '3.64'; $VERSION =~ tr/_//d; @ISA = qw(File::Spec::Unix); diff --git a/dist/Thread-Queue/lib/Thread/Queue.pm b/dist/Thread-Queue/lib/Thread/Queue.pm index 2f87eed..9f896b7 100644 --- a/dist/Thread-Queue/lib/Thread/Queue.pm +++ b/dist/Thread-Queue/lib/Thread/Queue.pm @@ -3,7 +3,7 @@ package Thread::Queue; use strict; use warnings; -our $VERSION = '3.09'; +our $VERSION = '3.11'; $VERSION = eval $VERSION; use threads::shared 1.21; @@ -304,7 +304,7 @@ Thread::Queue - Thread-safe queues =head1 VERSION -This document describes Thread::Queue version 3.09 +This document describes Thread::Queue version 3.11 =head1 SYNOPSIS @@ -618,8 +618,11 @@ Passing array/hash refs that contain objects may not work for Perl prior to =head1 SEE ALSO -Thread::Queue Discussion Forum on CPAN: -L +Thread::Queue on MetaCPAN: +L + +Code repository for CPAN distribution: +L L, L diff --git a/dist/Thread-Queue/t/07_lock.t b/dist/Thread-Queue/t/07_lock.t index f9e258e..b20e060 100644 --- a/dist/Thread-Queue/t/07_lock.t +++ b/dist/Thread-Queue/t/07_lock.t @@ -29,7 +29,7 @@ ok($q, 'New queue'); my $sm = Thread::Semaphore->new(0); my $st = Thread::Semaphore->new(0); -threads->create(sub { +my $thr = threads->create(sub { { lock($q); $sm->up(); @@ -39,13 +39,14 @@ threads->create(sub { my @x = $q->extract(5,2); is_deeply(\@x, [6,7], 'Thread dequeues under lock'); } -})->detach(); +}); $sm->down(); $st->up(); my @x = $q->dequeue_nb(100); is_deeply(\@x, [1..5,8..10], 'Main dequeues'); -threads::yield(); + +$thr->join(); exit(0); diff --git a/dist/Time-HiRes/HiRes.pm b/dist/Time-HiRes/HiRes.pm index ad9a65c..e22a663 100644 --- a/dist/Time-HiRes/HiRes.pm +++ b/dist/Time-HiRes/HiRes.pm @@ -28,7 +28,7 @@ our @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval stat lstat ); -our $VERSION = '1.9733'; +our $VERSION = '1.9734'; our $XS_VERSION = $VERSION; $VERSION = eval $VERSION; diff --git a/dist/Time-HiRes/HiRes.xs b/dist/Time-HiRes/HiRes.xs index 38ca0dc..ed60336 100644 --- a/dist/Time-HiRes/HiRes.xs +++ b/dist/Time-HiRes/HiRes.xs @@ -940,7 +940,7 @@ BOOT: } # endif #endif -#if defined(PERL_DARWIN) +#if defined(PERL_DARWIN) && !defined(CLOCK_REALTIME) # ifdef USE_ITHREADS MUTEX_INIT(&darwin_time_mutex); # endif diff --git a/dist/constant/t/constant.t b/dist/constant/t/constant.t index 00eddfb..442b819 100644 --- a/dist/constant/t/constant.t +++ b/dist/constant/t/constant.t @@ -92,11 +92,13 @@ is ZERO3, '0.0'; cmp_ok(abs(PI - 3.1416), '<', 0.0001); is Other::PI, 3.141; -use constant E2BIG => $! = 7; -cmp_ok E2BIG, '==', 7; -# This is something like "Arg list too long", but the actual message -# text may vary, so we can't test much better than this. -cmp_ok length(E2BIG), '>', 6; +# Test that constant.pm can create a dualvar out of $! +use constant A_DUALVAR_CONSTANT => $! = 7; +cmp_ok A_DUALVAR_CONSTANT, '==', 7; +# Make sure we have an error message string. It does not +# matter that 7 means different things on different platforms. +# If this test fails, then either constant.pm or $! is broken: +cmp_ok length(A_DUALVAR_CONSTANT), '>', 6; is @warnings, 0 or diag join "\n- ", "unexpected warning:", @warnings; @warnings = (); # just in case diff --git a/dist/threads/lib/threads.pm b/dist/threads/lib/threads.pm index 182c359..67086da 100644 --- a/dist/threads/lib/threads.pm +++ b/dist/threads/lib/threads.pm @@ -5,7 +5,7 @@ use 5.008; use strict; use warnings; -our $VERSION = '2.08'; +our $VERSION = '2.09'; my $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -134,7 +134,7 @@ threads - Perl interpreter-based threads =head1 VERSION -This document describes threads version 2.08 +This document describes threads version 2.09 =head1 WARNING @@ -1061,6 +1061,18 @@ In prior perl versions, spawning threads with open directory handles would crash the interpreter. L<[perl #75154]|http://rt.perl.org/rt3/Public/Bug/Display.html?id=75154> +=item Detached threads and global destruction + +If the main thread exits while there are detached threads which are still +running, then Perl's global destruction phase is not executed because +otherwise certain global structures that control the operation of threads and +that are allocated in the main thread's memory may get destroyed before the +detached thread is destroyed. + +If you are using any code that requires the execution of the global +destruction phase for clean up (e.g., removing temp files), then do not use +detached threads, but rather join all threads before exiting the program. + =item Perl Bugs and the CPAN Version of L Support for threads extends beyond the code in this module (i.e., diff --git a/dist/threads/t/exit.t b/dist/threads/t/exit.t index d9c4aa7..9e9b7f5 100644 --- a/dist/threads/t/exit.t +++ b/dist/threads/t/exit.t @@ -48,7 +48,7 @@ my $rc = $thr->join(); ok(! defined($rc), 'Exited: threads->exit()'); -run_perl(prog => 'use threads 2.08;' . +run_perl(prog => 'use threads 2.09;' . 'threads->exit(86);' . 'exit(99);', nolib => ($ENV{PERL_CORE}) ? 0 : 1, @@ -98,7 +98,7 @@ $rc = $thr->join(); ok(! defined($rc), 'Exited: $thr->set_thread_exit_only'); -run_perl(prog => 'use threads 2.08 qw(exit thread_only);' . +run_perl(prog => 'use threads 2.09 qw(exit thread_only);' . 'threads->create(sub { exit(99); })->join();' . 'exit(86);', nolib => ($ENV{PERL_CORE}) ? 0 : 1, @@ -108,7 +108,7 @@ run_perl(prog => 'use threads 2.08 qw(exit thread_only);' . is($?>>8, 86, "'use threads 'exit' => 'thread_only'"); } -my $out = run_perl(prog => 'use threads 2.08;' . +my $out = run_perl(prog => 'use threads 2.09;' . 'threads->create(sub {' . ' exit(99);' . '});' . @@ -124,7 +124,7 @@ my $out = run_perl(prog => 'use threads 2.08;' . like($out, qr/1 finished and unjoined/, "exit(status) in thread"); -$out = run_perl(prog => 'use threads 2.08 qw(exit thread_only);' . +$out = run_perl(prog => 'use threads 2.09 qw(exit thread_only);' . 'threads->create(sub {' . ' threads->set_thread_exit_only(0);' . ' exit(99);' . @@ -141,7 +141,7 @@ $out = run_perl(prog => 'use threads 2.08 qw(exit thread_only);' . like($out, qr/1 finished and unjoined/, "set_thread_exit_only(0)"); -run_perl(prog => 'use threads 2.08;' . +run_perl(prog => 'use threads 2.09;' . 'threads->create(sub {' . ' $SIG{__WARN__} = sub { exit(99); };' . ' die();' . diff --git a/dist/threads/t/thread.t b/dist/threads/t/thread.t index 24cf2f3..4bd96d0 100644 --- a/dist/threads/t/thread.t +++ b/dist/threads/t/thread.t @@ -161,7 +161,7 @@ package main; # bugid #24165 -run_perl(prog => 'use threads 2.08;' . +run_perl(prog => 'use threads 2.09;' . 'sub a{threads->create(shift)} $t = a sub{};' . '$t->tid; $t->join; $t->tid', nolib => ($ENV{PERL_CORE}) ? 0 : 1, diff --git a/doop.c b/doop.c index d290203..ad9172a 100644 --- a/doop.c +++ b/doop.c @@ -1241,8 +1241,12 @@ Perl_do_kv(pTHX) const U8 gimme = GIMME_V; const I32 dokv = (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV); /* op_type is OP_RKEYS/OP_RVALUES if pp_rkeys delegated to here */ - const I32 dokeys = dokv || (PL_op->op_type == OP_KEYS); - const I32 dovalues = dokv || (PL_op->op_type == OP_VALUES); + const I32 dokeys = dokv || (PL_op->op_type == OP_KEYS) + || ( PL_op->op_type == OP_AVHVSWITCH + && (PL_op->op_private & 3) + OP_EACH == OP_KEYS ); + const I32 dovalues = dokv || (PL_op->op_type == OP_VALUES) + || ( PL_op->op_type == OP_AVHVSWITCH + && (PL_op->op_private & 3) + OP_EACH == OP_VALUES ); (void)hv_iterinit(keys); /* always reset iterator regardless */ @@ -1273,6 +1277,13 @@ Perl_do_kv(pTHX) RETURN; } + if (UNLIKELY(PL_op->op_private & OPpMAYBE_LVSUB)) { + const I32 flags = is_lvalue_sub(); + if (flags && !(flags & OPpENTERSUB_INARGS)) + /* diag_listed_as: Can't modify %s in %s */ + Perl_croak(aTHX_ "Can't modify keys in list assignment"); + } + /* 2*HvUSEDKEYS() should never be big enough to truncate or wrap */ assert(HvUSEDKEYS(keys) <= (SSize_t_MAX >> 1)); extend_size = (SSize_t)HvUSEDKEYS(keys) * (dokeys + dovalues); diff --git a/embed.fnc b/embed.fnc index bf3b8c5..967fdfc 100644 --- a/embed.fnc +++ b/embed.fnc @@ -908,8 +908,14 @@ pod |SV* |magic_methcall |NN SV *sv|NN const MAGIC *mg \ Ap |I32 * |markstack_grow #if defined(USE_LOCALE_COLLATE) p |int |magic_setcollxfrm|NN SV* sv|NN MAGIC* mg +pb |char* |mem_collxfrm |NN const char* input_string|STRLEN len|NN STRLEN* xlen : Defined in locale.c, used only in sv.c -p |char* |mem_collxfrm |NN const char* s|STRLEN len|NN STRLEN* xlen +# if defined(PERL_IN_LOCALE_C) || defined(PERL_IN_SV_C) || defined(PERL_IN_MATHOMS_C) +pM |char* |_mem_collxfrm |NN const char* input_string \ + |STRLEN len \ + |NN STRLEN* xlen \ + |bool utf8 +# endif #endif Afpd |SV* |mess |NN const char* pat|... Apd |SV* |mess_sv |NN SV* basemsg|bool consume diff --git a/embed.h b/embed.h index 6071c31..f37b76b 100644 --- a/embed.h +++ b/embed.h @@ -1559,6 +1559,11 @@ #define share_hek_flags(a,b,c,d) S_share_hek_flags(aTHX_ a,b,c,d) #define unshare_hek_or_pvn(a,b,c,d) S_unshare_hek_or_pvn(aTHX_ a,b,c,d) # endif +# if defined(PERL_IN_LOCALE_C) || defined(PERL_IN_SV_C) || defined(PERL_IN_MATHOMS_C) +# if defined(USE_LOCALE_COLLATE) +#define _mem_collxfrm(a,b,c,d) Perl__mem_collxfrm(aTHX_ a,b,c,d) +# endif +# endif # if defined(PERL_IN_MALLOC_C) #define adjust_size_and_find_bucket S_adjust_size_and_find_bucket # endif @@ -1844,7 +1849,9 @@ # endif # if defined(USE_LOCALE_COLLATE) #define magic_setcollxfrm(a,b) Perl_magic_setcollxfrm(aTHX_ a,b) +#ifndef NO_MATHOMS #define mem_collxfrm(a,b,c) Perl_mem_collxfrm(aTHX_ a,b,c) +#endif # endif # if defined(USE_PERLIO) #define PerlIO_restore_errno(a) Perl_PerlIO_restore_errno(aTHX_ a) diff --git a/embedvar.h b/embedvar.h index 7e551be..c2831d6 100644 --- a/embedvar.h +++ b/embedvar.h @@ -168,6 +168,7 @@ #define PL_in_clean_objs (vTHX->Iin_clean_objs) #define PL_in_eval (vTHX->Iin_eval) #define PL_in_load_module (vTHX->Iin_load_module) +#define PL_in_utf8_COLLATE_locale (vTHX->Iin_utf8_COLLATE_locale) #define PL_in_utf8_CTYPE_locale (vTHX->Iin_utf8_CTYPE_locale) #define PL_incgv (vTHX->Iincgv) #define PL_initav (vTHX->Iinitav) @@ -308,6 +309,9 @@ #define PL_stderrgv (vTHX->Istderrgv) #define PL_stdingv (vTHX->Istdingv) #define PL_strtab (vTHX->Istrtab) +#define PL_strxfrm_is_behaved (vTHX->Istrxfrm_is_behaved) +#define PL_strxfrm_max_cp (vTHX->Istrxfrm_max_cp) +#define PL_strxfrm_min_char (vTHX->Istrxfrm_min_char) #define PL_sub_generation (vTHX->Isub_generation) #define PL_subline (vTHX->Isubline) #define PL_subname (vTHX->Isubname) diff --git a/ext/Devel-Peek/Peek.pm b/ext/Devel-Peek/Peek.pm index c0483ca..2c57cba 100644 --- a/ext/Devel-Peek/Peek.pm +++ b/ext/Devel-Peek/Peek.pm @@ -3,7 +3,7 @@ package Devel::Peek; -$VERSION = '1.23'; +$VERSION = '1.24'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -133,7 +133,9 @@ means no limit. If C directive has a C<:opd=FLAGS> argument, this switches on debugging of opcode dispatch. C should be a -combination of C, C, and C

(see B<-D> flags in L). +combination of C, C, and C

(see +L<< B<-D> flags in perlrun|perlrun/B<-D>I >>). + C<:opd> is a shortcut for C<:opd=st>. =head2 Runtime debugging @@ -548,7 +550,7 @@ inside a 5th eval in the program; =item * -it is not currently executed (see C); +it is not currently executed (because C is 0); =item * diff --git a/ext/DynaLoader/DynaLoader_pm.PL b/ext/DynaLoader/DynaLoader_pm.PL index e828f35..aeba743 100644 --- a/ext/DynaLoader/DynaLoader_pm.PL +++ b/ext/DynaLoader/DynaLoader_pm.PL @@ -85,7 +85,7 @@ package DynaLoader; # Tim.Bunce@ig.co.uk, August 1994 BEGIN { - $VERSION = '1.38'; + $VERSION = '1.39'; } EOT diff --git a/ext/DynaLoader/dl_dlopen.xs b/ext/DynaLoader/dl_dlopen.xs index 172da13..c166882 100644 --- a/ext/DynaLoader/dl_dlopen.xs +++ b/ext/DynaLoader/dl_dlopen.xs @@ -88,8 +88,7 @@ Dean Roerich's Perl 5 API document. Also, have a look in the typemap file (in the ext directory) for a fairly comprehensive list of types that are already supported. If you are completely stuck, I suggest you - post a message to perl5-porters, comp.lang.perl.misc or if you are really - desperate to me. + post a message to perl5-porters. Remember when you are making any changes that the return value from dl_load_file is used as a parameter in the dl_find_symbol diff --git a/ext/ExtUtils-Miniperl/lib/ExtUtils/Miniperl.pm b/ext/ExtUtils-Miniperl/lib/ExtUtils/Miniperl.pm index 61c66df..5d397b1 100644 --- a/ext/ExtUtils-Miniperl/lib/ExtUtils/Miniperl.pm +++ b/ext/ExtUtils-Miniperl/lib/ExtUtils/Miniperl.pm @@ -8,7 +8,7 @@ use vars qw($VERSION @ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(writemain); -$VERSION = '1.05'; +$VERSION = '1.06'; # blead will run this with miniperl, hence we can't use autodie or File::Temp my $temp; @@ -36,10 +36,10 @@ sub writemain{ my(@exts) = @_; printf $fh <<'EOF!HEAD', xsi_header(); -/* miniperlmain.c +/* miniperlmain.c or perlmain.c - a generated file * * Copyright (C) 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2003, - * 2004, 2005, 2006, 2007, by Larry Wall and others + * 2004, 2005, 2006, 2007, 2016 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -56,11 +56,18 @@ sub writemain{ /* This file contains the main() function for the perl interpreter. * Note that miniperlmain.c contains main() for the 'miniperl' binary, - * while perlmain.c contains main() for the 'perl' binary. + * while perlmain.c contains main() for the 'perl' binary. The typical + * difference being that the latter includes Dynaloader. * * Miniperl is like perl except that it does not support dynamic loading, * and in fact is used to build the dynamic modules needed for the 'real' * perl executable. + * + * The content of the body of this generated file is mostly contained + * in Miniperl.pm - edit that file if you want to change anything. + * miniperlmain.c is generated by running regen/miniperlmain.pl.pl, while + * perlmain.c is built automatically by Makefile (so the former is + * included in the tarball while the latter isn't). */ #ifdef OEMVS @@ -217,7 +224,7 @@ __END__ =head1 NAME -ExtUtils::Miniperl - write the C code for perlmain.c +ExtUtils::Miniperl - write the C code for miniperlmain.c and perlmain.c =head1 SYNOPSIS @@ -230,18 +237,21 @@ ExtUtils::Miniperl - write the C code for perlmain.c =head1 DESCRIPTION -C takes an argument list of directories containing archive +C takes an argument list of zero or more directories +containing archive libraries that relate to perl modules and should be linked into a new -perl binary. It writes a corresponding F file that +perl binary. It writes a corresponding F or F +file that is a plain C file containing all the bootstrap code to make the modules associated with the libraries available from within perl. If the first argument to C is a reference to a scalar it is used as the filename to open for output. Any other reference is used as the filehandle to write to. Otherwise output defaults to C. -The typical usage is from within a Makefile generated by -L. So under normal circumstances you won't have to -deal with this module directly. +The typical usage is from within perl's own Makefile (to build +F) or from F (to build miniperlmain.c). +So under normal circumstances you won't have to deal with this module +directly. =head1 SEE ALSO diff --git a/ext/File-Glob/Glob.pm b/ext/File-Glob/Glob.pm index c0b5a47..c9c2d29 100644 --- a/ext/File-Glob/Glob.pm +++ b/ext/File-Glob/Glob.pm @@ -37,7 +37,7 @@ pop @{$EXPORT_TAGS{bsd_glob}}; # no "glob" @EXPORT_OK = (@{$EXPORT_TAGS{'glob'}}, 'csh_glob'); -$VERSION = '1.26'; +$VERSION = '1.27'; sub import { require Exporter; @@ -176,10 +176,15 @@ means this will loop forever: =head3 C This function, which is included in the two export tags listed above, -takes one or two arguments. The first is the glob pattern. The second is -a set of flags ORed together. The available flags are listed below under -L. If the second argument is omitted, C (or -C on VMS and DOSish systems) is used by default. +takes one or two arguments. The first is the glob pattern. The +second, if given, is a set of flags ORed together. The available +flags and the default set of flags are listed below under L. + +Remember that to use the named constants for flags you must import +them, for example with C<:bsd_glob> described above. If not imported, +and C is not in effect, then the constants will be +treated as bareword strings, which won't do what you what. + =head3 C<:nocase> and C<:case> @@ -196,7 +201,9 @@ uses this internally. =head2 POSIX FLAGS -The POSIX defined flags for bsd_glob() are: +If no flags argument is give then C is set, and on VMS and +Windows systems, C too. Otherwise the flags to use are +determined solely by the flags argument. The POSIX defined flags are: =over 4 diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm index 1522c4c..9d667c2 100644 --- a/ext/Opcode/Opcode.pm +++ b/ext/Opcode/Opcode.pm @@ -6,7 +6,7 @@ use strict; our($VERSION, @ISA, @EXPORT_OK); -$VERSION = "1.34"; +$VERSION = "1.35"; use Carp; use Exporter (); @@ -338,7 +338,7 @@ invert_opset function. warn die lineseq nextstate scope enter leave - rv2cv anoncode prototype coreargs anonconst + rv2cv anoncode prototype coreargs avhvswitch anonconst entersub leavesub leavesublv return method method_named method_super method_redir method_redir_super diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index f825e29..3820026 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -1663,6 +1663,11 @@ allocate_struct(pTHX_ SV *rv, const STRLEN size, const char *packname) { SV *const t = newSVrv(rv, packname); void *const p = sv_grow(t, size + 1); + /* Ensure at least one use of not_here() to avoid "defined but not + * used" warning. This is not at all related to allocate_struct(); I + * just needed somewhere to dump it - DAPM */ + if (0) { not_here(""); } + SvCUR_set(t, size); SvPOK_on(t); return p; diff --git a/ext/POSIX/lib/POSIX.pm b/ext/POSIX/lib/POSIX.pm index 6231bcb..1bf8e62 100644 --- a/ext/POSIX/lib/POSIX.pm +++ b/ext/POSIX/lib/POSIX.pm @@ -4,7 +4,7 @@ use warnings; our ($AUTOLOAD, %SIGRT); -our $VERSION = '1.69'; +our $VERSION = '1.70'; require XSLoader; diff --git a/ext/POSIX/t/sigaction.t b/ext/POSIX/t/sigaction.t index d19341c..bce3b76 100644 --- a/ext/POSIX/t/sigaction.t +++ b/ext/POSIX/t/sigaction.t @@ -202,7 +202,9 @@ SKIP: { $skip{pid}{$^O} = $skip{uid}{$^O} = "not set for kill()" if (($^O.$Config{osvers}) =~ /^darwin[0-8]\./ || - ($^O.$Config{osvers}) =~ /^openbsd[0-5]\./); + ($^O.$Config{osvers}) =~ /^openbsd[0-5]\./ + || + ($^O eq 'gnu')); my $tests = keys %{{ %siginfo, %opt_val }}; eval 'use POSIX qw(SA_SIGINFO); SA_SIGINFO'; skip("no SA_SIGINFO", $tests) if $@; diff --git a/ext/Pod-Functions/Functions_pm.PL b/ext/Pod-Functions/Functions_pm.PL index af5d37a..eb8369a 100644 --- a/ext/Pod-Functions/Functions_pm.PL +++ b/ext/Pod-Functions/Functions_pm.PL @@ -161,7 +161,7 @@ Pod::Functions - Group Perl's functions a la perlfunc.pod =head1 SYNOPSIS use Pod::Functions; - + my @misc_ops = @{ $Kinds{ 'Misc' } }; my $misc_dsc = $Type_Description{ 'Misc' }; @@ -207,7 +207,7 @@ L section. =cut -our $VERSION = '1.10'; +our $VERSION = '1.11'; require Exporter; diff --git a/ext/VMS-DCLsym/DCLsym.pm b/ext/VMS-DCLsym/DCLsym.pm index b8c9c1b..b239e15 100644 --- a/ext/VMS-DCLsym/DCLsym.pm +++ b/ext/VMS-DCLsym/DCLsym.pm @@ -7,7 +7,7 @@ use strict; # Package globals @ISA = ( 'DynaLoader' ); -$VERSION = '1.06'; +$VERSION = '1.07'; my(%Locsyms) = ( ':ID' => 'LOCAL' ); my(%Gblsyms) = ( ':ID' => 'GLOBAL'); my $DoCache = 1; @@ -186,8 +186,8 @@ defines a new symbol (or overwrites the old value of an existing symbol), and deleting an element deletes the corresponding symbol. Setting an element to C, or Cing it directly, sets the corresponding symbol to the null string. You may also read the special keys ':GLOBAL' and ':LOCAL' to find out -whether a default symbol table has been specified for this hash (see C -below), or set either or these keys to specify a default symbol table. +whether a default symbol table has been specified for this hash (see the next +paragraph), or set either or these keys to specify a default symbol table. When you call the C function to bind an associative array to this package, you may specify as an optional argument the symbol table in which you wish to diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm index 334b9e3..c75241e 100644 --- a/ext/XS-APItest/APItest.pm +++ b/ext/XS-APItest/APItest.pm @@ -5,7 +5,7 @@ use strict; use warnings; use Carp; -our $VERSION = '0.81'; +our $VERSION = '0.82'; require XSLoader; diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index f175acd..f73a715 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -4091,6 +4091,7 @@ lexical_import(SV *name, CV *cv) padadd_STATE, 0, 0); SvREFCNT_dec(PL_curpad[off]); PL_curpad[off] = SvREFCNT_inc(cv); + intro_my(); LEAVE; } @@ -4193,7 +4194,7 @@ CODE: } else if (items == 3) { Perl_load_module(aTHX_ flags, SvREFCNT_inc(name), SvREFCNT_inc(ST(2))); } else - Perl_croak(aTHX_ "load_module can't yet support %lu items", items); + Perl_croak(aTHX_ "load_module can't yet support %"IVdf" items", (IV)items); MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest diff --git a/ext/XS-APItest/t/lexsub.t b/ext/XS-APItest/t/lexsub.t index 2d66add..25985f6 100644 --- a/ext/XS-APItest/t/lexsub.t +++ b/ext/XS-APItest/t/lexsub.t @@ -1,4 +1,4 @@ -use Test::More tests => 4; +use Test::More tests => 5; use XS::APItest; @@ -17,3 +17,14 @@ is fribbler(15), 30, 'XS-allocated lexical subs falling out of scope'; our sub fribbler; is fribbler(15), 30, 'our sub overrides XS-registered lexical sub'; } + +# With ‘use’ rather than explicit BEGIN: +package Lexical::Exporter { + sub import { shift; ::lexical_import @_; return } +} +BEGIN { ++$INC{"Lexical/Exporter.pm"} } + +{ + use Lexical::Exporter fribbler => sub { shift() . "foo" }; + is fribbler("bar"), "barfoo"; +} diff --git a/feature.h b/feature.h index a527e06..27dfd51 100644 --- a/feature.h +++ b/feature.h @@ -76,12 +76,6 @@ FEATURE_IS_ENABLED("evalbytes")) \ ) -#define FEATURE_POSTDEREF_IS_ENABLED \ - ( \ - CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \ - FEATURE_IS_ENABLED("postderef") \ - ) - #define FEATURE_ARYBASE_IS_ENABLED \ ( \ CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_511 \ @@ -109,12 +103,6 @@ FEATURE_IS_ENABLED("refaliasing") \ ) -#define FEATURE_LEXSUBS_IS_ENABLED \ - ( \ - CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \ - FEATURE_IS_ENABLED("lexsubs") \ - ) - #define FEATURE_POSTDEREF_QQ_IS_ENABLED \ ( \ CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_523 \ diff --git a/gv.c b/gv.c index e4fb3fe..4df3bce 100644 --- a/gv.c +++ b/gv.c @@ -531,18 +531,12 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv, return NULL; case KEY_chdir: case KEY_chomp: case KEY_chop: case KEY_defined: case KEY_delete: - case KEY_each : case KEY_eof : case KEY_exec : case KEY_exists: - case KEY_keys: + case KEY_eof : case KEY_exec: case KEY_exists : case KEY_lstat: - case KEY_pop: - case KEY_push: - case KEY_shift: - case KEY_splice: case KEY_split: + case KEY_split: case KEY_stat: case KEY_system: case KEY_truncate: case KEY_unlink: - case KEY_unshift: - case KEY_values: ampable = FALSE; } if (!gv) { @@ -604,7 +598,7 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv, )) != NULL) { assert(GvCV(gv) == orig_cv); if (opnum != OP_VEC && opnum != OP_SUBSTR && opnum != OP_POS - && opnum != OP_UNDEF) + && opnum != OP_UNDEF && opnum != OP_KEYS) CvLVALUE_off(cv); /* Now *that* was a neat trick. */ } LEAVE; diff --git a/handy.h b/handy.h index 932a874..b1b50ff 100644 --- a/handy.h +++ b/handy.h @@ -1860,7 +1860,7 @@ typedef U32 line_t; =for apidoc Am|void|Newx|void* ptr|int nitems|type The XSUB-writer's interface to the C C function. -Memory obtained by this should B be freed with L<"Safefree">. +Memory obtained by this should B be freed with L. In 5.9.3, Newx() and friends replace the older New() API, and drops the first parameter, I, a debug aid which allowed callers to identify @@ -1872,29 +1872,29 @@ there for use in XS modules supporting older perls. The XSUB-writer's interface to the C C function, with cast. See also C>. -Memory obtained by this should B be freed with L<"Safefree">. +Memory obtained by this should B be freed with L. =for apidoc Am|void|Newxz|void* ptr|int nitems|type The XSUB-writer's interface to the C C function. The allocated memory is zeroed with C. See also C>. -Memory obtained by this should B be freed with L<"Safefree">. +Memory obtained by this should B be freed with L. =for apidoc Am|void|Renew|void* ptr|int nitems|type The XSUB-writer's interface to the C C function. -Memory obtained by this should B be freed with L<"Safefree">. +Memory obtained by this should B be freed with L. =for apidoc Am|void|Renewc|void* ptr|int nitems|type|cast The XSUB-writer's interface to the C C function, with cast. -Memory obtained by this should B be freed with L<"Safefree">. +Memory obtained by this should B be freed with L. =for apidoc Am|void|Safefree|void* ptr The XSUB-writer's interface to the C C function. -This should B be used on memory obtained using L<"Newx"> and friends. +This should B be used on memory obtained using L and friends. =for apidoc Am|void|Move|void* src|void* dest|int nitems|type The XSUB-writer's interface to the C C function. The C is the diff --git a/hints/catamount.sh b/hints/catamount.sh index 50cc85f..bd1b26b 100644 --- a/hints/catamount.sh +++ b/hints/catamount.sh @@ -31,11 +31,11 @@ # mkdir -p /opt/perl-catamount # mkdir -p /opt/perl-catamount/include # mkdir -p /opt/perl-catamount/lib -# mkdir -p /opt/perl-catamount/lib/perl5/5.25.1 +# mkdir -p /opt/perl-catamount/lib/perl5/5.25.2 # mkdir -p /opt/perl-catamount/bin # cp *.h /opt/perl-catamount/include # cp libperl.a /opt/perl-catamount/lib -# cp -pr lib/* /opt/perl-catamount/lib/perl5/5.25.1 +# cp -pr lib/* /opt/perl-catamount/lib/perl5/5.25.2 # cp miniperl perl run.sh cc.sh /opt/perl-catamount/lib # # With the headers and the libperl.a you can embed Perl to your Catamount diff --git a/hints/gnu.sh b/hints/gnu.sh index fe251cb..8ec9470 100644 --- a/hints/gnu.sh +++ b/hints/gnu.sh @@ -1,6 +1,5 @@ # hints/gnu.sh -# Last modified: Thu Dec 10 20:47:28 CET 1998 -# Mark Kettenis +# Originally contributed by: Mark Kettenis Dec 10 1998 # libnsl is unusable on the Hurd. # XXX remove this once SUNRPC is implemented. @@ -30,8 +29,34 @@ lddlflags='-shared' # Flags needed by programs that use dynamic linking. ccdlflags='-Wl,-E' -# Debian bug #258618 -ccflags="-D_GNU_SOURCE $ccflags" +# This script UU/usethreads.cbu will get 'called-back' by Configure +# after it has prompted the user for whether to use threads. +cat > UU/usethreads.cbu <<'EOCBU' +case "$usethreads" in +$define|true|[yY]*) + ccflags="-D_REENTRANT -D_GNU_SOURCE $ccflags" + if echo $libswanted | grep -v pthread >/dev/null + then + set `echo X "$libswanted "| sed -e 's/ c / pthread c /'` + shift + libswanted="$*" + fi + + # Somehow at least in Debian 2.2 these manage to escape + # the #define forest of and so that + # the hasproto macro of Configure doesn't see these protos, + # even with the -D_GNU_SOURCE. + + d_asctime_r_proto="$define" + d_crypt_r_proto="$define" + d_ctime_r_proto="$define" + d_gmtime_r_proto="$define" + d_localtime_r_proto="$define" + d_random_r_proto="$define" + + ;; +esac +EOCBU cat > UU/uselargefiles.cbu <<'EOCBU' # This script UU/uselargefiles.cbu will get 'called-back' by Configure diff --git a/intrpvar.h b/intrpvar.h index 50a9ee0..ca1bb71 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -245,6 +245,7 @@ PERLVAR(I, exit_flags, U8) /* was exit() unexpected, etc. */ PERLVAR(I, utf8locale, bool) /* utf8 locale detected */ PERLVAR(I, in_utf8_CTYPE_locale, bool) +PERLVAR(I, in_utf8_COLLATE_locale, bool) #ifdef USE_LOCALE_CTYPE PERLVAR(I, warn_locale, SV *) #endif @@ -563,6 +564,10 @@ PERLVAR(I, collation_name, char *) /* Name of current collation */ PERLVAR(I, collxfrm_base, Size_t) /* Basic overhead in *xfrm() */ PERLVARI(I, collxfrm_mult,Size_t, 2) /* Expansion factor in *xfrm() */ PERLVARI(I, collation_ix, U32, 0) /* Collation generation index */ +PERLVARA(I, strxfrm_min_char, 3, char) +PERLVARI(I, strxfrm_is_behaved, bool, TRUE) + /* Assume until proven otherwise that it works */ +PERLVARI(I, strxfrm_max_cp, U8, 0) /* Highest collating cp in locale */ PERLVARI(I, collation_standard, bool, TRUE) /* Assume simple collation */ #endif /* USE_LOCALE_COLLATE */ diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t index 19db404..fe13aae 100644 --- a/lib/B/Deparse.t +++ b/lib/B/Deparse.t @@ -1941,12 +1941,11 @@ my($a, $b, $c) = @_; #### # SKIP ?$] < 5.017004 && "lexical subs not implemented on this Perl version" # lexical subroutine -use feature 'lexical_subs'; +# CONTEXT use feature 'lexical_subs'; no warnings "experimental::lexical_subs"; my sub f {} print f(); >>>> -use feature 'lexical_subs'; BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55\x15"} my sub f { BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x15"} @@ -1957,20 +1956,17 @@ print f(); #### # SKIP ?$] < 5.017004 && "lexical subs not implemented on this Perl version" # lexical "state" subroutine -use feature 'state', 'lexical_subs'; +# CONTEXT use feature 'state', 'lexical_subs'; no warnings 'experimental::lexical_subs'; state sub f {} print f(); >>>> -use feature 'lexical_subs'; BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55\x15"} -CORE::state sub f { +state sub f { BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x15"} - use feature 'state'; } BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x15"} -use feature 'state'; print f(); #### # SKIP ?$] < 5.017004 && "lexical subs not implemented on this Perl version" diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm index 6618418..a65196b 100644 --- a/lib/B/Op_private.pm +++ b/lib/B/Op_private.pm @@ -118,7 +118,7 @@ package B::Op_private; our %bits; -our $VERSION = "5.025001"; +our $VERSION = "5.025002"; $bits{$_}{3} = 'OPpENTERSUB_AMPER' for qw(entersub rv2cv); $bits{$_}{6} = 'OPpENTERSUB_DB' for qw(entersub rv2cv); @@ -136,7 +136,7 @@ $bits{$_}{6} = 'OPpLVAL_DEFER' for qw(aelem helem multideref); $bits{$_}{7} = 'OPpLVAL_INTRO' for qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list lvavref lvref lvrefslice multideref padav padhv padrange padsv pushmark refassign rv2av rv2gv rv2hv rv2sv); $bits{$_}{2} = 'OPpLVREF_ELEM' for qw(lvref refassign); $bits{$_}{3} = 'OPpLVREF_ITER' for qw(lvref refassign); -$bits{$_}{3} = 'OPpMAYBE_LVSUB' for qw(aassign aelem aslice av2arylen helem hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv substr vec); +$bits{$_}{3} = 'OPpMAYBE_LVSUB' for qw(aassign aelem akeys aslice av2arylen avhvswitch helem hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv substr vec); $bits{$_}{4} = 'OPpMAYBE_TRUEBOOL' for qw(padhv rv2hv); $bits{$_}{7} = 'OPpOFFBYONE' for qw(caller runcv wantarray); $bits{$_}{5} = 'OPpOPEN_IN_CRLF' for qw(backtick open); @@ -175,6 +175,11 @@ my @bf = ( bitmask => 3, }, { + bitmin => 0, + bitmax => 1, + bitmask => 3, + }, + { label => '-', mask_def => 'OPpARG3_MASK', bitmin => 0, @@ -229,52 +234,53 @@ my @bf = ( @{$bits{aassign}}{6,5,4,1,0} = ('OPpASSIGN_COMMON_SCALAR', 'OPpASSIGN_COMMON_RC1', 'OPpASSIGN_COMMON_AGG', $bf[1], $bf[1]); $bits{abs}{0} = $bf[0]; -@{$bits{accept}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{accept}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{add}}{1,0} = ($bf[1], $bf[1]); $bits{aeach}{0} = $bf[0]; -@{$bits{aelem}}{5,4,1,0} = ($bf[6], $bf[6], $bf[1], $bf[1]); -@{$bits{aelemfast}}{7,6,5,4,3,2,1,0} = ($bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5]); -@{$bits{aelemfast_lex}}{7,6,5,4,3,2,1,0} = ($bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5]); +@{$bits{aelem}}{5,4,1,0} = ($bf[7], $bf[7], $bf[1], $bf[1]); +@{$bits{aelemfast}}{7,6,5,4,3,2,1,0} = ($bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6]); +@{$bits{aelemfast_lex}}{7,6,5,4,3,2,1,0} = ($bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6]); $bits{akeys}{0} = $bf[0]; $bits{alarm}{0} = $bf[0]; $bits{and}{0} = $bf[0]; $bits{andassign}{0} = $bf[0]; $bits{anonconst}{0} = $bf[0]; -@{$bits{anonhash}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{anonlist}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{atan2}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{anonhash}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{anonlist}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{atan2}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{av2arylen}{0} = $bf[0]; $bits{avalues}{0} = $bf[0]; +@{$bits{avhvswitch}}{1,0} = ($bf[2], $bf[2]); $bits{backtick}{0} = $bf[0]; -@{$bits{bind}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{binmode}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{bind}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{binmode}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{bit_and}}{1,0} = ($bf[1], $bf[1]); @{$bits{bit_or}}{1,0} = ($bf[1], $bf[1]); @{$bits{bit_xor}}{1,0} = ($bf[1], $bf[1]); -@{$bits{bless}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{caller}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{chdir}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{chmod}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{bless}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{caller}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{chdir}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{chmod}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{chomp}{0} = $bf[0]; $bits{chop}{0} = $bf[0]; -@{$bits{chown}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{chown}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{chr}{0} = $bf[0]; $bits{chroot}{0} = $bf[0]; -@{$bits{close}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{close}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{closedir}{0} = $bf[0]; $bits{complement}{0} = $bf[0]; @{$bits{concat}}{1,0} = ($bf[1], $bf[1]); $bits{cond_expr}{0} = $bf[0]; -@{$bits{connect}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{connect}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{const}}{6,4,3,2,1} = ('OPpCONST_BARE', 'OPpCONST_ENTERED', 'OPpCONST_STRICT', 'OPpCONST_SHORTCIRCUIT', 'OPpCONST_NOVER'); @{$bits{coreargs}}{7,6,1,0} = ('OPpCOREARGS_PUSHMARK', 'OPpCOREARGS_SCALARMOD', 'OPpCOREARGS_DEREF2', 'OPpCOREARGS_DEREF1'); $bits{cos}{0} = $bf[0]; -@{$bits{crypt}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{crypt}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{dbmclose}{0} = $bf[0]; -@{$bits{dbmopen}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{dbmopen}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{defined}{0} = $bf[0]; @{$bits{delete}}{6,0} = ('OPpSLICE', $bf[0]); -@{$bits{die}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{die}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{divide}}{1,0} = ($bf[1], $bf[1]); $bits{dofile}{0} = $bf[0]; $bits{dor}{0} = $bf[0]; @@ -284,23 +290,23 @@ $bits{each}{0} = $bf[0]; @{$bits{entereval}}{5,4,3,2,1,0} = ('OPpEVAL_RE_REPARSING', 'OPpEVAL_COPHH', 'OPpEVAL_BYTES', 'OPpEVAL_UNICODE', 'OPpEVAL_HAS_HH', $bf[0]); $bits{entergiven}{0} = $bf[0]; $bits{enteriter}{3} = 'OPpITER_DEF'; -@{$bits{entersub}}{5,4,0} = ($bf[6], $bf[6], 'OPpENTERSUB_INARGS'); +@{$bits{entersub}}{5,4,0} = ($bf[7], $bf[7], 'OPpENTERSUB_INARGS'); $bits{entertry}{0} = $bf[0]; $bits{enterwhen}{0} = $bf[0]; -@{$bits{enterwrite}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{eof}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{enterwrite}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{eof}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{eq}}{1,0} = ($bf[1], $bf[1]); -@{$bits{exec}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{exec}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{exists}}{6,0} = ('OPpEXISTS_SUB', $bf[0]); -@{$bits{exit}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{exit}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{exp}{0} = $bf[0]; $bits{fc}{0} = $bf[0]; -@{$bits{fcntl}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{fileno}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{fcntl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{fileno}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{flip}{0} = $bf[0]; -@{$bits{flock}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{flock}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{flop}{0} = $bf[0]; -@{$bits{formline}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{formline}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{ftatime}{0} = $bf[0]; $bits{ftbinary}{0} = $bf[0]; $bits{ftblk}{0} = $bf[0]; @@ -330,32 +336,32 @@ $bits{fttty}{0} = $bf[0]; $bits{ftzero}{0} = $bf[0]; @{$bits{ge}}{1,0} = ($bf[1], $bf[1]); @{$bits{gelem}}{1,0} = ($bf[1], $bf[1]); -@{$bits{getc}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{getc}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{getpeername}{0} = $bf[0]; -@{$bits{getpgrp}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{getpriority}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{getpgrp}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{getpriority}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{getsockname}{0} = $bf[0]; $bits{ggrgid}{0} = $bf[0]; $bits{ggrnam}{0} = $bf[0]; -@{$bits{ghbyaddr}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{ghbyaddr}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{ghbyname}{0} = $bf[0]; -@{$bits{glob}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{gmtime}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{gnbyaddr}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{glob}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{gmtime}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{gnbyaddr}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{gnbyname}{0} = $bf[0]; $bits{goto}{0} = $bf[0]; $bits{gpbyname}{0} = $bf[0]; -@{$bits{gpbynumber}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{gpbynumber}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{gpwnam}{0} = $bf[0]; $bits{gpwuid}{0} = $bf[0]; $bits{grepstart}{0} = $bf[0]; $bits{grepwhile}{0} = $bf[0]; -@{$bits{gsbyname}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{gsbyport}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{gsockopt}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{gsbyname}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{gsbyport}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{gsockopt}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{gt}}{1,0} = ($bf[1], $bf[1]); $bits{gv}{5} = 'OPpEARLY_CV'; -@{$bits{helem}}{5,4,1,0} = ($bf[6], $bf[6], $bf[1], $bf[1]); +@{$bits{helem}}{5,4,1,0} = ($bf[7], $bf[7], $bf[1], $bf[1]); $bits{hex}{0} = $bf[0]; @{$bits{i_add}}{1,0} = ($bf[1], $bf[1]); @{$bits{i_divide}}{1,0} = ($bf[1], $bf[1]); @@ -374,12 +380,12 @@ $bits{i_postinc}{0} = $bf[0]; $bits{i_predec}{0} = $bf[0]; $bits{i_preinc}{0} = $bf[0]; @{$bits{i_subtract}}{1,0} = ($bf[1], $bf[1]); -@{$bits{index}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{index}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{int}{0} = $bf[0]; -@{$bits{ioctl}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{join}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{ioctl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{join}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{keys}{0} = $bf[0]; -@{$bits{kill}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{kill}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{last}{0} = $bf[0]; $bits{lc}{0} = $bf[0]; $bits{lcfirst}{0} = $bf[0]; @@ -393,9 +399,9 @@ $bits{leavewhen}{0} = $bf[0]; $bits{leavewrite}{0} = $bf[0]; @{$bits{left_shift}}{1,0} = ($bf[1], $bf[1]); $bits{length}{0} = $bf[0]; -@{$bits{link}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{link}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{list}{6} = 'OPpLIST_GUESSED'; -@{$bits{listen}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{listen}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{localtime}{0} = $bf[0]; $bits{lock}{0} = $bf[0]; $bits{log}{0} = $bf[0]; @@ -403,7 +409,7 @@ $bits{log}{0} = $bf[0]; $bits{lstat}{0} = $bf[0]; @{$bits{lt}}{1,0} = ($bf[1], $bf[1]); $bits{lvavref}{0} = $bf[0]; -@{$bits{lvref}}{5,4,0} = ($bf[7], $bf[7], $bf[0]); +@{$bits{lvref}}{5,4,0} = ($bf[8], $bf[8], $bf[0]); $bits{mapstart}{0} = $bf[0]; $bits{mapwhile}{0} = $bf[0]; $bits{method}{0} = $bf[0]; @@ -411,12 +417,12 @@ $bits{method_named}{0} = $bf[0]; $bits{method_redir}{0} = $bf[0]; $bits{method_redir_super}{0} = $bf[0]; $bits{method_super}{0} = $bf[0]; -@{$bits{mkdir}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{mkdir}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{modulo}}{1,0} = ($bf[1], $bf[1]); -@{$bits{msgctl}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{msgget}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{msgrcv}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{msgsnd}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{msgctl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{msgget}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{msgrcv}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{msgsnd}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{multideref}}{5,4,0} = ('OPpMULTIDEREF_DELETE', 'OPpMULTIDEREF_EXISTS', $bf[0]); @{$bits{multiply}}{1,0} = ($bf[1], $bf[1]); @{$bits{nbit_and}}{1,0} = ($bf[1], $bf[1]); @@ -430,15 +436,15 @@ $bits{next}{0} = $bf[0]; $bits{not}{0} = $bf[0]; $bits{oct}{0} = $bf[0]; $bits{once}{0} = $bf[0]; -@{$bits{open}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{open_dir}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{open}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{open_dir}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{or}{0} = $bf[0]; $bits{orassign}{0} = $bf[0]; $bits{ord}{0} = $bf[0]; -@{$bits{pack}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{padrange}}{6,5,4,3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4], $bf[4], $bf[4], $bf[4]); -@{$bits{padsv}}{5,4} = ($bf[6], $bf[6]); -@{$bits{pipe_op}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{pack}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{padrange}}{6,5,4,3,2,1,0} = ($bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5]); +@{$bits{padsv}}{5,4} = ($bf[7], $bf[7]); +@{$bits{pipe_op}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{pop}{0} = $bf[0]; $bits{pos}{0} = $bf[0]; $bits{postdec}{0} = $bf[0]; @@ -447,36 +453,36 @@ $bits{postinc}{0} = $bf[0]; $bits{predec}{0} = $bf[0]; $bits{preinc}{0} = $bf[0]; $bits{prototype}{0} = $bf[0]; -@{$bits{push}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{push}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{quotemeta}{0} = $bf[0]; -@{$bits{rand}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{rand}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{range}{0} = $bf[0]; -@{$bits{read}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{read}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{readdir}{0} = $bf[0]; $bits{readline}{0} = $bf[0]; $bits{readlink}{0} = $bf[0]; -@{$bits{recv}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{recv}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{redo}{0} = $bf[0]; $bits{ref}{0} = $bf[0]; -@{$bits{refassign}}{5,4,1,0} = ($bf[7], $bf[7], $bf[1], $bf[1]); +@{$bits{refassign}}{5,4,1,0} = ($bf[8], $bf[8], $bf[1], $bf[1]); $bits{refgen}{0} = $bf[0]; $bits{regcmaybe}{0} = $bf[0]; $bits{regcomp}{0} = $bf[0]; $bits{regcreset}{0} = $bf[0]; -@{$bits{rename}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{rename}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{repeat}}{6,1,0} = ('OPpREPEAT_DOLIST', $bf[1], $bf[1]); $bits{require}{0} = $bf[0]; -@{$bits{reset}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{reset}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{reverse}}{3,0} = ('OPpREVERSE_INPLACE', $bf[0]); $bits{rewinddir}{0} = $bf[0]; @{$bits{right_shift}}{1,0} = ($bf[1], $bf[1]); -@{$bits{rindex}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{rindex}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{rmdir}{0} = $bf[0]; $bits{rv2av}{0} = $bf[0]; @{$bits{rv2cv}}{7,5,0} = ('OPpENTERSUB_NOPAREN', 'OPpMAY_RETURN_CONSTANT', $bf[0]); -@{$bits{rv2gv}}{6,5,4,2,0} = ('OPpALLOW_FAKE', $bf[6], $bf[6], 'OPpDONT_INIT_GV', $bf[0]); +@{$bits{rv2gv}}{6,5,4,2,0} = ('OPpALLOW_FAKE', $bf[7], $bf[7], 'OPpDONT_INIT_GV', $bf[0]); $bits{rv2hv}{0} = $bf[0]; -@{$bits{rv2sv}}{5,4,0} = ($bf[6], $bf[6], $bf[0]); +@{$bits{rv2sv}}{5,4,0} = ($bf[7], $bf[7], $bf[0]); @{$bits{sassign}}{7,6,1,0} = ('OPpASSIGN_CV_TO_GV', 'OPpASSIGN_BACKWARDS', $bf[1], $bf[1]); @{$bits{sbit_and}}{1,0} = ($bf[1], $bf[1]); @{$bits{sbit_or}}{1,0} = ($bf[1], $bf[1]); @@ -486,76 +492,76 @@ $bits{schomp}{0} = $bf[0]; $bits{schop}{0} = $bf[0]; @{$bits{scmp}}{1,0} = ($bf[1], $bf[1]); $bits{scomplement}{0} = $bf[0]; -@{$bits{seek}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{seekdir}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{select}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{semctl}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{semget}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{semop}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{send}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{seek}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{seekdir}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{select}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{semctl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{semget}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{semop}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{send}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{seq}}{1,0} = ($bf[1], $bf[1]); -@{$bits{setpgrp}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{setpriority}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{setpgrp}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{setpriority}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{sge}}{1,0} = ($bf[1], $bf[1]); @{$bits{sgt}}{1,0} = ($bf[1], $bf[1]); $bits{shift}{0} = $bf[0]; -@{$bits{shmctl}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{shmget}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{shmread}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{shmwrite}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{shmctl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{shmget}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{shmread}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{shmwrite}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{shostent}{0} = $bf[0]; -@{$bits{shutdown}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{shutdown}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{sin}{0} = $bf[0]; @{$bits{sle}}{1,0} = ($bf[1], $bf[1]); -@{$bits{sleep}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{sleep}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{slt}}{1,0} = ($bf[1], $bf[1]); @{$bits{smartmatch}}{1,0} = ($bf[1], $bf[1]); @{$bits{sne}}{1,0} = ($bf[1], $bf[1]); $bits{snetent}{0} = $bf[0]; -@{$bits{socket}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{sockpair}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{socket}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{sockpair}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{sort}}{6,5,4,3,2,1,0} = ('OPpSORT_STABLE', 'OPpSORT_QSORT', 'OPpSORT_DESCEND', 'OPpSORT_INPLACE', 'OPpSORT_REVERSE', 'OPpSORT_INTEGER', 'OPpSORT_NUMERIC'); -@{$bits{splice}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{splice}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{split}{7} = 'OPpSPLIT_IMPLIM'; -@{$bits{sprintf}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{sprintf}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{sprotoent}{0} = $bf[0]; $bits{sqrt}{0} = $bf[0]; -@{$bits{srand}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{srand}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{srefgen}{0} = $bf[0]; -@{$bits{sselect}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{sselect}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{sservent}{0} = $bf[0]; -@{$bits{ssockopt}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{ssockopt}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{stat}{0} = $bf[0]; -@{$bits{stringify}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{stringify}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{study}{0} = $bf[0]; $bits{substcont}{0} = $bf[0]; -@{$bits{substr}}{4,2,1,0} = ('OPpSUBSTR_REPL_FIRST', $bf[2], $bf[2], $bf[2]); +@{$bits{substr}}{4,2,1,0} = ('OPpSUBSTR_REPL_FIRST', $bf[3], $bf[3], $bf[3]); @{$bits{subtract}}{1,0} = ($bf[1], $bf[1]); -@{$bits{symlink}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{syscall}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{sysopen}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{sysread}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{sysseek}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{system}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{syswrite}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{tell}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{symlink}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{syscall}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{sysopen}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{sysread}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{sysseek}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{system}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{syswrite}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{tell}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{telldir}{0} = $bf[0]; -@{$bits{tie}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{tie}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{tied}{0} = $bf[0]; -@{$bits{truncate}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{truncate}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{uc}{0} = $bf[0]; $bits{ucfirst}{0} = $bf[0]; -@{$bits{umask}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{umask}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{undef}{0} = $bf[0]; -@{$bits{unlink}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{unpack}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{unshift}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{unlink}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{unpack}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{unshift}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{untie}{0} = $bf[0]; -@{$bits{utime}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{utime}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{values}{0} = $bf[0]; @{$bits{vec}}{1,0} = ($bf[1], $bf[1]); -@{$bits{waitpid}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{warn}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{waitpid}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{warn}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{xor}}{1,0} = ($bf[1], $bf[1]); @@ -772,7 +778,7 @@ our %ops_using = ( OPpLVAL_DEFER => [qw(aelem helem multideref)], OPpLVAL_INTRO => [qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list lvavref lvref lvrefslice multideref padav padhv padrange padsv pushmark refassign rv2av rv2gv rv2hv rv2sv)], OPpLVREF_ELEM => [qw(lvref refassign)], - OPpMAYBE_LVSUB => [qw(aassign aelem aslice av2arylen helem hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv substr vec)], + OPpMAYBE_LVSUB => [qw(aassign aelem akeys aslice av2arylen avhvswitch helem hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv substr vec)], OPpMAYBE_TRUEBOOL => [qw(padhv rv2hv)], OPpMULTIDEREF_DELETE => [qw(multideref)], OPpOFFBYONE => [qw(caller runcv wantarray)], diff --git a/lib/CORE.pod b/lib/CORE.pod index ce5feb5..e40b2d0 100644 --- a/lib/CORE.pod +++ b/lib/CORE.pod @@ -49,10 +49,8 @@ ampersand syntax and through references does not work for the following functions, as they have special syntax that cannot always be translated into a simple list (e.g., C vs C): -C, C, C, C, C, C, -C, C, C, C, C, C, C, -C, C, C, C, C, C, -C, C, C +C, C, C, C, C, C, C, +C, C, C, C, C, C, C =head1 OVERRIDING CORE FUNCTIONS diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm index 842bd31..47e6429 100644 --- a/lib/File/Copy.pm +++ b/lib/File/Copy.pm @@ -22,7 +22,7 @@ sub syscopy; sub cp; sub mv; -$VERSION = '2.31'; +$VERSION = '2.32'; require Exporter; @ISA = qw(Exporter); @@ -479,6 +479,11 @@ from the input filespec, then all timestamps other than the revision date are propagated. If this parameter is not supplied, it defaults to 0. +C is VMS specific and cannot be exported; it must be +referenced by its full name, e.g.: + + File::Copy::rmscopy($from, $to) or die $!; + Like C, C returns 1 on success. If an error occurs, it sets C<$!>, deletes the output file, and returns 0. diff --git a/lib/FileHandle.pm b/lib/FileHandle.pm index 6b3636a..133221b 100644 --- a/lib/FileHandle.pm +++ b/lib/FileHandle.pm @@ -4,7 +4,7 @@ use 5.006; use strict; our($VERSION, @ISA, @EXPORT, @EXPORT_OK); -$VERSION = "2.02"; +$VERSION = "2.03"; require IO::File; @ISA = qw(IO::File); @@ -36,7 +36,7 @@ require IO::File; # # Everything we're willing to export, we must first import. # -import IO::Handle grep { !defined(&$_) } @EXPORT, @EXPORT_OK; +IO::Handle->import( grep { !defined(&$_) } @EXPORT, @EXPORT_OK ); # # Some people call "FileHandle::function", so all the functions @@ -88,8 +88,8 @@ sub import { # sub pipe { - my $r = new IO::Handle; - my $w = new IO::Handle; + my $r = IO::Handle->new; + my $w = IO::Handle->new; CORE::pipe($r, $w) or return undef; ($r, $w); } diff --git a/lib/Unicode/UCD.pm b/lib/Unicode/UCD.pm index 13c2c78..f48e4ca 100644 --- a/lib/Unicode/UCD.pm +++ b/lib/Unicode/UCD.pm @@ -5,7 +5,7 @@ use warnings; no warnings 'surrogate'; # surrogates can be inputs to this use charnames (); -our $VERSION = '0.64'; +our $VERSION = '0.65'; require Exporter; @@ -128,7 +128,8 @@ Examples: 223 # Decimal 223 in native character set 0223 # Hexadecimal 223, native (= 547 decimal) - 0xDF # Hexadecimal DF, native (= 223 decimal + 0xDF # Hexadecimal DF, native (= 223 decimal) + '0xDF' # String form of hexadecimal (= 223 decimal) 'U+DF' # Hexadecimal DF, in Unicode's character set (= LATIN SMALL LETTER SHARP S) diff --git a/lib/Unicode/UCD.t b/lib/Unicode/UCD.t index 83320d3..8f8e551 100644 --- a/lib/Unicode/UCD.t +++ b/lib/Unicode/UCD.t @@ -1415,9 +1415,14 @@ sub fail_with_diff ($$$$) { # For use below to output better messages my ($prop, $official, $constructed, $tested_function_name) = @_; - is($constructed, $official, "$tested_function_name('$prop')"); - diag("Comment out lines " . (__LINE__ - 1) . " through " . (__LINE__ + 1) . " in '$0' on Un*x-like systems to see just the differences. Uses the 'diff' first in your \$PATH"); - return; + if (! $ENV{PERL_DIFF_TOOL}) { + + is($constructed, $official, "$tested_function_name('$prop')"); + + diag("Set environment variable PERL_DIFF_TOOL=diff_tool to see just " + . "the differences."); + return; + } fail("$tested_function_name('$prop')"); @@ -1434,7 +1439,7 @@ sub fail_with_diff ($$$$) { close $gend || die "Can't close gend"; my $diff = File::Temp->new(); - system("diff $off $gend > $diff"); + system("$ENV{PERL_DIFF_TOOL} $off $gend > $diff"); open my $fh, "<", $diff || die "Can't open $diff"; my @diffs = <$fh>; diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm index 40c6748..731b1a0 100644 --- a/lib/diagnostics.pm +++ b/lib/diagnostics.pm @@ -186,7 +186,7 @@ use 5.009001; use Carp; $Carp::Internal{__PACKAGE__.""}++; -our $VERSION = '1.34'; +our $VERSION = '1.35'; our $DEBUG; our $VERBOSE; our $PRETTY; @@ -310,6 +310,7 @@ sub transmo { EOFUNC my %msg; +my $over_level = 0; # We look only at =item lines at the first =over level { print STDERR "FINISHING COMPILATION for $_\n" if $DEBUG; local $/ = ''; @@ -386,7 +387,7 @@ my %msg; push @headers, $header if defined $header; } - unless ( s/=item (.*?)\s*\z//s) { + if ( ! s/=item (.*?)\s*\z//s || $over_level != 1) { if ( s/=head1\sDESCRIPTION//) { $msg{$header = 'DESCRIPTION'} = ''; @@ -395,11 +396,17 @@ my %msg; elsif( s/^=for\s+diagnostics\s*\n(.*?)\s*\z// ) { $for_item = $1; } - elsif( /^=back/ ) { # Stop processing body here - undef $header; - undef $for_item; - $seen_body = 0; - next; + elsif( /^=over\b/ ) { + $over_level++; + } + elsif( /^=back\b/ ) { # Stop processing body here + $over_level--; + if ($over_level == 0) { + undef $header; + undef $for_item; + $seen_body = 0; + next; + } } next; } diff --git a/lib/diagnostics.t b/lib/diagnostics.t index 0b35d16..6521df2 100644 --- a/lib/diagnostics.t +++ b/lib/diagnostics.t @@ -4,7 +4,7 @@ BEGIN { chdir '..' if -d '../pod' && -d '../t'; @INC = 'lib'; require './t/test.pl'; - plan(29); + plan(31); } BEGIN { @@ -144,17 +144,30 @@ like $warning, { # Find last warning in perldiag.pod, and last items if any my $lw; + my $over_level = 0; my $inlast; my $item; + my $items_not_in_overs = 0; open(my $f, '<', "pod/perldiag.pod") or die "failed to open pod/perldiag.pod for reading: $!"; while (<$f>) { - if ( /^=item\s+(.*)/) { - $lw = $1; - } elsif (/^=back/) { - $inlast = 1; + + # We only look for entries (=item lines) in the first level of =overs + + if ( /^=over\b/) { + $over_level++; + } elsif ( /^=item\s+(.*)/) { + if ($over_level < 1) { + $items_not_in_overs++; + } + elsif ($over_level == 1) { + $lw = $1; + } + } elsif (/^=back\b/) { + $inlast = 1 if $over_level == 1; + $over_level--; } elsif ($inlast) { # Skip headings next if /^=/; @@ -174,6 +187,8 @@ like $warning, } close($f); + is($over_level, 0, "(sanity...) =over balanced with =back (off by $over_level)"); + is($items_not_in_overs, 0, "(sanity...) all =item lines are within =over..=back blocks"); ok($item, "(sanity...) found an item to check with ($item)"); seek STDERR, 0,0; $warning = ''; diff --git a/lib/feature.pm b/lib/feature.pm index ede1022..caa7326 100644 --- a/lib/feature.pm +++ b/lib/feature.pm @@ -5,7 +5,7 @@ package feature; -our $VERSION = '1.43'; +our $VERSION = '1.44'; our %feature = ( fc => 'feature_fc', @@ -14,12 +14,10 @@ our %feature = ( switch => 'feature_switch', bitwise => 'feature_bitwise', evalbytes => 'feature_evalbytes', - postderef => 'feature_postderef', array_base => 'feature_arybase', signatures => 'feature_signatures', current_sub => 'feature___SUB__', refaliasing => 'feature_refaliasing', - lexical_subs => 'feature_lexsubs', postderef_qq => 'feature_postderef_qq', unicode_eval => 'feature_unieval', unicode_strings => 'feature_unicode', @@ -30,7 +28,7 @@ our %feature_bundle = ( "5.11" => [qw(array_base say state switch unicode_strings)], "5.15" => [qw(current_sub evalbytes fc say state switch unicode_eval unicode_strings)], "5.23" => [qw(current_sub evalbytes fc postderef_qq say state switch unicode_eval unicode_strings)], - "all" => [qw(array_base bitwise current_sub evalbytes fc lexical_subs postderef postderef_qq refaliasing say signatures state switch unicode_eval unicode_strings)], + "all" => [qw(array_base bitwise current_sub evalbytes fc postderef_qq refaliasing say signatures state switch unicode_eval unicode_strings)], "default" => [qw(array_base)], ); @@ -48,6 +46,10 @@ $feature_bundle{"5.24"} = $feature_bundle{"5.23"}; $feature_bundle{"5.25"} = $feature_bundle{"5.23"}; $feature_bundle{"5.26"} = $feature_bundle{"5.23"}; $feature_bundle{"5.9.5"} = $feature_bundle{"5.10"}; +my %noops = ( + postderef => 1, + lexical_subs => 1, +); our $hint_shift = 26; our $hint_mask = 0x1c000000; @@ -248,17 +250,21 @@ This feature is available from Perl 5.16 onwards. =head2 The 'lexical_subs' feature -B: This feature is still experimental and the implementation may -change in future versions of Perl. For this reason, Perl will -warn when you use the feature, unless you have explicitly disabled the -warning: +In Perl versions prior to 5.26, this feature enabled +declaration of subroutines via C, C +and C syntax. See L for details. - no warnings "experimental::lexical_subs"; +This feature is available from Perl 5.18 onwards. From Perl 5.18 to 5.24, +it was classed as experimental, and Perl emitted a warning for its +usage, except when explicitly disabled: -This enables declaration of subroutines via C, C -and C syntax. See L for details. + no warnings "experimental::lexical_subs"; -This feature is available from Perl 5.18 onwards. +As of Perl 5.26, use of this feature no longer triggers a warning, though +the C warning category still exists (for +compatibility with code that disables it). In addition, this syntax is +not only no longer experimental, but it is enabled for all Perl code, +regardless of what feature declarations are in scope. =head2 The 'postderef' and 'postderef_qq' features @@ -493,6 +499,9 @@ sub __common { next; } if (!exists $feature{$name}) { + if (exists $noops{$name}) { + next; + } unknown_feature($name); } if ($import) { diff --git a/lib/locale.t b/lib/locale.t index dc31b46..9afa9a4 100644 --- a/lib/locale.t +++ b/lib/locale.t @@ -900,12 +900,12 @@ sub disp_str ($) { sub report_result { my ($Locale, $i, $pass_fail, $message) = @_; - $message //= ""; - $message = " ($message)" if $message; if ($pass_fail) { push @{$Okay{$i}}, $Locale; } else { + $message //= ""; + $message = " ($message)" if $message; $Known_bad_locale{$i}{$Locale} = 1 if exists $known_bad_locales{$^O} && $Locale =~ $known_bad_locales{$^O}; $Problem{$i}{$Locale} = 1; @@ -1735,6 +1735,83 @@ foreach my $Locale (@Locale) { last; } } + + use locale; + + ++$locales_test_number; + $test_names{$locales_test_number} + = 'Skip in locales where \001 has primary sorting weight; ' + . 'otherwise verify that \0 doesn\'t have primary sorting weight'; + if ("a\001c" lt "ab") { + report_result($Locale, $locales_test_number, 1); + } + else { + my $ok = "ab" lt "a\0c"; + report_result($Locale, $locales_test_number, $ok); + } + + ++$locales_test_number; + $test_names{$locales_test_number} + = 'Verify that strings with embedded NUL collate'; + my $ok = "a\0a\0a" lt "a\001a\001a"; + report_result($Locale, $locales_test_number, $ok); + + ++$locales_test_number; + $test_names{$locales_test_number} + = 'Verify that strings with embedded NUL and ' + . 'extra trailing NUL collate'; + $ok = "a\0a\0" lt "a\001a\001"; + report_result($Locale, $locales_test_number, $ok); + + ++$locales_test_number; + $test_names{$locales_test_number} + = "Skip in non-UTF-8 locales; otherwise verify that UTF8ness " + . "doesn't matter with collation"; + if (! $is_utf8_locale) { + report_result($Locale, $locales_test_number, 1); + } + else { + + # khw can't think of anything better. Start with a string that is + # higher than its UTF-8 representation in both EBCDIC and ASCII + my $string = chr utf8::unicode_to_native(0xff); + my $utf8_string = $string; + utf8::upgrade($utf8_string); + + # 8 should be lt 9 in all locales (except ones that aren't + # ASCII-based, which might fail this) + $ok = ("a${string}8") lt ("a${utf8_string}9"); + report_result($Locale, $locales_test_number, $ok); + } + + ++$locales_test_number; + $test_names{$locales_test_number} + = "Skip in UTF-8 locales; otherwise verify that single byte " + . "collates before 0x100 and above"; + if ($is_utf8_locale) { + report_result($Locale, $locales_test_number, 1); + } + else { + my $max_collating = chr 0; # Find byte that collates highest + for my $i (0 .. 255) { + my $char = chr $i; + $max_collating = $char if $char gt $max_collating; + } + $ok = $max_collating lt chr 0x100; + report_result($Locale, $locales_test_number, $ok); + } + + ++$locales_test_number; + $test_names{$locales_test_number} + = "Skip in UTF-8 locales; otherwise verify that 0x100 and " + . "above collate in code point order"; + if ($is_utf8_locale) { + report_result($Locale, $locales_test_number, 1); + } + else { + $ok = chr 0x100 lt chr 0x101; + report_result($Locale, $locales_test_number, $ok); + } } my $ok1; diff --git a/locale.c b/locale.c index 0bf8057..141def9 100644 --- a/locale.c +++ b/locale.c @@ -44,6 +44,20 @@ #include "reentr.h" +/* If the environment says to, we can output debugging information during + * initialization. This is done before option parsing, and before any thread + * creation, so can be a file-level static */ +#ifdef DEBUGGING +# ifdef PERL_GLOBAL_STRUCT + /* no global syms allowed */ +# define debug_initialization 0 +# define DEBUG_INITIALIZATION_set(v) +# else +static bool debug_initialization = FALSE; +# define DEBUG_INITIALIZATION_set(v) (debug_initialization = v) +# endif +#endif + #ifdef USE_LOCALE /* @@ -119,13 +133,17 @@ Perl_set_numeric_radix(pTHX) else PL_numeric_radix_sv = NULL; - DEBUG_L(PerlIO_printf(Perl_debug_log, "Locale radix is '%s', ?UTF-8=%d\n", +#ifdef DEBUGGING + if (DEBUG_L_TEST || debug_initialization) { + PerlIO_printf(Perl_debug_log, "Locale radix is '%s', ?UTF-8=%d\n", (PL_numeric_radix_sv) ? SvPVX(PL_numeric_radix_sv) : "NULL", (PL_numeric_radix_sv) ? cBOOL(SvUTF8(PL_numeric_radix_sv)) - : 0)); + : 0); + } +#endif # endif /* HAS_LOCALECONV */ #endif /* USE_LOCALE_NUMERIC */ @@ -230,8 +248,12 @@ Perl_set_numeric_standard(pTHX) PL_numeric_standard = TRUE; PL_numeric_local = isNAME_C_OR_POSIX(PL_numeric_name); set_numeric_radix(); - DEBUG_L(PerlIO_printf(Perl_debug_log, - "Underlying LC_NUMERIC locale now is C\n")); +#ifdef DEBUGGING + if (DEBUG_L_TEST || debug_initialization) { + PerlIO_printf(Perl_debug_log, + "Underlying LC_NUMERIC locale now is C\n"); + } +#endif #endif /* USE_LOCALE_NUMERIC */ } @@ -250,9 +272,13 @@ Perl_set_numeric_local(pTHX) PL_numeric_standard = isNAME_C_OR_POSIX(PL_numeric_name); PL_numeric_local = TRUE; set_numeric_radix(); - DEBUG_L(PerlIO_printf(Perl_debug_log, +#ifdef DEBUGGING + if (DEBUG_L_TEST || debug_initialization) { + PerlIO_printf(Perl_debug_log, "Underlying LC_NUMERIC locale now is %s\n", - PL_numeric_name)); + PL_numeric_name); + } +#endif #endif /* USE_LOCALE_NUMERIC */ } @@ -482,8 +508,12 @@ Perl_new_collate(pTHX_ const char *newcoll) PL_collation_name = NULL; } PL_collation_standard = TRUE; + is_standard_collation: PL_collxfrm_base = 0; PL_collxfrm_mult = 2; + PL_in_utf8_COLLATE_locale = FALSE; + *PL_strxfrm_min_char = '\0'; + PL_strxfrm_max_cp = 0; return; } @@ -493,46 +523,169 @@ Perl_new_collate(pTHX_ const char *newcoll) Safefree(PL_collation_name); PL_collation_name = stdize_locale(savepv(newcoll)); PL_collation_standard = isNAME_C_OR_POSIX(newcoll); + if (PL_collation_standard) { + goto is_standard_collation; + } + + PL_in_utf8_COLLATE_locale = _is_cur_LC_category_utf8(LC_COLLATE); + *PL_strxfrm_min_char = '\0'; + PL_strxfrm_max_cp = 0; + + /* A locale collation definition includes primary, secondary, tertiary, + * etc. weights for each character. To sort, the primary weights are + * used, and only if they compare equal, then the secondary weights are + * used, and only if they compare equal, then the tertiary, etc. + * + * strxfrm() works by taking the input string, say ABC, and creating an + * output transformed string consisting of first the primary weights, + * A¹B¹C¹ followed by the secondary ones, A²B²C²; and then the + * tertiary, etc, yielding A¹B¹C¹ A²B²C² A³B³C³ .... Some characters + * may not have weights at every level. In our example, let's say B + * doesn't have a tertiary weight, and A doesn't have a secondary + * weight. The constructed string is then going to be + * A¹B¹C¹ B²C² A³C³ .... + * This has the desired effect that strcmp() will look at the secondary + * or tertiary weights only if the strings compare equal at all higher + * priority weights. The spaces shown here, like in + * "A¹B¹C¹ * A²B²C² " + * are not just for readability. In the general case, these must + * actually be bytes, which we will call here 'separator weights'; and + * they must be smaller than any other weight value, but since these + * are C strings, only the terminating one can be a NUL (some + * implementations may include a non-NUL separator weight just before + * the NUL). Implementations tend to reserve 01 for the separator + * weights. They are needed so that a shorter string's secondary + * weights won't be misconstrued as primary weights of a longer string, + * etc. By making them smaller than any other weight, the shorter + * string will sort first. (Actually, if all secondary weights are + * smaller than all primary ones, there is no need for a separator + * weight between those two levels, etc.) + * + * The length of the transformed string is roughly a linear function of + * the input string. It's not exactly linear because some characters + * don't have weights at all levels. When we call strxfrm() we have to + * allocate some memory to hold the transformed string. The + * calculations below try to find coefficients 'm' and 'b' for this + * locale so that m*x + b equals how much space we need, given the size + * of the input string in 'x'. If we calculate too small, we increase + * the size as needed, and call strxfrm() again, but it is better to + * get it right the first time to avoid wasted expensive string + * transformations. */ { - /* A locale collation definition includes primary, secondary, - * tertiary, etc. weights for each character. To sort, the primary - * weights are used, and only if they compare equal, then the - * secondary weights are used, and only if they compare equal, then - * the tertiary, etc. strxfrm() works by taking the input string, - * say ABC, and creating an output string consisting of first the - * primary weights, A¹B¹C¹ followed by the secondary ones, A²B²C²; - * and then the tertiary, etc, yielding A¹B¹C¹A²B²C²A³B³C³.... - * Some characters may not have weights at every level. In our - * example, let's say B doesn't have a tertiary weight, and A - * doesn't have a secondary weight. The constructed string is then - * going to be A¹B¹C¹B²C²A³C³.... This has the desired - * characteristics that strcmp() will look at the secondary or - * tertiary weights only if the strings compare equal at all higher - * priority weights. The length of the transformed string is - * roughly a linear function of the input string. It's not exactly - * linear because some characters don't have weights at all levels, - * and there are some complications, so there is often per-string - * overhead. When we call strxfrm() we have to allocate some - * memory to hold the transformed string. The calculations below - * try to find constants for this locale 'm' and 'b' so that m*x + - * b equals how much space we need given the size of the input - * string in 'x'. If we calculate too small, we increase the size - * as needed, and call strxfrm() again, but it is better to get it - * right the first time to avoid wasted expensive string - * transformations. */ - /* 2: at most so many chars ('a', 'b'). */ - /* 50: surely no system expands a char more. */ -#define XFRMBUFSIZE (2 * 50) - char xbuf[XFRMBUFSIZE]; - const Size_t fa = strxfrm(xbuf, "a", XFRMBUFSIZE); - const Size_t fb = strxfrm(xbuf, "ab", XFRMBUFSIZE); - const SSize_t mult = fb - fa; - if (mult < 1 && !(fa == 0 && fb == 0)) - Perl_croak(aTHX_ "panic: strxfrm() gets absurd - a => %"UVuf", ab => %"UVuf, - (UV) fa, (UV) fb); - PL_collxfrm_base = (fa > (Size_t)mult) ? (fa - mult) : 0; - PL_collxfrm_mult = mult; + /* We use the string below to find how long the tranformation of it + * is. Almost all locales are supersets of ASCII, or at least the + * ASCII letters. We use all of them, half upper half lower, + * because if we used fewer, we might hit just the ones that are + * outliers in a particular locale. Most of the strings being + * collated will contain a preponderance of letters, and even if + * they are above-ASCII, they are likely to have the same number of + * weight levels as the ASCII ones. It turns out that digits tend + * to have fewer levels, and some punctuation has more, but those + * are relatively sparse in text, and khw believes this gives a + * reasonable result, but it could be changed if experience so + * dictates. */ + const char longer[] = "ABCDEFGHIJKLMnopqrstuvwxyz"; + char * x_longer; /* Transformed 'longer' */ + Size_t x_len_longer; /* Length of 'x_longer' */ + + char * x_shorter; /* We also transform a substring of 'longer' */ + Size_t x_len_shorter; + + /* _mem_collxfrm() is used get the transformation (though here we + * are interested only in its length). It is used because it has + * the intelligence to handle all cases, but to work, it needs some + * values of 'm' and 'b' to get it started. For the purposes of + * this calculation we use a very conservative estimate of 'm' and + * 'b'. This assumes a weight can be multiple bytes, enough to + * hold any UV on the platform, and there are 5 levels, 4 weight + * bytes, and a trailing NUL. */ + PL_collxfrm_base = 5; + PL_collxfrm_mult = 5 * sizeof(UV); + + /* Find out how long the transformation really is */ + x_longer = _mem_collxfrm(longer, + sizeof(longer) - 1, + &x_len_longer, + + /* We avoid converting to UTF-8 in the + * called function by telling it the + * string is in UTF-8 if the locale is a + * UTF-8 one. Since the string passed + * here is invariant under UTF-8, we can + * claim it's UTF-8 even though it isn't. + * */ + PL_in_utf8_COLLATE_locale); + Safefree(x_longer); + + /* Find out how long the transformation of a substring of 'longer' + * is. Together the lengths of these transformations are + * sufficient to calculate 'm' and 'b'. The substring is all of + * 'longer' except the first character. This minimizes the chances + * of being swayed by outliers */ + x_shorter = _mem_collxfrm(longer + 1, + sizeof(longer) - 2, + &x_len_shorter, + PL_in_utf8_COLLATE_locale); + Safefree(x_shorter); + + /* If the results are nonsensical for this simple test, the whole + * locale definition is suspect. Mark it so that locale collation + * is not active at all for it. XXX Should we warn? */ + if ( x_len_shorter == 0 + || x_len_longer == 0 + || x_len_shorter >= x_len_longer) + { + PL_collxfrm_mult = 0; + PL_collxfrm_base = 0; + } + else { + SSize_t base; /* Temporary */ + + /* We have both: m * strlen(longer) + b = x_len_longer + * m * strlen(shorter) + b = x_len_shorter; + * subtracting yields: + * m * (strlen(longer) - strlen(shorter)) + * = x_len_longer - x_len_shorter + * But we have set things up so that 'shorter' is 1 byte smaller + * than 'longer'. Hence: + * m = x_len_longer - x_len_shorter + * + * But if something went wrong, make sure the multiplier is at + * least 1. + */ + if (x_len_longer > x_len_shorter) { + PL_collxfrm_mult = (STRLEN) x_len_longer - x_len_shorter; + } + else { + PL_collxfrm_mult = 1; + } + + /* mx + b = len + * so: b = len - mx + * but in case something has gone wrong, make sure it is + * non-negative */ + base = x_len_longer - PL_collxfrm_mult * (sizeof(longer) - 1); + if (base < 0) { + base = 0; + } + + /* Add 1 for the trailing NUL */ + PL_collxfrm_base = base + 1; + } + +#ifdef DEBUGGING + if (DEBUG_L_TEST || debug_initialization) { + PerlIO_printf(Perl_debug_log, + "%s:%d: ?UTF-8 locale=%d; x_len_shorter=%"UVuf", " + "x_len_longer=%"UVuf"," + " collate multipler=%"UVuf", collate base=%"UVuf"\n", + __FILE__, __LINE__, + PL_in_utf8_COLLATE_locale, + x_len_shorter, x_len_longer, + PL_collxfrm_mult, PL_collxfrm_base); + } +#endif } } @@ -770,24 +923,6 @@ Perl_init_i18nl10n(pTHX_ int printwarn) const char * const setlocale_init = (PerlEnv_getenv("PERL_SKIP_LOCALE_INIT")) ? NULL : ""; -#ifdef DEBUGGING - const bool debug = (PerlEnv_getenv("PERL_DEBUG_LOCALE_INIT")) - ? TRUE - : FALSE; -# define DEBUG_LOCALE_INIT(category, locale, result) \ - STMT_START { \ - if (debug) { \ - PerlIO_printf(Perl_debug_log, \ - "%s:%d: %s\n", \ - __FILE__, __LINE__, \ - _setlocale_debug_string(category, \ - locale, \ - result)); \ - } \ - } STMT_END -#else -# define DEBUG_LOCALE_INIT(a,b,c) -#endif const char* trial_locales[5]; /* 5 = 1 each for "", LC_ALL, LANG, "", C */ unsigned int trial_locales_count; const char * const lc_all = savepv(PerlEnv_getenv("LC_ALL")); @@ -818,6 +953,25 @@ Perl_init_i18nl10n(pTHX_ int printwarn) const char *system_default_locale = NULL; #endif +#ifdef DEBUGGING + DEBUG_INITIALIZATION_set((PerlEnv_getenv("PERL_DEBUG_LOCALE_INIT")) + ? TRUE + : FALSE); +# define DEBUG_LOCALE_INIT(category, locale, result) \ + STMT_START { \ + if (debug_initialization) { \ + PerlIO_printf(Perl_debug_log, \ + "%s:%d: %s\n", \ + __FILE__, __LINE__, \ + _setlocale_debug_string(category, \ + locale, \ + result)); \ + } \ + } STMT_END +#else +# define DEBUG_LOCALE_INIT(a,b,c) +#endif + #ifndef LOCALE_ENVIRON_REQUIRED PERL_UNUSED_VAR(done); PERL_UNUSED_VAR(locale_param); @@ -1256,82 +1410,498 @@ Perl_init_i18nl10n(pTHX_ int printwarn) PERL_UNUSED_ARG(printwarn); #endif /* USE_LOCALE */ +#ifdef DEBUGGING + /* So won't continue to output stuff */ + DEBUG_INITIALIZATION_set(FALSE); +#endif + return ok; } - #ifdef USE_LOCALE_COLLATE -/* - * mem_collxfrm() is a bit like strxfrm() but with two important - * differences. First, it handles embedded NULs. Second, it allocates - * a bit more memory than needed for the transformed data itself. - * The real transformed data begins at offset sizeof(collationix). - * *xlen is set to the length of that, and doesn't include the collation index - * size. - * Please see sv_collxfrm() to see how this is used. - */ - char * -Perl_mem_collxfrm(pTHX_ const char *s, STRLEN len, STRLEN *xlen) +Perl__mem_collxfrm(pTHX_ const char *input_string, + STRLEN len, /* Length of 'input_string' */ + STRLEN *xlen, /* Set to length of returned string + (not including the collation index + prefix) */ + bool utf8 /* Is the input in UTF-8? */ + ) { - char *xbuf; - STRLEN xAlloc, xin, xout; /* xalloc is a reserved word in VC */ - PERL_ARGS_ASSERT_MEM_COLLXFRM; + /* _mem_collxfrm() is a bit like strxfrm() but with two important + * differences. First, it handles embedded NULs. Second, it allocates a bit + * more memory than needed for the transformed data itself. The real + * transformed data begins at offset COLLXFRM_HDR_LEN. *xlen is set to + * the length of that, and doesn't include the collation index size. + * Please see sv_collxfrm() to see how this is used. */ + +#define COLLXFRM_HDR_LEN sizeof(PL_collation_ix) + + char * s = (char *) input_string; + STRLEN s_strlen = strlen(input_string); + char *xbuf = NULL; + STRLEN xAlloc; /* xalloc is a reserved word in VC */ + STRLEN length_in_chars; + bool first_time = TRUE; /* Cleared after first loop iteration */ + + PERL_ARGS_ASSERT__MEM_COLLXFRM; + + /* Must be NUL-terminated */ + assert(*(input_string + len) == '\0'); + + /* If this locale has defective collation, skip */ + if (PL_collxfrm_base == 0 && PL_collxfrm_mult == 0) { + goto bad; + } + + /* Replace any embedded NULs with the control that sorts before any others. + * This will give as good as possible results on strings that don't + * otherwise contain that character, but otherwise there may be + * less-than-perfect results with that character and NUL. This is + * unavoidable unless we replace strxfrm with our own implementation. + * + * XXX This code may be overkill. khw wrote it before realizing that if + * you change a NUL into some other character, that that may change the + * strxfrm results if that character is part of a sequence with other + * characters for weight calculations. To minimize the chances of this, + * now the replacement is restricted to another control (likely to be + * \001). But the full generality has been retained. + * + * This is one of the few places in the perl core, where we can use + * standard functions like strlen() and strcat(). It's because we're + * looking for NULs. */ + if (s_strlen < len) { + char * e = s + len; + char * sans_nuls; + STRLEN cur_min_char_len; + + /* If we don't know what control character sorts lowest for this + * locale, find it */ + if (*PL_strxfrm_min_char == '\0') { + int j; +#ifdef DEBUGGING + U8 cur_min_cp = 1; /* The code point that sorts lowest, so far */ +#endif + char * cur_min_x = NULL; /* And its xfrm, (except it also + includes the collation index + prefixed. */ + + /* Look through all legal code points (NUL isn't) */ + for (j = 1; j < 256; j++) { + char * x; /* j's xfrm plus collation index */ + STRLEN x_len; /* length of 'x' */ + STRLEN trial_len = 1; + + /* Create a 1 byte string of the current code point, but with + * room to be 2 bytes */ + char cur_source[] = { (char) j, '\0' , '\0' }; + + if (PL_in_utf8_COLLATE_locale) { + if (! isCNTRL_L1(j)) { + continue; + } + + /* If needs to be 2 bytes, find them */ + if (! UVCHR_IS_INVARIANT(j)) { + char * d = cur_source; + append_utf8_from_native_byte((U8) j, (U8 **) &d); + trial_len = 2; + } + } + else if (! isCNTRL_LC(j)) { + continue; + } + + /* Then transform it */ + x = _mem_collxfrm(cur_source, trial_len, &x_len, + PL_in_utf8_COLLATE_locale); + + /* If something went wrong (which it shouldn't), just + * ignore this code point */ + if ( x_len == 0 + || strlen(x + COLLXFRM_HDR_LEN) < x_len) + { + continue; + } + + /* If this character's transformation is lower than + * the current lowest, this one becomes the lowest */ + if ( cur_min_x == NULL + || strLT(x + COLLXFRM_HDR_LEN, + cur_min_x + COLLXFRM_HDR_LEN)) + { + PL_strxfrm_min_char[0] = cur_source[0]; + PL_strxfrm_min_char[1] = cur_source[1]; + PL_strxfrm_min_char[2] = cur_source[2]; + cur_min_x = x; +#ifdef DEBUGGING + cur_min_cp = j; +#endif + } + else { + Safefree(x); + } + } /* end of loop through all bytes */ + + /* Unlikely, but possible, if there aren't any controls in the + * locale, arbitrarily use \001 */ + if (cur_min_x == NULL) { + STRLEN x_len; /* temporary */ + cur_min_x = _mem_collxfrm("\001", 1, &x_len, + PL_in_utf8_COLLATE_locale); + /* cur_min_cp was already initialized to 1 */ + } + + DEBUG_L(PerlIO_printf(Perl_debug_log, + "_mem_collxfrm: lowest collating control in the 0-255 " + "range in locale %s is 0x%02X\n", + PL_collation_name, + cur_min_cp)); + if (DEBUG_Lv_TEST) { + unsigned i; + PerlIO_printf(Perl_debug_log, "Its xfrm is"); + for (i = 0; i < strlen(cur_min_x + COLLXFRM_HDR_LEN); i ++) { + PerlIO_printf(Perl_debug_log, " %02x", + (U8) *(cur_min_x + COLLXFRM_HDR_LEN + i)); + } + PerlIO_printf(Perl_debug_log, "\n"); + } + + Safefree(cur_min_x); + } + + /* The worst case length for the replaced string would be if every + * character in it is NUL. Multiply that by the length of each + * replacement, and allow for a trailing NUL */ + cur_min_char_len = strlen(PL_strxfrm_min_char); + Newx(sans_nuls, (len * cur_min_char_len) + 1, char); + *sans_nuls = '\0'; + + + /* Replace each NUL with the lowest collating control. Loop until have + * exhausted all the NULs */ + while (s + s_strlen < e) { + strcat(sans_nuls, s); + + /* Do the actual replacement */ + strcat(sans_nuls, PL_strxfrm_min_char); + + /* Move past the input NUL */ + s += s_strlen + 1; + s_strlen = strlen(s); + } + + /* And add anything that trails the final NUL */ + strcat(sans_nuls, s); + + /* Switch so below we transform this modified string */ + s = sans_nuls; + len = strlen(s); + } - /* the first sizeof(collationix) bytes are used by sv_collxfrm(). */ - /* the +1 is for the terminating NUL. */ + /* Make sure the UTF8ness of the string and locale match */ + if (utf8 != PL_in_utf8_COLLATE_locale) { + const char * const t = s; /* Temporary so we can later find where the + input was */ - xAlloc = sizeof(PL_collation_ix) + PL_collxfrm_base + (PL_collxfrm_mult * len) + 1; + /* Here they don't match. Change the string's to be what the locale is + * expecting */ + + if (! utf8) { /* locale is UTF-8, but input isn't; upgrade the input */ + s = (char *) bytes_to_utf8((const U8 *) s, &len); + utf8 = TRUE; + } + else { /* locale is not UTF-8; but input is; downgrade the input */ + + s = (char *) bytes_from_utf8((const U8 *) s, &len, &utf8); + + /* If the downgrade was successful we are done, but if the input + * contains things that require UTF-8 to represent, have to do + * damage control ... */ + if (UNLIKELY(utf8)) { + + /* What we do is construct a non-UTF-8 string with + * 1) the characters representable by a single byte converted + * to be so (if necessary); + * 2) and the rest converted to collate the same as the + * highest collating representable character. That makes + * them collate at the end. This is similar to how we + * handle embedded NULs, but we use the highest collating + * code point instead of the smallest. Like the NUL case, + * this isn't perfect, but is the best we can reasonably + * do. Every above-255 code point will sort the same as + * the highest-sorting 0-255 code point. If that code + * point can combine in a sequence with some other code + * points for weight calculations, us changing something to + * be it can adversely affect the results. But in most + * cases, it should work reasonably. And note that this is + * really an illegal situation: using code points above 255 + * on a locale where only 0-255 are valid. If two strings + * sort entirely equal, then the sort order for the + * above-255 code points will be in code point order. */ + + utf8 = FALSE; + + /* If we haven't calculated the code point with the maximum + * collating order for this locale, do so now */ + if (! PL_strxfrm_max_cp) { + int j; + + /* The current transformed string that collates the + * highest (except it also includes the prefixed collation + * index. */ + char * cur_max_x = NULL; + + /* Look through all legal code points (NUL isn't) */ + for (j = 1; j < 256; j++) { + char * x; + STRLEN x_len; + + /* Create a 1-char string of the current code point. */ + char cur_source[] = { (char) j, '\0' }; + + /* Then transform it */ + x = _mem_collxfrm(cur_source, 1, &x_len, FALSE); + + /* If something went wrong (which it shouldn't), just + * ignore this code point */ + if (x_len == 0) { + Safefree(x); + continue; + } + + /* If this character's transformation is higher than + * the current highest, this one becomes the highest */ + if ( cur_max_x == NULL + || strGT(x + COLLXFRM_HDR_LEN, + cur_max_x + COLLXFRM_HDR_LEN)) + { + PL_strxfrm_max_cp = j; + cur_max_x = x; + } + else { + Safefree(x); + } + } + + DEBUG_L(PerlIO_printf(Perl_debug_log, + "_mem_collxfrm: highest 1-byte collating character" + " in locale %s is 0x%02X\n", + PL_collation_name, + PL_strxfrm_max_cp)); + if (DEBUG_Lv_TEST) { + unsigned i; + PerlIO_printf(Perl_debug_log, "Its xfrm is "); + for (i = 0; + i < strlen(cur_max_x + COLLXFRM_HDR_LEN); + i++) + { + PerlIO_printf(Perl_debug_log, " %02x", + (U8) cur_max_x[i + COLLXFRM_HDR_LEN]); + } + PerlIO_printf(Perl_debug_log, "\n"); + } + + Safefree(cur_max_x); + } + + /* Here we know which legal code point collates the highest. + * We are ready to construct the non-UTF-8 string. The length + * will be at least 1 byte smaller than the input string + * (because we changed at least one 2-byte character into a + * single byte), but that is eaten up by the trailing NUL */ + Newx(s, len, char); + + { + STRLEN i; + STRLEN d= 0; + + for (i = 0; i < len; i+= UTF8SKIP(t + i)) { + U8 cur_char = t[i]; + if (UTF8_IS_INVARIANT(cur_char)) { + s[d++] = cur_char; + } + else if (UTF8_IS_DOWNGRADEABLE_START(cur_char)) { + s[d++] = EIGHT_BIT_UTF8_TO_NATIVE(cur_char, t[i+1]); + } + else { /* Replace illegal cp with highest collating + one */ + s[d++] = PL_strxfrm_max_cp; + } + } + s[d++] = '\0'; + Renew(s, d, char); /* Free up unused space */ + } + } + } + + /* Here, we have constructed a modified version of the input. It could + * be that we already had a modified copy before we did this version. + * If so, that copy is no longer needed */ + if (t != input_string) { + Safefree(t); + } + } + + length_in_chars = (utf8) + ? utf8_length((U8 *) s, (U8 *) s + len) + : len; + + /* The first element in the output is the collation id, used by + * sv_collxfrm(); then comes the space for the transformed string. The + * equation should give us a good estimate as to how much is needed */ + xAlloc = COLLXFRM_HDR_LEN + + PL_collxfrm_base + + (PL_collxfrm_mult * length_in_chars); Newx(xbuf, xAlloc, char); if (UNLIKELY(! xbuf)) goto bad; /* Store the collation id */ *(U32*)xbuf = PL_collation_ix; - xout = sizeof(PL_collation_ix); /* Then the transformation of the input. We loop until successful, or we * give up */ - for (xin = 0; xin < len; ) { - Size_t xused; - - for (;;) { - xused = strxfrm(xbuf + xout, s + xin, xAlloc - xout); - - /* If the transformed string occupies less space than we told - * strxfrm() was available, it means it successfully transformed - * the whole string. */ - if ((STRLEN)xused < xAlloc - xout) - break; - - if (UNLIKELY(xused >= PERL_INT_MAX)) - goto bad; - - /* Otherwise it should be that the transformation stopped in the - * middle because it ran out of space. Malloc more, and try again. - * */ - xAlloc = (2 * xAlloc) + 1; - Renew(xbuf, xAlloc, char); - if (UNLIKELY(! xbuf)) - goto bad; - } + for (;;) { + *xlen = strxfrm(xbuf + COLLXFRM_HDR_LEN, s, xAlloc - COLLXFRM_HDR_LEN); + + /* If the transformed string occupies less space than we told strxfrm() + * was available, it means it successfully transformed the whole + * string. */ + if (*xlen < xAlloc - COLLXFRM_HDR_LEN) { + + /* If the first try didn't get it, it means our prediction was low. + * Modify the coefficients so that we predict a larger value in any + * future transformations */ + if (! first_time) { + STRLEN needed = *xlen + 1; /* +1 For trailing NUL */ + STRLEN computed_guess = PL_collxfrm_base + + (PL_collxfrm_mult * length_in_chars); + const STRLEN new_m = needed / length_in_chars; + + DEBUG_Lv(PerlIO_printf(Perl_debug_log, + "%s: %d: initial size of %"UVuf" bytes for a length " + "%"UVuf" string was insufficient, %"UVuf" needed\n", + __FILE__, __LINE__, + (UV) computed_guess, (UV) length_in_chars, (UV) needed)); + + /* If slope increased, use it, but discard this result for + * length 1 strings, as we can't be sure that it's a real slope + * change */ + if (length_in_chars > 1 && new_m > PL_collxfrm_mult) { +#ifdef DEBUGGING + STRLEN old_m = PL_collxfrm_mult; + STRLEN old_b = PL_collxfrm_base; +#endif + PL_collxfrm_mult = new_m; + PL_collxfrm_base = 1; /* +1 For trailing NUL */ + computed_guess = PL_collxfrm_base + + (PL_collxfrm_mult * length_in_chars); + if (computed_guess < needed) { + PL_collxfrm_base += needed - computed_guess; + } + + DEBUG_Lv(PerlIO_printf(Perl_debug_log, + "%s: %d: slope is now %"UVuf"; was %"UVuf", base " + "is now %"UVuf"; was %"UVuf"\n", + __FILE__, __LINE__, + (UV) PL_collxfrm_mult, (UV) old_m, + (UV) PL_collxfrm_base, (UV) old_b)); + } + else { /* Slope didn't change, but 'b' did */ + const STRLEN new_b = needed + - computed_guess + + PL_collxfrm_base; + DEBUG_Lv(PerlIO_printf(Perl_debug_log, + "%s: %d: base is now %"UVuf"; was %"UVuf"\n", + __FILE__, __LINE__, + (UV) new_b, (UV) PL_collxfrm_base)); + PL_collxfrm_base = new_b; + } + } + + break; + } - xin += strlen(s + xin) + 1; - xout += xused; + if (UNLIKELY(*xlen >= PERL_INT_MAX)) + goto bad; - /* Embedded NULs are understood but silently skipped - * because they make no sense in locale collation. */ + /* A well-behaved strxfrm() returns exactly how much space it needs + * (not including the trailing NUL) when it fails due to not enough + * space being provided. Assume that this is the case unless it's been + * proven otherwise */ + if (LIKELY(PL_strxfrm_is_behaved) && first_time) { + xAlloc = *xlen + COLLXFRM_HDR_LEN + 1; + } + else { /* Here, either: + * 1) The strxfrm() has previously shown bad behavior; or + * 2) It isn't the first time through the loop, which means + * that the strxfrm() is now showing bad behavior, because + * we gave it what it said was needed in the previous + * iteration, and it came back saying it needed still more. + * (Many versions of cygwin fit this. When the buffer size + * isn't sufficient, they return the input size instead of + * how much is needed.) + * Increase the buffer size by a fixed percentage and try again. */ + xAlloc += (xAlloc / 4) + 1; + PL_strxfrm_is_behaved = FALSE; + +#ifdef DEBUGGING + if (DEBUG_Lv_TEST || debug_initialization) { + PerlIO_printf(Perl_debug_log, + "_mem_collxfrm required more space than previously calculated" + " for locale %s, trying again with new guess=%d+%"UVuf"\n", + PL_collation_name, (int) COLLXFRM_HDR_LEN, + (UV) xAlloc - COLLXFRM_HDR_LEN); + } +#endif + } + + Renew(xbuf, xAlloc, char); + if (UNLIKELY(! xbuf)) + goto bad; + + first_time = FALSE; + } + + +#ifdef DEBUGGING + if (DEBUG_Lv_TEST || debug_initialization) { + unsigned i; + PerlIO_printf(Perl_debug_log, + "_mem_collxfrm[%d]: returning %"UVuf" for locale %s '%s'\n", + PL_collation_ix, *xlen, PL_collation_name, input_string); + PerlIO_printf(Perl_debug_log, "Its xfrm is"); + for (i = COLLXFRM_HDR_LEN; i < *xlen + COLLXFRM_HDR_LEN; i++) { + PerlIO_printf(Perl_debug_log, " %02x", (U8) xbuf[i]); + } + PerlIO_printf(Perl_debug_log, "\n"); + } +#endif + + /* Free up unneeded space; retain ehough for trailing NUL */ + Renew(xbuf, COLLXFRM_HDR_LEN + *xlen + 1, char); + + if (s != input_string) { + Safefree(s); } - xbuf[xout] = '\0'; - *xlen = xout - sizeof(PL_collation_ix); return xbuf; bad: Safefree(xbuf); + if (s != input_string) { + Safefree(s); + } *xlen = 0; +#ifdef DEBUGGING + if (DEBUG_Lv_TEST || debug_initialization) { + PerlIO_printf(Perl_debug_log, "_mem_collxfrm[%d] returning NULL\n", + PL_collation_ix); + } +#endif return NULL; } diff --git a/make_ext.pl b/make_ext.pl index 64263bd..8270092 100644 --- a/make_ext.pl +++ b/make_ext.pl @@ -699,20 +699,37 @@ sub just_pm_to_blib { } # This is running under miniperl, so no autodie if ($target eq 'all') { - local $ENV{PERL_INSTALL_QUIET} = 1; - require ExtUtils::Install; - ExtUtils::Install::pm_to_blib(\%pm, '../../lib/auto'); - open my $fh, '>', $pm_to_blib - or die "Can't open '$pm_to_blib': $!"; - print $fh "$0 has handled pm_to_blib directly\n"; - close $fh - or die "Can't close '$pm_to_blib': $!"; - if (IS_UNIX) { - # Fake the fallback cleanup - my $fallback - = join '', map {s!^\.\./\.\./!!; "rm -f $_\n"} sort values %pm; - foreach my $clean_target ('realclean', 'veryclean') { - fallback_cleanup($return_dir, $clean_target, $fallback); + my $need_update = 1; + if (-f $pm_to_blib) { + # avoid touching pm_to_blib unless there's something that + # needs updating, see #126710 + $need_update = 0; + my $test_at = -M _; + while (my $from = each(%pm)) { + if (-M $from < $test_at) { + ++$need_update; + last; + } + } + keys %pm; # reset iterator + } + + if ($need_update) { + local $ENV{PERL_INSTALL_QUIET} = 1; + require ExtUtils::Install; + ExtUtils::Install::pm_to_blib(\%pm, '../../lib/auto'); + open my $fh, '>', $pm_to_blib + or die "Can't open '$pm_to_blib': $!"; + print $fh "$0 has handled pm_to_blib directly\n"; + close $fh + or die "Can't close '$pm_to_blib': $!"; + if (IS_UNIX) { + # Fake the fallback cleanup + my $fallback + = join '', map {s!^\.\./\.\./!!; "rm -f $_\n"} sort values %pm; + foreach my $clean_target ('realclean', 'veryclean') { + fallback_cleanup($return_dir, $clean_target, $fallback); + } } } } else { diff --git a/mathoms.c b/mathoms.c index 6c60328..82ee778 100644 --- a/mathoms.c +++ b/mathoms.c @@ -21,17 +21,37 @@ /* * This file contains mathoms, various binary artifacts from previous - * versions of Perl. For binary or source compatibility reasons, though, - * we cannot completely remove them from the core code. + * versions of Perl which we cannot completely remove from the core + * code. There are two reasons functions should be here: * - * REMEMBER to update makedef.pl when adding a function to mathoms.c whose - * name doesn't begin with "Perl_". + * 1) A function has been been replaced by a macro within a minor release, + * so XS modules compiled against an older release will expect to + * still be able to link against the function + * 2) A function Perl_foo(...) with #define foo Perl_foo(aTHX_ ...) + * has been replaced by a macro, e.g. #define foo(...) foo_flags(...,0) + * but XS code may still explicitly use the long form, i.e. + * Perl_foo(aTHX_ ...) * - * SMP - Oct. 24, 2005 + * NOTE: ALL FUNCTIONS IN THIS FILE should have an entry with the 'b' flag in + * embed.fnc. + * + * To move a function to this file, simply cut and paste it here, and change + * its embed.fnc entry to additionally have the 'b' flag. If, for some reason + * a function you'd like to be treated as mathoms can't be moved from its + * current place, simply enclose it between + * + * #ifndef NO_MATHOMS + * ... + * #endif + * + * and add the 'b' flag in embed.fnc. * * The compilation of this file can be suppressed; see INSTALL * + * Some blurb for perlapi.pod: + =head1 Obsolete backwards compatibility functions + Some of these are also deprecated. You can exclude these from your compiled Perl by adding this option to Configure: C<-Accflags='-DNO_MATHOMS'> @@ -51,22 +71,6 @@ C<-Accflags='-DNO_MATHOMS'> */ #else -/* NOTE ALL FUNCTIONS IN THIS FILE should have an entry with the 'b' flag in - * embed.fnc. - * - * To move a function to this file, simply cut and paste it here, and change - * its embed.fnc entry to additionally have the 'b' flag. If, for some reason - * a function you'd like to be treated as mathoms can't be moved from its - * current place, simply enclose it between - * - * #ifndef NO_MATHOMS - * ... - * #endif - * - * and add the 'b' flag in embed.fnc. - * - * */ - /* ref() is now a macro using Perl_doref; * this version provided for binary compatibility only. */ @@ -1092,6 +1096,18 @@ Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp) { return sv_collxfrm_flags(sv, nxp, SV_GMAGIC); } + +char * +Perl_mem_collxfrm(pTHX_ const char *input_string, STRLEN len, STRLEN *xlen) +{ + /* This function is retained for compatibility in case someone outside core + * is using this (but it is undocumented) */ + + PERL_ARGS_ASSERT_MEM_COLLXFRM; + + return _mem_collxfrm(input_string, len, xlen, FALSE); +} + #endif bool diff --git a/metaconfig.h b/metaconfig.h index 84580f5..94aae84 100644 --- a/metaconfig.h +++ b/metaconfig.h @@ -31,6 +31,8 @@ * HAS_NEWLOCALE * HAS_PRCTL * HAS_PSEUDOFORK + * HAS_QUERYLOCALE + * HAS_STRERROR_L * HAS_TIMEGM * HAS_USELOCALE * I16SIZE diff --git a/miniperlmain.c b/miniperlmain.c index fa7951f..a79099b 100644 --- a/miniperlmain.c +++ b/miniperlmain.c @@ -4,10 +4,10 @@ Any changes made here will be lost! */ -/* miniperlmain.c +/* miniperlmain.c or perlmain.c - a generated file * * Copyright (C) 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2003, - * 2004, 2005, 2006, 2007, by Larry Wall and others + * 2004, 2005, 2006, 2007, 2016 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -24,11 +24,18 @@ /* This file contains the main() function for the perl interpreter. * Note that miniperlmain.c contains main() for the 'miniperl' binary, - * while perlmain.c contains main() for the 'perl' binary. + * while perlmain.c contains main() for the 'perl' binary. The typical + * difference being that the latter includes Dynaloader. * * Miniperl is like perl except that it does not support dynamic loading, * and in fact is used to build the dynamic modules needed for the 'real' * perl executable. + * + * The content of the body of this generated file is mostly contained + * in Miniperl.pm - edit that file if you want to change anything. + * miniperlmain.c is generated by running regen/miniperlmain.pl.pl, while + * perlmain.c is built automatically by Makefile (so the former is + * included in the tarball while the latter isn't). */ #ifdef OEMVS diff --git a/myconfig.SH b/myconfig.SH index c5a9537..61c0f66 100755 --- a/myconfig.SH +++ b/myconfig.SH @@ -25,39 +25,73 @@ $startsh # This script is designed to provide a handy summary of the configuration # information being used to build perl. This is especially useful if you -# are requesting help from comp.lang.perl.misc on usenet or via mail. +# are requesting help online or via email. # Note that the text lines /^Summary of/ .. /^\s*$/ are copied into Config.pm. cat <<'!NO!SUBS!' Summary of my $package (revision $revision $version_patchlevel_string) configuration: $git_commit_id_title $git_commit_id$git_ancestor_line Platform: - osname=$osname, osvers=$osvers, archname=$archname + osname=$osname + osvers=$osvers + archname=$archname uname='$myuname' config_args='$config_args' - hint=$hint, useposix=$useposix, d_sigaction=$d_sigaction - useithreads=$useithreads, usemultiplicity=$usemultiplicity - use64bitint=$use64bitint, use64bitall=$use64bitall, uselongdouble=$uselongdouble - usemymalloc=$usemymalloc, bincompat5005=undef + hint=$hint + useposix=$useposix + d_sigaction=$d_sigaction + useithreads=$useithreads + usemultiplicity=$usemultiplicity + use64bitint=$use64bitint + use64bitall=$use64bitall + uselongdouble=$uselongdouble + usemymalloc=$usemymalloc + bincompat5005=undef Compiler: - cc='$cc', ccflags ='$ccflags', - optimize='$optimize', + cc='$cc' + ccflags ='$ccflags' + optimize='$optimize' cppflags='$cppflags' - ccversion='$ccversion', gccversion='$gccversion', gccosandvers='$gccosandvers' - intsize=$intsize, longsize=$longsize, ptrsize=$ptrsize, doublesize=$doublesize, byteorder=$byteorder, doublekind=$doublekind - d_longlong=$d_longlong, longlongsize=$longlongsize, d_longdbl=$d_longdbl, longdblsize=$longdblsize, longdblkind=$longdblkind - ivtype='$ivtype', ivsize=$ivsize, nvtype='$nvtype', nvsize=$nvsize, Off_t='$lseektype', lseeksize=$lseeksize - alignbytes=$alignbytes, prototype=$prototype + ccversion='$ccversion' + gccversion='$gccversion' + gccosandvers='$gccosandvers' + intsize=$intsize + longsize=$longsize + ptrsize=$ptrsize + doublesize=$doublesize + byteorder=$byteorder + doublekind=$doublekind + d_longlong=$d_longlong + longlongsize=$longlongsize + d_longdbl=$d_longdbl + longdblsize=$longdblsize + longdblkind=$longdblkind + ivtype='$ivtype' + ivsize=$ivsize + nvtype='$nvtype' + nvsize=$nvsize + Off_t='$lseektype' + lseeksize=$lseeksize + alignbytes=$alignbytes + prototype=$prototype Linker and Libraries: - ld='$ld', ldflags ='$ldflags' + ld='$ld' + ldflags ='$ldflags' libpth=$libpth libs=$libs perllibs=$perllibs - libc=$libc, so=$so, useshrplib=$useshrplib, libperl=$libperl + libc=$libc + so=$so + useshrplib=$useshrplib + libperl=$libperl gnulibc_version='$gnulibc_version' Dynamic Linking: - dlsrc=$dlsrc, dlext=$dlext, d_dlsymun=$d_dlsymun, ccdlflags='$ccdlflags' - cccdlflags='$cccdlflags', lddlflags='$lddlflags' + dlsrc=$dlsrc + dlext=$dlext + d_dlsymun=$d_dlsymun + ccdlflags='$ccdlflags' + cccdlflags='$cccdlflags' + lddlflags='$lddlflags' !NO!SUBS! !GROK!THIS! diff --git a/op.c b/op.c index cad8237..8008a21 100644 --- a/op.c +++ b/op.c @@ -1532,8 +1532,11 @@ S_scalarboolean(pTHX_ OP *o) { PERL_ARGS_ASSERT_SCALARBOOLEAN; - if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST - && !(cBINOPo->op_first->op_flags & OPf_SPECIAL)) { + if ((o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST && + !(cBINOPo->op_first->op_flags & OPf_SPECIAL)) || + (o->op_type == OP_NOT && cUNOPo->op_first->op_type == OP_SASSIGN && + cBINOPx(cUNOPo->op_first)->op_first->op_type == OP_CONST && + !(cBINOPx(cUNOPo->op_first)->op_first->op_flags & OPf_SPECIAL))) { if (ckWARN(WARN_SYNTAX)) { const line_t oldline = CopLINE(PL_curcop); @@ -2779,6 +2782,14 @@ S_lvref(pTHX_ OP *o, I32 type) o->op_private |= OPpLVREF_ITER; } +PERL_STATIC_INLINE bool +S_potential_mod_type(I32 type) +{ + /* Types that only potentially result in modification. */ + return type == OP_GREPSTART || type == OP_ENTERSUB + || type == OP_REFGEN || type == OP_LEAVESUBLV; +} + OP * Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) { @@ -2819,9 +2830,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) else { /* lvalue subroutine call */ o->op_private |= OPpLVAL_INTRO; PL_modcount = RETURN_UNLIMITED_NUMBER; - if (type == OP_GREPSTART || type == OP_ENTERSUB - || type == OP_REFGEN || type == OP_LEAVESUBLV) { - /* Potential lvalue context: */ + if (S_potential_mod_type(type)) { o->op_private |= OPpENTERSUB_INARGS; break; } @@ -2883,8 +2892,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) nomod: if (flags & OP_LVALUE_NO_CROAK) return NULL; /* grep, foreach, subcalls, refgen */ - if (type == OP_GREPSTART || type == OP_ENTERSUB - || type == OP_REFGEN || type == OP_LEAVESUBLV) + if (S_potential_mod_type(type)) break; yyerror(Perl_form(aTHX_ "Can't modify %s in %s", (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL) @@ -2977,9 +2985,15 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) break; case OP_KVHSLICE: case OP_KVASLICE: + case OP_AKEYS: if (type == OP_LEAVESUBLV) o->op_private |= OPpMAYBE_LVSUB; goto nomod; + case OP_AVHVSWITCH: + if (type == OP_LEAVESUBLV + && (o->op_private & 3) + OP_EACH == OP_KEYS) + o->op_private |= OPpMAYBE_LVSUB; + goto nomod; case OP_AV2ARYLEN: PL_hints |= HINT_BLOCK_SCOPE; if (type == OP_LEAVESUBLV) @@ -3033,7 +3047,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) break; case OP_KEYS: - if (type != OP_SASSIGN && type != OP_LEAVESUBLV) + if (type != OP_LEAVESUBLV && !scalar_mod_type(NULL, type)) goto nomod; goto lvalue_func; case OP_SUBSTR: @@ -3045,8 +3059,18 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) lvalue_func: if (type == OP_LEAVESUBLV) o->op_private |= OPpMAYBE_LVSUB; - if (o->op_flags & OPf_KIDS) - op_lvalue(OpSIBLING(cBINOPo->op_first), type); + if (o->op_flags & OPf_KIDS && OpHAS_SIBLING(cBINOPo->op_first)) { + /* substr and vec */ + /* If this op is in merely potential (non-fatal) modifiable + context, then apply OP_ENTERSUB context to + the kid op (to avoid croaking). Other- + wise pass this op’s own type so the correct op is mentioned + in error messages. */ + op_lvalue(OpSIBLING(cBINOPo->op_first), + S_potential_mod_type(type) + ? OP_ENTERSUB + : o->op_type); + } break; case OP_AELEM: @@ -3223,6 +3247,12 @@ S_scalar_mod_type(const OP *o, I32 type) case OP_BIT_AND: case OP_BIT_XOR: case OP_BIT_OR: + case OP_NBIT_AND: + case OP_NBIT_XOR: + case OP_NBIT_OR: + case OP_SBIT_AND: + case OP_SBIT_XOR: + case OP_SBIT_OR: case OP_CONCAT: case OP_SUBST: case OP_TRANS: @@ -3233,6 +3263,8 @@ S_scalar_mod_type(const OP *o, I32 type) case OP_ANDASSIGN: case OP_ORASSIGN: case OP_DORASSIGN: + case OP_VEC: + case OP_SUBSTR: return TRUE; default: return FALSE; @@ -3656,7 +3688,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp) return o; } else if (type == OP_RV2SV || /* "our" declaration */ type == OP_RV2AV || - type == OP_RV2HV) { /* XXX does this let anything illegal in? */ + type == OP_RV2HV) { if (cUNOPo->op_first->op_type != OP_GV) { /* MJD 20011224 */ S_cant_declare(aTHX_ o); } else if (attrs) { @@ -11956,9 +11988,9 @@ Perl_ck_each(pTHX_ OP *o) ) goto bad; default: - yyerror_pv(Perl_form(aTHX_ + qerror(Perl_mess(aTHX_ "Experimental %s on scalar is now forbidden", - PL_op_desc[orig_type]), 0); + PL_op_desc[orig_type])); bad: bad_type_pv(1, "hash or array", o, kid); return o; @@ -14688,6 +14720,12 @@ Perl_coresub_op(pTHX_ SV * const coreargssv, const int code, newOP(OP_CALLER,0) ) ); + case OP_EACH: + case OP_KEYS: + case OP_VALUES: + o = newUNOP(OP_AVHVSWITCH,0,argop); + o->op_private = opnum-OP_EACH; + return o; case OP_SELECT: /* which represents OP_SSELECT as well */ if (code) return newCONDOP( diff --git a/opcode.h b/opcode.h index 5ec8f58..0aaefb6 100644 --- a/opcode.h +++ b/opcode.h @@ -288,8 +288,8 @@ EXTCONST char* const PL_op_name[] = { "aslice", "kvaslice", "aeach", - "akeys", "avalues", + "akeys", "each", "values", "keys", @@ -528,6 +528,7 @@ EXTCONST char* const PL_op_name[] = { "once", "custom", "coreargs", + "avhvswitch", "runcv", "fc", "padcv", @@ -642,12 +643,12 @@ EXTCONST char* const PL_op_desc[] = { "bitwise and (&)", "bitwise xor (^)", "bitwise or (|)", - "numeric bitiwse and (&)", + "numeric bitwise and (&)", "numeric bitwise xor (^)", "numeric bitwise or (|)", - "string bitiwse and (&)", - "string bitwise xor (^)", - "string bitwise or (|)", + "string bitwise and (&.)", + "string bitwise xor (^.)", + "string bitwise or (|.)", "negation (-)", "integer negation (-)", "not", @@ -689,8 +690,8 @@ EXTCONST char* const PL_op_desc[] = { "array slice", "index/value array slice", "each on array", - "keys on array", "values on array", + "keys on array", "each", "values", "keys", @@ -929,6 +930,7 @@ EXTCONST char* const PL_op_desc[] = { "once", "unknown custom operator", "CORE:: subroutine", + "Array/hash switch", "__SUB__", "fc", "private subroutine", @@ -1104,8 +1106,8 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */ Perl_pp_aslice, Perl_pp_kvaslice, Perl_pp_aeach, - Perl_pp_akeys, Perl_pp_avalues, /* implemented by Perl_pp_akeys */ + Perl_pp_akeys, Perl_pp_each, Perl_pp_values, /* implemented by Perl_do_kv */ Perl_pp_keys, /* implemented by Perl_do_kv */ @@ -1344,6 +1346,7 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */ Perl_pp_once, Perl_pp_custom, /* implemented by Perl_unimplemented_op */ Perl_pp_coreargs, + Perl_pp_avhvswitch, Perl_pp_runcv, Perl_pp_fc, Perl_pp_padcv, @@ -1515,8 +1518,8 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */ Perl_ck_null, /* aslice */ Perl_ck_null, /* kvaslice */ Perl_ck_each, /* aeach */ - Perl_ck_each, /* akeys */ Perl_ck_each, /* avalues */ + Perl_ck_each, /* akeys */ Perl_ck_each, /* each */ Perl_ck_each, /* values */ Perl_ck_each, /* keys */ @@ -1755,6 +1758,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */ Perl_ck_null, /* once */ Perl_ck_null, /* custom */ Perl_ck_null, /* coreargs */ + Perl_ck_null, /* avhvswitch */ Perl_ck_null, /* runcv */ Perl_ck_fun, /* fc */ Perl_ck_null, /* padcv */ @@ -1920,8 +1924,8 @@ EXTCONST U32 PL_opargs[] = { 0x00023401, /* aslice */ 0x00023401, /* kvaslice */ 0x00003b40, /* aeach */ - 0x00003b08, /* akeys */ 0x00003b48, /* avalues */ + 0x00003b08, /* akeys */ 0x00004b40, /* each */ 0x00004b48, /* values */ 0x00004b08, /* keys */ @@ -2160,6 +2164,7 @@ EXTCONST U32 PL_opargs[] = { 0x00000300, /* once */ 0x00000000, /* custom */ 0x00000600, /* coreargs */ + 0x00000108, /* avhvswitch */ 0x00000004, /* runcv */ 0x00009b8e, /* fc */ 0x00000040, /* padcv */ @@ -2401,6 +2406,7 @@ EXTCONST char PL_op_private_labels[] = { EXTCONST I16 PL_op_private_bitfields[] = { 0, 8, -1, 0, 8, -1, + 0, -1, -1, 0, 8, -1, 0, 8, -1, 0, 8, -1, @@ -2557,8 +2563,8 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 96, /* aslice */ 99, /* kvaslice */ 0, /* aeach */ - 0, /* akeys */ 0, /* avalues */ + 39, /* akeys */ 0, /* each */ 0, /* values */ 39, /* keys */ @@ -2797,16 +2803,17 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* once */ -1, /* custom */ 181, /* coreargs */ + 185, /* avhvswitch */ 3, /* runcv */ 0, /* fc */ -1, /* padcv */ -1, /* introcv */ -1, /* clonecv */ - 185, /* padrange */ - 187, /* refassign */ - 193, /* lvref */ - 199, /* lvrefslice */ - 200, /* lvavref */ + 187, /* padrange */ + 189, /* refassign */ + 195, /* lvref */ + 201, /* lvrefslice */ + 202, /* lvavref */ 0, /* anonconst */ }; @@ -2826,22 +2833,22 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { */ EXTCONST U16 PL_op_private_bitdefs[] = { - 0x0003, /* scalar, prototype, refgen, srefgen, ref, readline, regcmaybe, regcreset, regcomp, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i_postdec, negate, i_negate, not, complement, ucfirst, lcfirst, uc, lc, quotemeta, aeach, akeys, avalues, each, values, pop, shift, grepstart, grepwhile, mapstart, mapwhile, range, and, or, dor, andassign, orassign, dorassign, method, method_named, method_super, method_redir, method_redir_super, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, fc, anonconst */ + 0x0003, /* scalar, prototype, refgen, srefgen, ref, readline, regcmaybe, regcreset, regcomp, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i_postdec, negate, i_negate, not, complement, ucfirst, lcfirst, uc, lc, quotemeta, aeach, avalues, each, values, pop, shift, grepstart, grepwhile, mapstart, mapwhile, range, and, or, dor, andassign, orassign, dorassign, method, method_named, method_super, method_redir, method_redir_super, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, fc, anonconst */ 0x2b5c, 0x3d59, /* pushmark */ 0x00bd, /* wantarray, runcv */ 0x03b8, 0x17f0, 0x3e0c, 0x38c8, 0x2f25, /* const */ 0x2b5c, 0x3079, /* gvsv */ 0x1655, /* gv */ 0x0067, /* gelem, lt, i_lt, gt, i_gt, le, i_le, ge, i_ge, eq, i_eq, ne, i_ne, ncmp, i_ncmp, slt, sgt, sle, sge, seq, sne, scmp, bit_and, bit_xor, bit_or, sbit_and, sbit_xor, sbit_or, smartmatch, lslice, xor */ - 0x2b5c, 0x3d58, 0x0257, /* padsv */ + 0x2b5c, 0x3d58, 0x02b7, /* padsv */ 0x2b5c, 0x3d58, 0x2c4c, 0x3a49, /* padav */ 0x2b5c, 0x3d58, 0x0534, 0x05d0, 0x2c4c, 0x3a49, /* padhv */ 0x3819, /* pushre, match, qr, subst */ - 0x2b5c, 0x19d8, 0x0256, 0x2c4c, 0x2e48, 0x3e04, 0x0003, /* rv2gv */ - 0x2b5c, 0x3078, 0x0256, 0x3e04, 0x0003, /* rv2sv */ - 0x2c4c, 0x0003, /* av2arylen, pos, keys */ + 0x2b5c, 0x19d8, 0x02b6, 0x2c4c, 0x2e48, 0x3e04, 0x0003, /* rv2gv */ + 0x2b5c, 0x3078, 0x02b6, 0x3e04, 0x0003, /* rv2sv */ + 0x2c4c, 0x0003, /* av2arylen, pos, akeys, keys */ 0x2dbc, 0x0e18, 0x0b74, 0x028c, 0x3fc8, 0x3e04, 0x0003, /* rv2cv */ - 0x012f, /* bless, glob, sprintf, formline, unpack, pack, join, anonlist, anonhash, splice, warn, die, reset, exit, close, pipe_op, fileno, umask, binmode, tie, dbmopen, sselect, select, getc, read, enterwrite, sysopen, sysseek, sysread, syswrite, eof, tell, seek, truncate, fcntl, ioctl, send, recv, socket, sockpair, bind, connect, listen, accept, shutdown, gsockopt, ssockopt, open_dir, seekdir, gmtime, shmget, shmctl, shmread, shmwrite, msgget, msgctl, msgsnd, msgrcv, semop, semget, semctl, ghbyaddr, gnbyaddr, gpbynumber, gsbyname, gsbyport, syscall */ + 0x018f, /* bless, glob, sprintf, formline, unpack, pack, join, anonlist, anonhash, splice, warn, die, reset, exit, close, pipe_op, fileno, umask, binmode, tie, dbmopen, sselect, select, getc, read, enterwrite, sysopen, sysseek, sysread, syswrite, eof, tell, seek, truncate, fcntl, ioctl, send, recv, socket, sockpair, bind, connect, listen, accept, shutdown, gsockopt, ssockopt, open_dir, seekdir, gmtime, shmget, shmctl, shmread, shmwrite, msgget, msgctl, msgsnd, msgrcv, semop, semget, semctl, ghbyaddr, gnbyaddr, gpbynumber, gsbyname, gsbyport, syscall */ 0x325c, 0x3178, 0x2634, 0x2570, 0x0003, /* backtick */ 0x3818, 0x0003, /* substcont */ 0x0f1c, 0x1f58, 0x0754, 0x3b8c, 0x22e8, 0x01e4, 0x0141, /* trans, transr */ @@ -2850,12 +2857,12 @@ EXTCONST U16 PL_op_private_bitdefs[] = { 0x4070, 0x0003, /* chomp, schomp, ncomplement, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, length, ord, chr, chroot, rmdir */ 0x4070, 0x0067, /* pow, multiply, i_multiply, divide, i_divide, modulo, i_modulo, add, i_add, subtract, i_subtract, concat, left_shift, right_shift, nbit_and, nbit_xor, nbit_or */ 0x12d8, 0x0067, /* repeat */ - 0x4070, 0x012f, /* stringify, atan2, rand, srand, index, rindex, crypt, push, unshift, flock, chdir, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgrp, setpgrp, getpriority, setpriority, sleep */ - 0x3570, 0x2c4c, 0x00cb, /* substr */ + 0x4070, 0x018f, /* stringify, atan2, rand, srand, index, rindex, crypt, push, unshift, flock, chdir, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgrp, setpgrp, getpriority, setpriority, sleep */ + 0x3570, 0x2c4c, 0x012b, /* substr */ 0x2c4c, 0x0067, /* vec */ 0x2b5c, 0x3078, 0x2c4c, 0x3a48, 0x3e04, 0x0003, /* rv2av */ - 0x01ff, /* aelemfast, aelemfast_lex */ - 0x2b5c, 0x2a58, 0x0256, 0x2c4c, 0x0067, /* aelem, helem */ + 0x025f, /* aelemfast, aelemfast_lex */ + 0x2b5c, 0x2a58, 0x02b6, 0x2c4c, 0x0067, /* aelem, helem */ 0x2b5c, 0x2c4c, 0x3a49, /* aslice, hslice */ 0x2c4d, /* kvaslice, kvhslice */ 0x2b5c, 0x3998, 0x0003, /* delete */ @@ -2868,24 +2875,25 @@ EXTCONST U16 PL_op_private_bitdefs[] = { 0x26cc, 0x0003, /* reverse */ 0x28f8, 0x0003, /* flip, flop */ 0x2b5c, 0x0003, /* cond_expr */ - 0x2b5c, 0x0e18, 0x0256, 0x028c, 0x3fc8, 0x3e04, 0x2481, /* entersub */ + 0x2b5c, 0x0e18, 0x02b6, 0x028c, 0x3fc8, 0x3e04, 0x2481, /* entersub */ 0x33d8, 0x0003, /* leavesub, leavesublv, leavewrite, leaveeval */ - 0x00bc, 0x012f, /* caller */ + 0x00bc, 0x018f, /* caller */ 0x21f5, /* nextstate, dbstate */ 0x29fc, 0x33d9, /* leave */ 0x2b5c, 0x3078, 0x0e8c, 0x36e5, /* enteriter */ 0x36e5, /* iter */ 0x29fc, 0x0067, /* leaveloop */ 0x41dc, 0x0003, /* last, next, redo, dump, goto */ - 0x325c, 0x3178, 0x2634, 0x2570, 0x012f, /* open */ + 0x325c, 0x3178, 0x2634, 0x2570, 0x018f, /* open */ 0x1b90, 0x1dec, 0x1ca8, 0x1a64, 0x0003, /* ftrread, ftrwrite, ftrexec, fteread, ftewrite, fteexec */ 0x1b90, 0x1dec, 0x1ca8, 0x0003, /* ftis, ftsize, ftmtime, ftatime, ftctime, ftrowned, fteowned, ftzero, ftsock, ftchr, ftblk, ftfile, ftdir, ftpipe, ftsuid, ftsgid, ftsvtx, ftlink, fttty, fttext, ftbinary */ 0x4071, /* wait, getppid, time */ 0x3474, 0x0c30, 0x068c, 0x4148, 0x2104, 0x0003, /* entereval */ 0x2d1c, 0x0018, 0x1144, 0x1061, /* coreargs */ - 0x2b5c, 0x019b, /* padrange */ - 0x2b5c, 0x3d58, 0x0376, 0x284c, 0x1748, 0x0067, /* refassign */ - 0x2b5c, 0x3d58, 0x0376, 0x284c, 0x1748, 0x0003, /* lvref */ + 0x2c4c, 0x00c7, /* avhvswitch */ + 0x2b5c, 0x01fb, /* padrange */ + 0x2b5c, 0x3d58, 0x03d6, 0x284c, 0x1748, 0x0067, /* refassign */ + 0x2b5c, 0x3d58, 0x03d6, 0x284c, 0x1748, 0x0003, /* lvref */ 0x2b5d, /* lvrefslice */ 0x2b5c, 0x3d58, 0x0003, /* lvavref */ @@ -3038,8 +3046,8 @@ EXTCONST U8 PL_op_private_valid[] = { /* ASLICE */ (OPpSLICEWARNING|OPpMAYBE_LVSUB|OPpLVAL_INTRO), /* KVASLICE */ (OPpMAYBE_LVSUB), /* AEACH */ (OPpARG1_MASK), - /* AKEYS */ (OPpARG1_MASK), /* AVALUES */ (OPpARG1_MASK), + /* AKEYS */ (OPpARG1_MASK|OPpMAYBE_LVSUB), /* EACH */ (OPpARG1_MASK), /* VALUES */ (OPpARG1_MASK), /* KEYS */ (OPpARG1_MASK|OPpMAYBE_LVSUB), @@ -3278,6 +3286,7 @@ EXTCONST U8 PL_op_private_valid[] = { /* ONCE */ (OPpARG1_MASK), /* CUSTOM */ (0xff), /* COREARGS */ (OPpCOREARGS_DEREF1|OPpCOREARGS_DEREF2|OPpCOREARGS_SCALARMOD|OPpCOREARGS_PUSHMARK), + /* AVHVSWITCH */ (3|OPpMAYBE_LVSUB), /* RUNCV */ (OPpOFFBYONE), /* FC */ (OPpARG1_MASK), /* PADCV */ (0), diff --git a/opnames.h b/opnames.h index 065c1a8..99b19d0 100644 --- a/opnames.h +++ b/opnames.h @@ -156,8 +156,8 @@ typedef enum opcode { OP_ASLICE = 139, OP_KVASLICE = 140, OP_AEACH = 141, - OP_AKEYS = 142, - OP_AVALUES = 143, + OP_AVALUES = 142, + OP_AKEYS = 143, OP_EACH = 144, OP_VALUES = 145, OP_KEYS = 146, @@ -396,21 +396,22 @@ typedef enum opcode { OP_ONCE = 379, OP_CUSTOM = 380, OP_COREARGS = 381, - OP_RUNCV = 382, - OP_FC = 383, - OP_PADCV = 384, - OP_INTROCV = 385, - OP_CLONECV = 386, - OP_PADRANGE = 387, - OP_REFASSIGN = 388, - OP_LVREF = 389, - OP_LVREFSLICE = 390, - OP_LVAVREF = 391, - OP_ANONCONST = 392, + OP_AVHVSWITCH = 382, + OP_RUNCV = 383, + OP_FC = 384, + OP_PADCV = 385, + OP_INTROCV = 386, + OP_CLONECV = 387, + OP_PADRANGE = 388, + OP_REFASSIGN = 389, + OP_LVREF = 390, + OP_LVREFSLICE = 391, + OP_LVAVREF = 392, + OP_ANONCONST = 393, OP_max } opcode; -#define MAXO 393 +#define MAXO 394 #define OP_FREED MAXO /* the OP_IS_* macros are optimized to a simple range check because diff --git a/patchlevel.h b/patchlevel.h index 808846a..819d14a 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -15,7 +15,7 @@ #define PERL_REVISION 5 /* age */ #define PERL_VERSION 25 /* epoch */ -#define PERL_SUBVERSION 1 /* generation */ +#define PERL_SUBVERSION 2 /* generation */ /* The following numbers describe the earliest compatible version of Perl ("compatibility" here being defined as sufficient binary/API @@ -36,7 +36,7 @@ */ #define PERL_API_REVISION 5 #define PERL_API_VERSION 25 -#define PERL_API_SUBVERSION 1 +#define PERL_API_SUBVERSION 2 /* XXX Note: The selection of non-default Configure options, such as -Duselonglong may invalidate these settings. Currently, Configure diff --git a/perl.c b/perl.c index 671e355..98bfdcf 100644 --- a/perl.c +++ b/perl.c @@ -22,6 +22,10 @@ * and destroy a perl interpreter, plus the functions used by XS code to * call back into perl. Note that it does not contain the actual main() * function of the interpreter; that can be found in perlmain.c + * + * Note that at build time this file is also linked to as perlmini.c, + * and perlmini.o is then built with PERL_IS_MINIPERL defined, which is + * then used to create the miniperl executable, rather than perl.o. */ #if defined(PERL_IS_MINIPERL) && !defined(USE_SITECUSTOMIZE) @@ -3150,6 +3154,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp) " M trace smart match resolution\n" " B dump suBroutine definitions, including special Blocks like BEGIN\n", " L trace some locale setting information--for Perl core development\n", + " i trace PerlIO layer processing\n", NULL }; UV uv = 0; @@ -3158,7 +3163,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp) if (isALPHA(**s)) { /* if adding extra options, remember to update DEBUG_MASK */ - static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAqMBL"; + static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAqMBLi"; for (; isWORDCHAR(**s); (*s)++) { const char * const d = strchr(debopts,**s); diff --git a/perl.h b/perl.h index a5c3eb8..a1dae95 100644 --- a/perl.h +++ b/perl.h @@ -4176,7 +4176,8 @@ Gid_t getegid (void); #define DEBUG_M_FLAG 0x01000000 /*16777216*/ #define DEBUG_B_FLAG 0x02000000 /*33554432*/ #define DEBUG_L_FLAG 0x04000000 /*67108864*/ -#define DEBUG_MASK 0x07FFEFFF /* mask of all the standard flags */ +#define DEBUG_i_FLAG 0x08000000 /*134217728*/ +#define DEBUG_MASK 0x0FFFEFFF /* mask of all the standard flags */ #define DEBUG_DB_RECURSE_FLAG 0x40000000 #define DEBUG_TOP_FLAG 0x80000000 /* -D was given --> PL_debug |= FLAG */ @@ -4208,6 +4209,7 @@ Gid_t getegid (void); # define DEBUG_M_TEST_ (PL_debug & DEBUG_M_FLAG) # define DEBUG_B_TEST_ (PL_debug & DEBUG_B_FLAG) # define DEBUG_L_TEST_ (PL_debug & DEBUG_L_FLAG) +# define DEBUG_i_TEST_ (PL_debug & DEBUG_i_FLAG) # define DEBUG_Xv_TEST_ (DEBUG_X_TEST_ && DEBUG_v_TEST_) # define DEBUG_Uv_TEST_ (DEBUG_U_TEST_ && DEBUG_v_TEST_) # define DEBUG_Pv_TEST_ (DEBUG_P_TEST_ && DEBUG_v_TEST_) @@ -4242,6 +4244,7 @@ Gid_t getegid (void); # define DEBUG_M_TEST DEBUG_M_TEST_ # define DEBUG_B_TEST DEBUG_B_TEST_ # define DEBUG_L_TEST DEBUG_L_TEST_ +# define DEBUG_i_TEST DEBUG_i_TEST_ # define DEBUG_Xv_TEST DEBUG_Xv_TEST_ # define DEBUG_Uv_TEST DEBUG_Uv_TEST_ # define DEBUG_Pv_TEST DEBUG_Pv_TEST_ @@ -4297,6 +4300,7 @@ Gid_t getegid (void); # define DEBUG_M(a) DEBUG__(DEBUG_M_TEST, a) # define DEBUG_B(a) DEBUG__(DEBUG_B_TEST, a) # define DEBUG_L(a) DEBUG__(DEBUG_L_TEST, a) +# define DEBUG_i(a) DEBUG__(DEBUG_i_TEST, a) #else /* DEBUGGING */ @@ -4327,6 +4331,7 @@ Gid_t getegid (void); # define DEBUG_M_TEST (0) # define DEBUG_B_TEST (0) # define DEBUG_L_TEST (0) +# define DEBUG_i_TEST (0) # define DEBUG_Xv_TEST (0) # define DEBUG_Uv_TEST (0) # define DEBUG_Pv_TEST (0) @@ -4361,6 +4366,7 @@ Gid_t getegid (void); # define DEBUG_M(a) # define DEBUG_B(a) # define DEBUG_L(a) +# define DEBUG_i(a) # define DEBUG_Xv(a) # define DEBUG_Uv(a) # define DEBUG_Pv(a) @@ -5123,7 +5129,7 @@ EXTCONST char* PL_block_type[]; /* These are all the compile time options that affect binary compatibility. Other compile time options that are binary compatible are in perl.c - Both are combined for the output of perl -V + (in S_Internals_V()). Both are combined for the output of perl -V However, this string will be embedded in any shared perl library, which will allow us add a comparison check in perlmain.c in the near future. */ #ifdef DOINIT diff --git a/perlio.c b/perlio.c index 11a66d0..d44c67f 100644 --- a/perlio.c +++ b/perlio.c @@ -351,6 +351,10 @@ PerlIO_debug(const char *fmt, ...) va_list ap; dSYS; va_start(ap, fmt); + + if (!DEBUG_i_TEST) + return; + if (!PL_perlio_debug_fd) { if (!TAINTING_get && PerlProc_getuid() == PerlProc_geteuid() && @@ -360,11 +364,11 @@ PerlIO_debug(const char *fmt, ...) PL_perlio_debug_fd = PerlLIO_open3(s, O_WRONLY | O_CREAT | O_APPEND, 0666); else - PL_perlio_debug_fd = -1; + PL_perlio_debug_fd = PerlLIO_dup(2); /* stderr */ } else { - /* tainting or set*id, so ignore the environment, and ensure we - skip these tests next time through. */ - PL_perlio_debug_fd = -1; + /* tainting or set*id, so ignore the environment and send the + debug output to stderr, like other -D switches. */ + PL_perlio_debug_fd = PerlLIO_dup(2); /* stderr */ } } if (PL_perlio_debug_fd > 0) { @@ -477,7 +481,7 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags) { if (PerlIOValid(f)) { const PerlIO_funcs * const tab = PerlIOBase(f)->tab; - PerlIO_debug("fdupopen f=%p param=%p\n",(void*)f,(void*)param); + DEBUG_i( PerlIO_debug("fdupopen f=%p param=%p\n",(void*)f,(void*)param) ); if (tab && tab->Dup) return (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX), f, param, flags); else { @@ -586,7 +590,7 @@ PerlIO_clone(pTHX_ PerlInterpreter *proto, CLONE_PARAMS *param) PL_known_layers = PerlIO_clone_list(aTHX_ proto->Iknown_layers, param); PL_def_layerlist = PerlIO_clone_list(aTHX_ proto->Idef_layerlist, param); PerlIO_init_table(aTHX); - PerlIO_debug("Clone %p from %p\n",(void*)aTHX,(void*)proto); + DEBUG_i( PerlIO_debug("Clone %p from %p\n",(void*)aTHX,(void*)proto) ); while ((f = *table)) { int i; table = (PerlIOl **) (f++); @@ -610,7 +614,7 @@ PerlIO_destruct(pTHX) PerlIOl **table = &PL_perlio; PerlIOl *f; #ifdef USE_ITHREADS - PerlIO_debug("Destruct %p\n",(void*)aTHX); + DEBUG_i( PerlIO_debug("Destruct %p\n",(void*)aTHX) ); #endif while ((f = *table)) { int i; @@ -620,7 +624,7 @@ PerlIO_destruct(pTHX) const PerlIOl *l; while ((l = *x)) { if (l->tab && l->tab->kind & PERLIO_K_DESTRUCT) { - PerlIO_debug("Destruct popping %s\n", l->tab->name); + DEBUG_i( PerlIO_debug("Destruct popping %s\n", l->tab->name) ); PerlIO_flush(x); PerlIO_pop(aTHX_ x); } @@ -639,8 +643,8 @@ PerlIO_pop(pTHX_ PerlIO *f) const PerlIOl *l = *f; VERIFY_HEAD(f); if (l) { - PerlIO_debug("PerlIO_pop f=%p %s\n", (void*)f, - l->tab ? l->tab->name : "(Null)"); + DEBUG_i( PerlIO_debug("PerlIO_pop f=%p %s\n", (void*)f, + l->tab ? l->tab->name : "(Null)") ); if (l->tab && l->tab->Popped) { /* * If popped returns non-zero do not free its layer structure @@ -713,7 +717,7 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load) PerlIO_funcs * const f = PL_known_layers->array[i].funcs; const STRLEN this_len = strlen(f->name); if (this_len == len && memEQ(f->name, name, len)) { - PerlIO_debug("%.*s => %p\n", (int) len, name, (void*)f); + DEBUG_i( PerlIO_debug("%.*s => %p\n", (int) len, name, (void*)f) ); return f; } } @@ -741,7 +745,7 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load) return PerlIO_find_layer(aTHX_ name, len, 0); } } - PerlIO_debug("Cannot find %.*s\n", (int) len, name); + DEBUG_i( PerlIO_debug("Cannot find %.*s\n", (int) len, name) ); return NULL; } @@ -844,8 +848,10 @@ XS(XS_PerlIO__Layer__NoWarnings) */ dXSARGS; PERL_UNUSED_ARG(cv); - if (items) - PerlIO_debug("warning:%s\n",SvPV_nolen_const(ST(0))); + PERL_UNUSED_VAR(items); + DEBUG_i( + if (items) + PerlIO_debug("warning:%s\n",SvPV_nolen_const(ST(0))) ); XSRETURN(0); } @@ -874,7 +880,7 @@ PerlIO_define_layer(pTHX_ PerlIO_funcs *tab) if (!PL_known_layers) PL_known_layers = PerlIO_list_alloc(aTHX); PerlIO_list_push(aTHX_ PL_known_layers, tab, NULL); - PerlIO_debug("define %s %p\n", tab->name, (void*)tab); + DEBUG_i( PerlIO_debug("define %s %p\n", tab->name, (void*)tab) ); } int @@ -979,7 +985,7 @@ PerlIO_default_buffer(pTHX_ PerlIO_list_t *av) if (PerlIO_stdio.Set_ptrcnt) tab = &PerlIO_stdio; #endif - PerlIO_debug("Pushing %s\n", tab->name); + DEBUG_i( PerlIO_debug("Pushing %s\n", tab->name) ); PerlIO_list_push(aTHX_ av, (PerlIO_funcs *)tab, &PL_sv_undef); } @@ -993,8 +999,8 @@ PerlIO_funcs * PerlIO_layer_fetch(pTHX_ PerlIO_list_t *av, IV n, PerlIO_funcs *def) { if (n >= 0 && n < av->cur) { - PerlIO_debug("Layer %" IVdf " is %s\n", n, - av->array[n].funcs->name); + DEBUG_i( PerlIO_debug("Layer %" IVdf " is %s\n", n, + av->array[n].funcs->name) ); return av->array[n].funcs; } if (!def) @@ -1145,9 +1151,9 @@ PerlIO_push(pTHX_ PerlIO *f, PERLIO_FUNCS_DECL(*tab), const char *mode, SV *arg) l->tab = (PerlIO_funcs*) tab; l->head = ((PerlIOl*)f)->head; *f = l; - PerlIO_debug("PerlIO_push f=%p %s %s %p\n", - (void*)f, tab->name, - (mode) ? mode : "(Null)", (void*)arg); + DEBUG_i( PerlIO_debug("PerlIO_push f=%p %s %s %p\n", + (void*)f, tab->name, + (mode) ? mode : "(Null)", (void*)arg) ); if (*l->tab->Pushed && (*l->tab->Pushed) (aTHX_ f, mode, arg, (PerlIO_funcs*) tab) != 0) { @@ -1161,8 +1167,8 @@ PerlIO_push(pTHX_ PerlIO *f, PERLIO_FUNCS_DECL(*tab), const char *mode, SV *arg) } else if (f) { /* Pseudo-layer where push does its own stack adjust */ - PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name, - (mode) ? mode : "(Null)", (void*)arg); + DEBUG_i( PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name, + (mode) ? mode : "(Null)", (void*)arg) ); if (tab->Pushed && (*tab->Pushed) (aTHX_ f, mode, arg, (PerlIO_funcs*) tab) != 0) { return NULL; @@ -1241,8 +1247,8 @@ PerlIORaw_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) } } if (PerlIOValid(f)) { - PerlIO_debug(":raw f=%p :%s\n", (void*)f, - PerlIOBase(f)->tab ? PerlIOBase(f)->tab->name : "(Null)"); + DEBUG_i( PerlIO_debug(":raw f=%p :%s\n", (void*)f, + PerlIOBase(f)->tab ? PerlIOBase(f)->tab->name : "(Null)") ); return 0; } } @@ -1294,10 +1300,14 @@ PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names) int PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names) { - PerlIO_debug("PerlIO_binmode f=%p %s %c %x %s\n", (void*)f, - (PerlIOBase(f) && PerlIOBase(f)->tab) ? - PerlIOBase(f)->tab->name : "(Null)", - iotype, mode, (names) ? names : "(Null)"); + PERL_UNUSED_ARG(iotype); + PERL_UNUSED_ARG(mode); + + DEBUG_i( + PerlIO_debug("PerlIO_binmode f=%p %s %c %x %s\n", (void*)f, + (PerlIOBase(f) && PerlIOBase(f)->tab) ? + PerlIOBase(f)->tab->name : "(Null)", + iotype, mode, (names) ? names : "(Null)") ); if (names) { /* Do not flush etc. if (e.g.) switching encodings. @@ -1530,9 +1540,9 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd, if (narg > 1 && !(tab->kind & PERLIO_K_MULTIARG)) { Perl_croak(aTHX_ "More than one argument to open(,':%s')",tab->name); } - PerlIO_debug("openn(%s,'%s','%s',%d,%x,%o,%p,%d,%p)\n", - tab->name, layers ? layers : "(Null)", mode, fd, - imode, perm, (void*)f, narg, (void*)args); + DEBUG_i( PerlIO_debug("openn(%s,'%s','%s',%d,%x,%o,%p,%d,%p)\n", + tab->name, layers ? layers : "(Null)", mode, fd, + imode, perm, (void*)f, narg, (void*)args) ); if (tab->Open) f = (*tab->Open) (aTHX_ tab, layera, n, mode, fd, imode, perm, f, narg, args); @@ -1609,7 +1619,7 @@ Perl_PerlIO_flush(pTHX_ PerlIO *f) return 0; /* If no Flush defined, silently succeed. */ } else { - PerlIO_debug("Cannot flush f=%p\n", (void*)f); + DEBUG_i( PerlIO_debug("Cannot flush f=%p\n", (void*)f) ); SETERRNO(EBADF, SS_IVCHAN); return -1; } @@ -2001,9 +2011,11 @@ PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) } } #if 0 + DEBUG_i( PerlIO_debug("PerlIOBase_pushed f=%p %s %s fl=%08" UVxf " (%s)\n", (void*)f, PerlIOBase(f)->tab->name, (omode) ? omode : "(Null)", l->flags, PerlIO_modestr(f, temp)); + ); #endif return 0; } @@ -2187,9 +2199,9 @@ PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) SV *arg = NULL; char buf[8]; assert(self); - PerlIO_debug("PerlIOBase_dup %s f=%p o=%p param=%p\n", - self->name, - (void*)f, (void*)o, (void*)param); + DEBUG_i(PerlIO_debug("PerlIOBase_dup %s f=%p o=%p param=%p\n", + self->name, + (void*)f, (void*)o, (void*)param) ); if (self->Getarg) arg = (*self->Getarg)(aTHX_ o, param, flags); f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg); @@ -2216,8 +2228,8 @@ S_more_refcounted_fds(pTHX_ const int new_fd) PERL_UNUSED_CONTEXT; #endif - PerlIO_debug("More fds - old=%d, need %d, new=%d\n", - old_max, new_fd, new_max); + DEBUG_i( PerlIO_debug("More fds - old=%d, need %d, new=%d\n", + old_max, new_fd, new_max) ); if (new_fd < old_max) { return; @@ -2239,9 +2251,9 @@ S_more_refcounted_fds(pTHX_ const int new_fd) PL_perlio_fd_refcnt_size = new_max; PL_perlio_fd_refcnt = new_array; - PerlIO_debug("Zeroing %p, %d\n", - (void*)(new_array + old_max), - new_max - old_max); + DEBUG_i( PerlIO_debug("Zeroing %p, %d\n", + (void*)(new_array + old_max), + new_max - old_max) ); Zero(new_array + old_max, new_max - old_max, int); } @@ -2273,8 +2285,8 @@ PerlIOUnix_refcnt_inc(int fd) Perl_croak(aTHX_ "refcnt_inc: fd %d: %d <= 0\n", fd, PL_perlio_fd_refcnt[fd]); } - PerlIO_debug("refcnt_inc: fd %d refcnt=%d\n", - fd, PL_perlio_fd_refcnt[fd]); + DEBUG_i( PerlIO_debug("refcnt_inc: fd %d refcnt=%d\n", + fd, PL_perlio_fd_refcnt[fd]) ); #ifdef USE_ITHREADS MUTEX_UNLOCK(&PL_perlio_mutex); @@ -2290,7 +2302,11 @@ PerlIOUnix_refcnt_dec(int fd) { int cnt = 0; if (fd >= 0) { +#ifdef DEBUGGING + dTHX; +#else dVAR; +#endif #ifdef USE_ITHREADS MUTEX_LOCK(&PL_perlio_mutex); #endif @@ -2305,7 +2321,7 @@ PerlIOUnix_refcnt_dec(int fd) fd, PL_perlio_fd_refcnt[fd]); } cnt = --PL_perlio_fd_refcnt[fd]; - PerlIO_debug("refcnt_dec: fd %d refcnt=%d\n", fd, cnt); + DEBUG_i( PerlIO_debug("refcnt_dec: fd %d refcnt=%d\n", fd, cnt) ); #ifdef USE_ITHREADS MUTEX_UNLOCK(&PL_perlio_mutex); #endif @@ -2352,9 +2368,9 @@ PerlIO_cleanup(pTHX) { int i; #ifdef USE_ITHREADS - PerlIO_debug("Cleanup layers for %p\n",(void*)aTHX); + DEBUG_i( PerlIO_debug("Cleanup layers for %p\n",(void*)aTHX) ); #else - PerlIO_debug("Cleanup layers\n"); + DEBUG_i( PerlIO_debug("Cleanup layers\n") ); #endif /* Raise STDIN..STDERR refcount so we don't close them */ @@ -2557,11 +2573,11 @@ PerlIOUnix_setfd(pTHX_ PerlIO *f, int fd, int imode) Stat_t st; if (PerlLIO_fstat(fd, &st) == 0) { if (!S_ISREG(st.st_mode)) { - PerlIO_debug("%d is not regular file\n",fd); + DEBUG_i( PerlIO_debug("%d is not regular file\n",fd) ); PerlIOBase(f)->flags |= PERLIO_F_NOTREG; } else { - PerlIO_debug("%d _is_ a regular file\n",fd); + DEBUG_i( PerlIO_debug("%d _is_ a regular file\n",fd) ); } } #endif @@ -4493,9 +4509,11 @@ PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) PerlIOBase(f)->flags |= PERLIO_F_CRLF; code = PerlIOBuf_pushed(aTHX_ f, mode, arg, tab); #if 0 + DEBUG_i( PerlIO_debug("PerlIOCrlf_pushed f=%p %s %s fl=%08" UVxf "\n", (void*)f, PerlIOBase(f)->tab->name, (mode) ? mode : "(Null)", PerlIOBase(f)->flags); + ); #endif { /* If the old top layer is a CRLF layer, reactivate it (if diff --git a/perly.act b/perly.act index 668ab00..445c264 100644 --- a/perly.act +++ b/perly.act @@ -1115,7 +1115,7 @@ case 2: case 170: #line 892 "perly.y" - { (yyval.opval) = localize((ps[(2) - (2)].val.opval),(ps[(1) - (2)].val.ival)); ;} + { (yyval.opval) = localize((ps[(2) - (2)].val.opval),0); ;} break; case 171: @@ -1395,7 +1395,7 @@ case 2: case 218: #line 1043 "perly.y" - { (yyval.opval) = localize((ps[(2) - (2)].val.opval),(ps[(1) - (2)].val.ival)); ;} + { (yyval.opval) = localize((ps[(2) - (2)].val.opval),1); ;} break; case 219: @@ -1539,6 +1539,6 @@ case 2: /* Generated from: - * 703ebd267cf8ca45f9dee9bc0f4b21511117a0c1dca1c8bc9438ce91950217ae perly.y + * 70adb6e1be5382fb5c8cd783cd886cb4725c98a3e69c54eb16da5d7829d929aa perly.y * 3e1dff60f26df8933d7aed0c0e87177a0f022c14800c0707eb62a7db4196ac98 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index 727d244..9295f54 100644 --- a/perly.h +++ b/perly.h @@ -258,6 +258,6 @@ typedef union YYSTYPE /* Generated from: - * 703ebd267cf8ca45f9dee9bc0f4b21511117a0c1dca1c8bc9438ce91950217ae perly.y + * 70adb6e1be5382fb5c8cd783cd886cb4725c98a3e69c54eb16da5d7829d929aa perly.y * 3e1dff60f26df8933d7aed0c0e87177a0f022c14800c0707eb62a7db4196ac98 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index ee4cb89..8694bd4 100644 --- a/perly.tab +++ b/perly.tab @@ -1171,6 +1171,6 @@ static const toketypes yy_type_tab[] = }; /* Generated from: - * 703ebd267cf8ca45f9dee9bc0f4b21511117a0c1dca1c8bc9438ce91950217ae perly.y + * 70adb6e1be5382fb5c8cd783cd886cb4725c98a3e69c54eb16da5d7829d929aa perly.y * 3e1dff60f26df8933d7aed0c0e87177a0f022c14800c0707eb62a7db4196ac98 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index 200964d..e7cea35 100644 --- a/perly.y +++ b/perly.y @@ -889,7 +889,7 @@ term : termbinop | myattrterm %prec UNIOP { $$ = $1; } | LOCAL term %prec UNIOP - { $$ = localize($2,$1); } + { $$ = localize($2,0); } | '(' expr ')' { $$ = sawparens($2); } | QWLIST @@ -1040,7 +1040,7 @@ term : termbinop myattrterm: MY myterm myattrlist { $$ = my_attrs($2,$3); } | MY myterm - { $$ = localize($2,$1); } + { $$ = localize($2,1); } ; /* Things that can be "my"'d */ diff --git a/plan9/config.plan9 b/plan9/config.plan9 index 174ac26..d7a4af9 100644 --- a/plan9/config.plan9 +++ b/plan9/config.plan9 @@ -3329,8 +3329,8 @@ * 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 "/sys/lib/perl/5.25.1" /**/ -#define PRIVLIB_EXP "/sys/lib/perl/5.25.1" /**/ +#define PRIVLIB "/sys/lib/perl/5.25.2" /**/ +#define PRIVLIB_EXP "/sys/lib/perl/5.25.2" /**/ /* PTRSIZE: * This symbol contains the size of a pointer, so that the C preprocessor @@ -3457,9 +3457,9 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "/sys/lib/perl/5.25.1/site_perl" /**/ -#define SITELIB_EXP "/sys/lib/perl/5.25.1/site_perl" /**/ -#define SITELIB_STEM "/sys/lib/perl/5.25.1/site_perl" /**/ +#define SITELIB "/sys/lib/perl/5.25.2/site_perl" /**/ +#define SITELIB_EXP "/sys/lib/perl/5.25.2/site_perl" /**/ +#define SITELIB_STEM "/sys/lib/perl/5.25.2/site_perl" /**/ /* Size_t_size: * This symbol holds the size of a Size_t in bytes. diff --git a/plan9/config_sh.sample b/plan9/config_sh.sample index 37b3228..4171745 100644 --- a/plan9/config_sh.sample +++ b/plan9/config_sh.sample @@ -32,12 +32,12 @@ alignbytes='4' ansi2knr='' aphostname='/bin/uname -n' api_revision='5' -api_subversion='1' +api_subversion='2' api_version='25' -api_versionstring='5.25.1' +api_versionstring='5.25.2' ar='ar' -archlib='/sys/lib/perl5/5.25.1/386' -archlibexp='/sys/lib/perl5/5.25.1/386' +archlib='/sys/lib/perl5/5.25.2/386' +archlibexp='/sys/lib/perl5/5.25.2/386' archname64='' archname='386' archobjs='' @@ -432,6 +432,7 @@ d_pwpasswd='undef' d_pwquota='undef' d_qgcvt='undef' d_quad='define' +d_querylocale='undef' d_random_r='undef' d_readdir64_r='undef' d_readdir='define' @@ -548,6 +549,7 @@ d_strcoll='define' d_strctcpy='define' d_strerrm='strerror(e)' d_strerror='define' +d_strerror_l='undef' d_strerror_r='undef' d_strftime='define' d_strlcat='undef' @@ -802,17 +804,17 @@ inc_version_list=' ' inc_version_list_init='0' incpath='' inews='' -installarchlib='/sys/lib/perl/5.25.1/386' +installarchlib='/sys/lib/perl/5.25.2/386' installbin='/usr/bin' installman1dir='/sys/man/1pub' installman3dir='/sys/man/2pub' installprefix='/usr' installprefixexp='/usr' -installprivlib='/sys/lib/perl/5.25.1' +installprivlib='/sys/lib/perl/5.25.2' installscript='/usr/bin' -installsitearch='/sys/lib/perl/5.25.1/site_perl/386' +installsitearch='/sys/lib/perl/5.25.2/site_perl/386' installsitebin='/usr/bin' -installsitelib='/sys/lib/perl/5.25.1/site_perl' +installsitelib='/sys/lib/perl/5.25.2/site_perl' installstyle='lib/perl5' installusrbinperl='undef' installvendorarch='' @@ -937,8 +939,8 @@ pmake='' pr='' prefix='/usr' prefixexp='/usr' -privlib='/sys/lib/perl/5.25.1' -privlibexp='/sys/lib/perl/5.25.1' +privlib='/sys/lib/perl/5.25.2' +privlibexp='/sys/lib/perl/5.25.2' procselfexe='' prototype='define' ptrsize='4' @@ -1003,13 +1005,13 @@ 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 sig_num_init='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, 44, 45, 46, 47, 48, 49, 0' sig_size='50' signal_t='void' -sitearch='/sys/lib/perl/5.25.1/site_perl/386' +sitearch='/sys/lib/perl/5.25.2/site_perl/386' sitearchexp='/sys/lib/perl/site_perl/386' sitebin='/usr/bin' sitebinexp='/usr/bin' -sitelib='/sys/lib/perl/5.25.1/site_perl' -sitelib_stem='/sys/lib/perl/5.25.1/site_perl' -sitelibexp='/sys/lib/perl/5.25.1/site_perl' +sitelib='/sys/lib/perl/5.25.2/site_perl' +sitelib_stem='/sys/lib/perl/5.25.2/site_perl' +sitelibexp='/sys/lib/perl/5.25.2/site_perl' siteprefix='/usr' siteprefixexp='/usr' sizesize='4' @@ -1042,7 +1044,7 @@ stdio_stream_array='' strerror_r_proto='0' strings='/sys/include/ape/string.h' submit='' -subversion='1' +subversion='2' sysman='/sys/man/1pub' tail='' tar='' @@ -1124,8 +1126,8 @@ vendorlib_stem='' vendorlibexp='' vendorprefix='' vendorprefixexp='' -version='5.25.1' -version_patchlevel_string='version 25 subversion 1' +version='5.25.2' +version_patchlevel_string='version 25 subversion 2' versiononly='undef' vi='' xlibpth='' @@ -1139,9 +1141,9 @@ config_args='' config_argc=0 PERL_REVISION=5 PERL_VERSION=25 -PERL_SUBVERSION=1 +PERL_SUBVERSION=2 PERL_API_REVISION=5 PERL_API_VERSION=25 -PERL_API_SUBVERSION=1 +PERL_API_SUBVERSION=2 PERL_PATCHLEVEL= PERL_CONFIG_SH=true diff --git a/pod/.gitignore b/pod/.gitignore index bf8ebee..a305636 100644 --- a/pod/.gitignore +++ b/pod/.gitignore @@ -53,7 +53,7 @@ /roffitall # generated -/perl5251delta.pod +/perl5252delta.pod /perlapi.pod /perlintern.pod *.html diff --git a/pod/perl.pod b/pod/perl.pod index 14e78ac..dbf57ec 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -180,6 +180,7 @@ aux c2ph h2ph h2xs perlbug pl2pm pod2html pod2man splain xsubpp perlhist Perl history records perldelta Perl changes since previous version + perl5251delta Perl changes in version 5.25.1 perl5250delta Perl changes in version 5.25.0 perl5240delta Perl changes in version 5.24.0 perl5222delta Perl changes in version 5.22.2 diff --git a/pod/perl5004delta.pod b/pod/perl5004delta.pod index fc5ae62..264483e 100644 --- a/pod/perl5004delta.pod +++ b/pod/perl5004delta.pod @@ -696,7 +696,7 @@ effect if perl is compiled with system malloc().) If this macro is defined, running out of memory need not be a fatal error: a memory pool can allocated by assigning to the special -variable C<$^M>. See L<"$^M">. +variable C<$^M>. See L. =item -DPACK_MALLOC diff --git a/pod/perl5005delta.pod b/pod/perl5005delta.pod index e73bceb..f1e304e 100644 --- a/pod/perl5005delta.pod +++ b/pod/perl5005delta.pod @@ -106,7 +106,7 @@ directly accessing perl globals as C. The API call is backward compatible with existing perls and provides source compatibility with threading is enabled. -See L<"C Source Compatibility"> for more information. +See L for more information. =back @@ -134,7 +134,7 @@ Oneliners with the C<-e> switch do not create temporary files anymore. Many new warnings that were introduced in 5.004 have been made optional. Some of these warnings are still present, but perl's new -features make them less often a problem. See L. +features make them less often a problem. See L. =head2 Licensing diff --git a/pod/perl5101delta.pod b/pod/perl5101delta.pod index 415ab6b..1fdd045 100644 --- a/pod/perl5101delta.pod +++ b/pod/perl5101delta.pod @@ -127,7 +127,7 @@ if overload fallback is active, it will be used instead, as usual.) =item * The semantics of C have changed slightly. -See L<"Modules and Pragmata"> for more information. +See L for more information. =item * diff --git a/pod/perl5120delta.pod b/pod/perl5120delta.pod index b8bd646..988662f 100644 --- a/pod/perl5120delta.pod +++ b/pod/perl5120delta.pod @@ -65,7 +65,7 @@ years, it will become a standard practice. However, C requires a new, 'strict' version -number format. See L<"Version number formats"> for details. +number format. See L for details. =head2 The C<...> operator @@ -430,7 +430,7 @@ to bless them into C. =item * The semantics of C have changed slightly. -See L<"Modules and Pragmata"> for more information. +See L for more information. =item * diff --git a/pod/perl5251delta.pod b/pod/perl5251delta.pod new file mode 100644 index 0000000..b615112 --- /dev/null +++ b/pod/perl5251delta.pod @@ -0,0 +1,421 @@ +=encoding utf8 + +=head1 NAME + +perl5251delta - what is new for perl v5.25.1 + +=head1 DESCRIPTION + +This document describes differences between the 5.25.0 release and the 5.25.1 +release. + +If you are upgrading from an earlier release such as 5.24.0, first read +L, which describes differences between 5.24.0 and 5.25.0. + +=head1 Core Enhancements + +=head2 POSIX::tmpnam() has been removed + +The fundamentally unsafe C interface was deprecated in +Perl 5.22.0 and has now been removed. In its place you can use +for example the L interfaces. + +=head2 require ::Foo::Bar is now illegal. + +Formerly, C would try to read F. Now any +bareword require which starts with a double colon dies instead. + +=head2 Unescaped literal C<"{"> characters in regular expression +patterns are no longer permissible + +You have to now say something like C<"\{"> or C<"[{]"> to specify to +match a LEFT CURLY BRACKET. This will allow future extensions to the +language. This restriction is not enforced, nor are there current plans +to enforce it, if the C<"{"> is the first character in the pattern. + +These have been deprecated since v5.16, with a deprecation message +displayed starting in v5.22. + +=head2 Literal control character variable names are no longer permissible + +A variable name may no longer contain a literal control character under +any circumstances. These previously were allowed in single-character +names on ASCII platforms, but have been deprecated there since Perl +v5.20. This affects things like C<$I<\cT>>, where I<\cT> is a literal +control (such as a C or C character) in the +source code. + +=head2 C is no longer permissible + +Using more than one C regular expression pattern modifier on a +single pattern is now forbidden. This is to allow a future enhancement +to the language. This usage has been deprecated since v5.22. + +=head2 C is no longer permissible in C<\N{...}> + +The name of a character may no longer contain non-breaking spaces. It +has been deprecated to do so since Perl v5.22. + +=head1 Performance Enhancements + +=over 4 + +=item * + +Bareword constant strings are now permitted to take part in constant +folding. They were originally exempted from constant folding in August 1999, +during the development of Perl 5.6, to ensure that C +would still apply to bareword constants. That has now been accomplished a +different way, so barewords, like other constants, now gain the performance +benefits of constant folding. + +This also means that void-context warnings on constant expressions of +barewords now report the folded constant operand, rather than the operation; +this matches the behaviour for non-bareword constants. + +=back + +=head1 Modules and Pragmata + +=head2 Updated Modules and Pragmata + +=over 4 + +=item * + +L has been upgraded from version 2.04 to 2.08. + +=item * + +L has been upgraded from version 1.40 to 1.41. + +=item * + +L has been upgraded from version 1.43 to 1.44. + +=item * + +L has been upgraded from version 0.25 to 0.26. + +=item * + +L has been upgraded from version 1.835 to 1.838. + +=item * + +L has been upgraded from version 2.54 to 2.55. + +=item * + +L has been upgraded from version 0.92 to 0.94. + +=item * + +L has been upgraded from version 2.06_01 to 2.07. + +=item * + +L has been upgraded from version 1.42_02 to 1.45_01. + +=item * + +L has been upgraded from version 3.37 to 3.38. + +=item * + +L has been upgraded from version 1.26 to 1.27. + +=item * + +L has been upgraded from version 5.20160507 to 5.20160520. + +=item * + +L has been upgraded from version 1.000031 to 1.000032. + +=item * + +L has been upgraded from version 5.021010 to 5.021011. + +=item * + +L has been upgraded from version 1.65 to 1.69. This remedies several +defects in making its symbols exportable. [perl #127821] +The C interface has been removed, +see L. +Trying to import POSIX subs that have no real implementations +(like C) now fails at import time, instead of +waiting until runtime. + +=item * + +L has been upgraded from version 0.32 to 0.33. + +=item * + +L has been upgraded from version 1.42_02 to 1.45_01. + +=item * + +L has been upgraded from version 0.33 to 0.34. + +=item * + +L has been upgraded from version 4.04 to 4.05. + +=item * + +L has been upgraded from version 1.001014 to 1.302015. + +=item * + +L has been upgraded from version 2.07 to 2.08. Compatibility +with 5.8 has been restored. + +=item * + +L has been upgraded from version 1.51 to 1.52. +Compatibility with 5.8 has been restored. + +=back + +=head1 Documentation + +=head2 Changes to Existing Documentation + +=over 4 + +=item * + +Fixed link to Crosby paper on hash complexity attack in L. + +=back + +=head1 Diagnostics + +=head2 New Diagnostics + +=head3 New Errors + +=over 4 + +=item * + +L + +=item * + +L + +=item * + +L + +=item * + +L + +=back + +=head2 Changes to Existing Diagnostics + +=over 4 + +=item * + +Code like C<$x = $x . "a"> was incorrectly failing to yield a +L +warning when C<$x> was a lexical variable with an undefined value. That has +now been fixed. [perl #127877] + +=item * + +When the error "Experimental push on scalar is now forbidden" is raised for +the hash functions C, C, and C, it is now followed by +the more helpful message, "Type of arg 1 to whatever must be hash or +array". [perl #127976] + +=item * + +C or C inside a subroutine, with no +argument to C or C, began crashing in Perl 5.14.0, but has now +been fixed. + +=item * + +C<< "string$scalar-E$*" >> now correctly prefers concat overloading to +string overloading if C<< $scalar-E$* >> returns an overloaded object, +bringing it into consistency with C<$$scalar>. + +=item * + +C<< /@0{0*-E@*/*0 >> and similar contortions used to crash, but no longer +do, but merely produce a syntax error. [perl #128171] + +=item * + +C or C with a reference or typeglob which, when stringified, +contains a null character started crashing in Perl 5.20.0, but has now been +fixed. [perl #128182] + +=back + +=head1 Utility Changes + +=head2 L + +=over 4 + +=item * + +Long lines in the message body are now wrapped at 900 characters, to stay +well within the 1000-character limit imposed by SMTP mail transfer agents. +This is particularly likely to be important for the list of arguments to +C, which can readily exceed the limit if, for example, it names +several non-default installation paths. This change also adds the first unit +tests for perlbug. [perl #128020] + +=back + +=head1 Configuration and Compilation + +=over 4 + +=item * + +C now builds C and C if you +invoke it with C<-Dusecrosscompiler> but not C<-Dtargethost=somehost>. +This means you can supply your target platform C, generate +the headers and proceed to build your cross-target perl. [perl #127234] + +=item * + +Builds with C<-Accflags=-DPERL_TRACE_OPS> now only dump the operator +counts when the environment variable C to be set to a +non-zero integer. This allows C to pass on such a build. + +=item * + +When building with GCC 6 and link-time optimization (the C<-flto> option to +C), C was treating all probed symbols as present on the +system, regardless of whether they actually exist. This has been fixed. +[perl #128131] + +=item * + +The F library is used for internal testing of Perl itself, and +also copied by several CPAN modules. Some of those modules must work on +older versions of Perl, so F must in turn avoid newer Perl +features. Compatibility with Perl 5.8 was inadvertently removed some time +ago; it has now been restored. [perl #128052] + +=item * + +The build process no longer emits an extra blank line before building each +"simple" extension (those with only F<*.pm> and F<*.pod> files). + +=back + +=head1 Internal Changes + +=over 4 + +=item * + +Perl is now built with the C compiler define enabled by +default. To disable it, use the C compiler define. +This flag alters how the C field is used in C structures, +and has been available optionally since perl 5.22.0. + +See L for more details of what this +build option does. + +=back + +=head1 Selected Bug Fixes + +=over 4 + +=item * + +Expressions containing an C<&&> or C<||> operator (or their synonyms C +and C) were being compiled incorrectly in some cases. If the left-hand +side consisted of either a negated bareword constant or a negated C +block containing a constant expression, and the right-hand side consisted of +a negated non-foldable expression, one of the negations was effectively +ignored. The same was true of C and C statement modifiers, +though with the left-hand and right-hand sides swapped. This long-standing +bug has now been fixed. [perl #127952] + +=item * + +C with an argument no longer crashes when encountering stash entries +other than globs. [perl #128106] + +=item * + +Assignment of hashes to, and deletion of, typeglobs named C<*::::::> no +longer causes crashes. [perl #128086] + +=back + +=head1 Acknowledgements + +Perl 5.25.1 represents approximately 2 weeks of development since Perl 5.25.0 +and contains approximately 46,000 lines of changes across 630 files from 24 +authors. + +Excluding auto-generated files, documentation and release tools, there were +approximately 40,000 lines of changes to 510 .pm, .t, .c and .h files. + +Perl continues to flourish into its third decade thanks to a vibrant community +of users and developers. The following people are known to have contributed the +improvements that became Perl 5.25.1: + +Aaron Crane, Andreas Voegele, Chad Granum, Chris 'BinGOs' Williams, Craig A. +Berry, David Mitchell, Doug Bell, Father Chrysostomos, H.Merijn Brand, Hugo van +der Sanden, Jarkko Hietaniemi, Jerry D. Hedden, Jim Cromie, John Lightsey, +Karen Etheridge, Karl Williamson, Lukas Mai, Maxwell Carey, Nicholas Clark, +Niko Tyni, Ricardo Signes, Sawyer X, Tony Cook, Yves Orton. + +The list above is almost certainly incomplete as it is automatically generated +from version control history. In particular, it does not include the names of +the (very much appreciated) contributors who reported issues to the Perl bug +tracker. + +Many of the changes included in this version originated in the CPAN modules +included in Perl's core. We're grateful to the entire CPAN community for +helping Perl to flourish. + +For a more complete list of all of Perl's historical contributors, please see +the F file in the Perl source distribution. + +=head1 Reporting Bugs + +If you find what you think is a bug, you might check the articles recently +posted to the comp.lang.perl.misc newsgroup and the perl bug database at +L . There may also be information at +L , the Perl Home Page. + +If you believe you have an unreported bug, please run the L program +included with your release. Be sure to trim your bug down to a tiny but +sufficient test case. Your bug report, along with the output of C, +will be sent off to perlbug@perl.org to be analysed by the Perl porting team. + +If the bug you are reporting has security implications which make it +inappropriate to send to a publicly archived mailing list, then see +L +for details of how to report the issue. + +=head1 SEE ALSO + +The F file for an explanation of how to view exhaustive details on +what changed. + +The F file for how to build Perl. + +The F file for general stuff. + +The F and F files for copyright information. + +=cut diff --git a/pod/perl561delta.pod b/pod/perl561delta.pod index 49ff54f..1ccc85a 100644 --- a/pod/perl561delta.pod +++ b/pod/perl561delta.pod @@ -744,7 +744,7 @@ than C<$]> (a numeric value). (This is a potential incompatibility. Send us a report via perlbug if you are affected by this.) The v1.2.3 syntax is also now legal in Perl. -See L for more on that. +See L for more on that. To cope with the new versioning system's use of at least three significant digits for each version component, the method used for incrementing the @@ -2092,7 +2092,7 @@ capabilities. In other words: if your operating system has the necessary APIs and datatypes, you should be able just to go ahead and use them, for threads by Configure -Dusethreads, and for 64 bits either explicitly by Configure -Duse64bitint or implicitly if your -system has 64-bit wide datatypes. See also L<"64-bit support">. +system has 64-bit wide datatypes. See also L. =head2 Long Doubles @@ -2103,7 +2103,7 @@ Perl's scalars, use -Duselongdouble. =head2 -Dusemorebits You can enable both -Duse64bitint and -Duselongdouble with -Dusemorebits. -See also L<"64-bit support">. +See also L. =head2 -Duselargefiles @@ -2111,7 +2111,7 @@ Some platforms support system APIs that are capable of handling large files (typically, files larger than two gigabytes). Perl will try to use these APIs if you ask for -Duselargefiles. -See L<"Large file support"> for more information. +See L for more information. =head2 installusrbinperl diff --git a/pod/perl56delta.pod b/pod/perl56delta.pod index 24c2072..8b6272b 100644 --- a/pod/perl56delta.pod +++ b/pod/perl56delta.pod @@ -146,7 +146,7 @@ than C<$]> (a numeric value). (This is a potential incompatibility. Send us a report via perlbug if you are affected by this.) The v1.2.3 syntax is also now legal in Perl. -See L for more on that. +See L for more on that. To cope with the new versioning system's use of at least three significant digits for each version component, the method used for incrementing the @@ -1494,7 +1494,7 @@ capabilities. In other words: if your operating system has the necessary APIs and datatypes, you should be able just to go ahead and use them, for threads by Configure -Dusethreads, and for 64 bits either explicitly by Configure -Duse64bitint or implicitly if your -system has 64-bit wide datatypes. See also L<"64-bit support">. +system has 64-bit wide datatypes. See also L. =head2 Long Doubles @@ -1505,7 +1505,7 @@ Perl's scalars, use -Duselongdouble. =head2 -Dusemorebits You can enable both -Duse64bitint and -Duselongdouble with -Dusemorebits. -See also L<"64-bit support">. +See also L. =head2 -Duselargefiles @@ -1513,7 +1513,7 @@ Some platforms support system APIs that are capable of handling large files (typically, files larger than two gigabytes). Perl will try to use these APIs if you ask for -Duselargefiles. -See L<"Large file support"> for more information. +See L for more information. =head2 installusrbinperl diff --git a/pod/perl581delta.pod b/pod/perl581delta.pod index cd88c73..a5a960c 100644 --- a/pod/perl581delta.pod +++ b/pod/perl581delta.pod @@ -120,7 +120,7 @@ by anyone, it has been repurposed. The behavior that this switch enabled in 5.6.x releases may be supported in a transparent, data-dependent fashion in a future release. -For the new life of this switch, see L<"UTF-8 no longer default under +For the new life of this switch, see L, and L. =head2 (Win32) The /d Switch Of cmd.exe diff --git a/pod/perl58delta.pod b/pod/perl58delta.pod index 8b81d4c..1997ff9 100644 --- a/pod/perl58delta.pod +++ b/pod/perl58delta.pod @@ -318,7 +318,7 @@ tainted data and in some future release they will produce fatal errors. The existing behaviour when localising tied arrays and hashes is wrong, and will be changed in a future release, so do not rely on the existing -behaviour. See L<"Localising Tied Arrays and Hashes Is Broken">. +behaviour. See L. =back diff --git a/pod/perlapio.pod b/pod/perlapio.pod index a879809..8e0f82e 100644 --- a/pod/perlapio.pod +++ b/pod/perlapio.pod @@ -499,23 +499,25 @@ debugging. No return value. Its main use is inside PerlIO where using real printf, warn() etc. would recursively call PerlIO and be a problem. -PerlIO_debug writes to the file named by $ENV{'PERLIO_DEBUG'} typical +PerlIO_debug writes to the file named by $ENV{'PERLIO_DEBUG'} or defaults +to stderr if the environment variable is not defined. Typical use might be Bourne shells (sh, ksh, bash, zsh, ash, ...): - PERLIO_DEBUG=/dev/tty ./perl somescript some args + PERLIO_DEBUG=/tmp/perliodebug.log ./perl -Di somescript some args Csh/Tcsh: - setenv PERLIO_DEBUG /dev/tty - ./perl somescript some args + setenv PERLIO_DEBUG /tmp/perliodebug.log + ./perl -Di somescript some args If you have the "env" utility: - env PERLIO_DEBUG=/dev/tty ./perl somescript some args + env PERLIO_DEBUG=/tmp/perliodebug.log ./perl -Di somescript args Win32: - set PERLIO_DEBUG=CON - perl somescript some args + set PERLIO_DEBUG=perliodebug.log + perl -Di somescript some args -If $ENV{'PERLIO_DEBUG'} is not set PerlIO_debug() is a no-op. +On a Perl built without C<-DDEBUGGING>, or when the C<-Di> command-line switch +is not specified, or under taint, PerlIO_debug() is a no-op. =back diff --git a/pod/perlcommunity.pod b/pod/perlcommunity.pod index 4b86740..bb55b67 100644 --- a/pod/perlcommunity.pod +++ b/pod/perlcommunity.pod @@ -32,9 +32,6 @@ contributors. If you don't see a certain project listed at L, check the particular website for that project. Most mailing lists are archived at L. -There are also plenty of Perl related newsgroups located under -C. - =head2 IRC The Perl community has a rather large IRC presence. For starters, it has its diff --git a/pod/perldata.pod b/pod/perldata.pod index a285eb7..66bb206 100644 --- a/pod/perldata.pod +++ b/pod/perldata.pod @@ -25,7 +25,7 @@ be a chain of identifiers, separated by C<::> (or by the slightly archaic C<'>); all but the last are interpreted as names of packages, to locate the namespace in which to look up the final identifier (see L for details). For a more in-depth discussion -on identifiers, see L. It's possible to +on identifiers, see L. It's possible to substitute for a simple identifier, an expression that produces a reference to the value at runtime. This is described in more detail below and in L. diff --git a/pod/perldebug.pod b/pod/perldebug.pod index 5762235..7c80db3 100644 --- a/pod/perldebug.pod +++ b/pod/perldebug.pod @@ -126,7 +126,7 @@ hashes, you'll probably prefer 'x \%h' rather than 'x %h'. See L if you'd like to do this yourself. The output format is governed by multiple options described under -L<"Configurable Options">. +L. If the C is included, it must be a numeral I; the value is dumped only I levels deep, as if the C option had been @@ -474,7 +474,7 @@ For historical reasons, the C<=value> is optional, but defaults to 1 only where it is safe to do so--that is, mostly for Boolean options. It is always better to assign a specific value using C<=>. The C