From 8da2d23733595367fad869e5fbc6c9a87041879b Mon Sep 17 00:00:00 2001 From: Siep Kroonenberg Date: Thu, 17 Feb 2011 16:52:23 +0000 Subject: New tlperl part VIII git-svn-id: svn://tug.org/texlive/trunk@21430 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/tlperl/lib/.packlist | 2115 ++++++ Master/tlpkg/tlperl/lib/AnyDBM_File.pm | 93 + Master/tlpkg/tlperl/lib/AutoLoader.pm | 429 ++ Master/tlpkg/tlperl/lib/AutoSplit.pm | 592 ++ Master/tlpkg/tlperl/lib/B.pm | 1189 ++++ Master/tlpkg/tlperl/lib/Benchmark.pm | 1044 +++ Master/tlpkg/tlperl/lib/CGI.pm | 8096 +++++++++++++++++++++++ Master/tlpkg/tlperl/lib/CORE.pod | 62 + Master/tlpkg/tlperl/lib/CPAN.pm | 3774 +++++++++++ Master/tlpkg/tlperl/lib/CPANPLUS.pm | 271 + Master/tlpkg/tlperl/lib/Carp.pm | 538 ++ Master/tlpkg/tlperl/lib/Config.pm | 103 + Master/tlpkg/tlperl/lib/Config.pmold | 99 + Master/tlpkg/tlperl/lib/Config.pod | 8880 ++++++++++++++++++++++++++ Master/tlpkg/tlperl/lib/Config_git.pl | 12 + Master/tlpkg/tlperl/lib/Config_heavy.pl | 1319 ++++ Master/tlpkg/tlperl/lib/Config_heavy.plold | 1315 ++++ Master/tlpkg/tlperl/lib/Cwd.pm | 824 +++ Master/tlpkg/tlperl/lib/DB.pm | 809 +++ Master/tlpkg/tlperl/lib/DBM_Filter.pm | 605 ++ Master/tlpkg/tlperl/lib/Digest.pm | 316 + Master/tlpkg/tlperl/lib/DirHandle.pm | 92 + Master/tlpkg/tlperl/lib/Dumpvalue.pm | 648 ++ Master/tlpkg/tlperl/lib/DynaLoader.pm | 771 +++ Master/tlpkg/tlperl/lib/Encode.pm | 963 +++ Master/tlpkg/tlperl/lib/English.pm | 230 + Master/tlpkg/tlperl/lib/Env.pm | 254 + Master/tlpkg/tlperl/lib/Errno.pm | 2768 ++++++++ Master/tlpkg/tlperl/lib/Exporter.pm | 584 ++ Master/tlpkg/tlperl/lib/Fatal.pm | 1374 ++++ Master/tlpkg/tlperl/lib/Fcntl.pm | 244 + Master/tlpkg/tlperl/lib/FileCache.pm | 188 + Master/tlpkg/tlperl/lib/FileHandle.pm | 262 + Master/tlpkg/tlperl/lib/FindBin.pm | 209 + Master/tlpkg/tlperl/lib/IO.pm | 68 + Master/tlpkg/tlperl/lib/Memoize.pm | 1047 +++ Master/tlpkg/tlperl/lib/NEXT.pm | 563 ++ Master/tlpkg/tlperl/lib/O.pm | 143 + Master/tlpkg/tlperl/lib/Opcode.pm | 593 ++ Master/tlpkg/tlperl/lib/POSIX.pm | 1042 +++ Master/tlpkg/tlperl/lib/POSIX.pod | 2218 +++++++ Master/tlpkg/tlperl/lib/PerlIO.pm | 344 + Master/tlpkg/tlperl/lib/SDBM_File.pm | 116 + Master/tlpkg/tlperl/lib/Safe.pm | 794 +++ Master/tlpkg/tlperl/lib/SelectSaver.pm | 54 + Master/tlpkg/tlperl/lib/SelfLoader.pm | 435 ++ Master/tlpkg/tlperl/lib/Shell.pm | 270 + Master/tlpkg/tlperl/lib/Socket.pm | 436 ++ Master/tlpkg/tlperl/lib/Storable.pm | 1188 ++++ Master/tlpkg/tlperl/lib/Switch.pm | 875 +++ Master/tlpkg/tlperl/lib/Symbol.pm | 170 + Master/tlpkg/tlperl/lib/Test.pm | 954 +++ Master/tlpkg/tlperl/lib/Thread.pm | 273 + Master/tlpkg/tlperl/lib/Tk.pm | 856 +++ Master/tlpkg/tlperl/lib/Tk.pod | 862 +++ Master/tlpkg/tlperl/lib/UNIVERSAL.pm | 214 + Master/tlpkg/tlperl/lib/Win32.pm | 793 +++ Master/tlpkg/tlperl/lib/Win32CORE.pm | 38 + Master/tlpkg/tlperl/lib/XSLoader.pm | 358 ++ Master/tlpkg/tlperl/lib/abbrev.pl | 45 + Master/tlpkg/tlperl/lib/assert.pl | 61 + Master/tlpkg/tlperl/lib/attributes.pm | 490 ++ Master/tlpkg/tlperl/lib/autodie.pm | 424 ++ Master/tlpkg/tlperl/lib/autouse.pm | 171 + Master/tlpkg/tlperl/lib/base.pm | 265 + Master/tlpkg/tlperl/lib/bigfloat.pl | 256 + Master/tlpkg/tlperl/lib/bigint.pl | 322 + Master/tlpkg/tlperl/lib/bigint.pm | 675 ++ Master/tlpkg/tlperl/lib/bignum.pm | 681 ++ Master/tlpkg/tlperl/lib/bigrat.pl | 157 + Master/tlpkg/tlperl/lib/bigrat.pm | 566 ++ Master/tlpkg/tlperl/lib/blib.pm | 97 + Master/tlpkg/tlperl/lib/bytes.pm | 100 + Master/tlpkg/tlperl/lib/bytes_heavy.pl | 40 + Master/tlpkg/tlperl/lib/cacheout.pl | 57 + Master/tlpkg/tlperl/lib/charnames.pm | 577 ++ Master/tlpkg/tlperl/lib/complete.pl | 122 + Master/tlpkg/tlperl/lib/constant.pm | 391 ++ Master/tlpkg/tlperl/lib/ctime.pl | 62 + Master/tlpkg/tlperl/lib/deprecate.pm | 105 + Master/tlpkg/tlperl/lib/diagnostics.pm | 648 ++ Master/tlpkg/tlperl/lib/dotsh.pl | 76 + Master/tlpkg/tlperl/lib/dumpvar.pl | 552 ++ Master/tlpkg/tlperl/lib/encoding.pm | 669 ++ Master/tlpkg/tlperl/lib/exceptions.pl | 62 + Master/tlpkg/tlperl/lib/fastcwd.pl | 45 + Master/tlpkg/tlperl/lib/feature.pm | 236 + Master/tlpkg/tlperl/lib/fields.pm | 327 + Master/tlpkg/tlperl/lib/filetest.pm | 117 + Master/tlpkg/tlperl/lib/find.pl | 52 + Master/tlpkg/tlperl/lib/finddepth.pl | 51 + Master/tlpkg/tlperl/lib/flush.pl | 34 + Master/tlpkg/tlperl/lib/getcwd.pl | 72 + Master/tlpkg/tlperl/lib/getopt.pl | 51 + Master/tlpkg/tlperl/lib/getopts.pl | 66 + Master/tlpkg/tlperl/lib/hostname.pl | 33 + Master/tlpkg/tlperl/lib/if.pm | 56 + Master/tlpkg/tlperl/lib/importenv.pl | 19 + Master/tlpkg/tlperl/lib/integer.pm | 93 + Master/tlpkg/tlperl/lib/less.pm | 158 + Master/tlpkg/tlperl/lib/lib.pm | 242 + Master/tlpkg/tlperl/lib/locale.pm | 40 + Master/tlpkg/tlperl/lib/look.pl | 52 + Master/tlpkg/tlperl/lib/mro.pm | 379 ++ Master/tlpkg/tlperl/lib/newgetopt.pl | 77 + Master/tlpkg/tlperl/lib/open.pm | 258 + Master/tlpkg/tlperl/lib/open2.pl | 15 + Master/tlpkg/tlperl/lib/open3.pl | 15 + Master/tlpkg/tlperl/lib/ops.pm | 47 + Master/tlpkg/tlperl/lib/overload.pm | 1534 +++++ Master/tlpkg/tlperl/lib/overloading.pm | 101 + Master/tlpkg/tlperl/lib/parent.pm | 136 + Master/tlpkg/tlperl/lib/perl5db.pl | 9559 ++++++++++++++++++++++++++++ Master/tlpkg/tlperl/lib/perllocal.pod | 110 + Master/tlpkg/tlperl/lib/pwd.pl | 69 + Master/tlpkg/tlperl/lib/re.pm | 485 ++ Master/tlpkg/tlperl/lib/shellwords.pl | 17 + Master/tlpkg/tlperl/lib/sigtrap.pm | 289 + Master/tlpkg/tlperl/lib/sort.pm | 196 + Master/tlpkg/tlperl/lib/stat.pl | 33 + Master/tlpkg/tlperl/lib/strict.pm | 147 + Master/tlpkg/tlperl/lib/subs.pm | 40 + Master/tlpkg/tlperl/lib/syslog.pl | 199 + Master/tlpkg/tlperl/lib/tainted.pl | 12 + Master/tlpkg/tlperl/lib/termcap.pl | 181 + Master/tlpkg/tlperl/lib/threads.pm | 1066 ++++ Master/tlpkg/tlperl/lib/timelocal.pl | 21 + Master/tlpkg/tlperl/lib/utf8.pm | 214 + Master/tlpkg/tlperl/lib/utf8_heavy.pl | 466 ++ Master/tlpkg/tlperl/lib/validate.pl | 102 + Master/tlpkg/tlperl/lib/vars.pm | 82 + Master/tlpkg/tlperl/lib/version.pm | 171 + Master/tlpkg/tlperl/lib/version.pod | 321 + Master/tlpkg/tlperl/lib/vmsish.pm | 154 + Master/tlpkg/tlperl/lib/warnings.pm | 544 ++ 135 files changed, 82231 insertions(+) create mode 100644 Master/tlpkg/tlperl/lib/.packlist create mode 100644 Master/tlpkg/tlperl/lib/AnyDBM_File.pm create mode 100644 Master/tlpkg/tlperl/lib/AutoLoader.pm create mode 100644 Master/tlpkg/tlperl/lib/AutoSplit.pm create mode 100644 Master/tlpkg/tlperl/lib/B.pm create mode 100644 Master/tlpkg/tlperl/lib/Benchmark.pm create mode 100644 Master/tlpkg/tlperl/lib/CGI.pm create mode 100644 Master/tlpkg/tlperl/lib/CORE.pod create mode 100644 Master/tlpkg/tlperl/lib/CPAN.pm create mode 100644 Master/tlpkg/tlperl/lib/CPANPLUS.pm create mode 100644 Master/tlpkg/tlperl/lib/Carp.pm create mode 100644 Master/tlpkg/tlperl/lib/Config.pm create mode 100644 Master/tlpkg/tlperl/lib/Config.pmold create mode 100644 Master/tlpkg/tlperl/lib/Config.pod create mode 100644 Master/tlpkg/tlperl/lib/Config_git.pl create mode 100644 Master/tlpkg/tlperl/lib/Config_heavy.pl create mode 100644 Master/tlpkg/tlperl/lib/Config_heavy.plold create mode 100644 Master/tlpkg/tlperl/lib/Cwd.pm create mode 100644 Master/tlpkg/tlperl/lib/DB.pm create mode 100644 Master/tlpkg/tlperl/lib/DBM_Filter.pm create mode 100644 Master/tlpkg/tlperl/lib/Digest.pm create mode 100644 Master/tlpkg/tlperl/lib/DirHandle.pm create mode 100644 Master/tlpkg/tlperl/lib/Dumpvalue.pm create mode 100644 Master/tlpkg/tlperl/lib/DynaLoader.pm create mode 100644 Master/tlpkg/tlperl/lib/Encode.pm create mode 100644 Master/tlpkg/tlperl/lib/English.pm create mode 100644 Master/tlpkg/tlperl/lib/Env.pm create mode 100644 Master/tlpkg/tlperl/lib/Errno.pm create mode 100644 Master/tlpkg/tlperl/lib/Exporter.pm create mode 100644 Master/tlpkg/tlperl/lib/Fatal.pm create mode 100644 Master/tlpkg/tlperl/lib/Fcntl.pm create mode 100644 Master/tlpkg/tlperl/lib/FileCache.pm create mode 100644 Master/tlpkg/tlperl/lib/FileHandle.pm create mode 100644 Master/tlpkg/tlperl/lib/FindBin.pm create mode 100644 Master/tlpkg/tlperl/lib/IO.pm create mode 100644 Master/tlpkg/tlperl/lib/Memoize.pm create mode 100644 Master/tlpkg/tlperl/lib/NEXT.pm create mode 100644 Master/tlpkg/tlperl/lib/O.pm create mode 100644 Master/tlpkg/tlperl/lib/Opcode.pm create mode 100644 Master/tlpkg/tlperl/lib/POSIX.pm create mode 100644 Master/tlpkg/tlperl/lib/POSIX.pod create mode 100644 Master/tlpkg/tlperl/lib/PerlIO.pm create mode 100644 Master/tlpkg/tlperl/lib/SDBM_File.pm create mode 100644 Master/tlpkg/tlperl/lib/Safe.pm create mode 100644 Master/tlpkg/tlperl/lib/SelectSaver.pm create mode 100644 Master/tlpkg/tlperl/lib/SelfLoader.pm create mode 100644 Master/tlpkg/tlperl/lib/Shell.pm create mode 100644 Master/tlpkg/tlperl/lib/Socket.pm create mode 100644 Master/tlpkg/tlperl/lib/Storable.pm create mode 100644 Master/tlpkg/tlperl/lib/Switch.pm create mode 100644 Master/tlpkg/tlperl/lib/Symbol.pm create mode 100644 Master/tlpkg/tlperl/lib/Test.pm create mode 100644 Master/tlpkg/tlperl/lib/Thread.pm create mode 100644 Master/tlpkg/tlperl/lib/Tk.pm create mode 100644 Master/tlpkg/tlperl/lib/Tk.pod create mode 100644 Master/tlpkg/tlperl/lib/UNIVERSAL.pm create mode 100644 Master/tlpkg/tlperl/lib/Win32.pm create mode 100644 Master/tlpkg/tlperl/lib/Win32CORE.pm create mode 100644 Master/tlpkg/tlperl/lib/XSLoader.pm create mode 100644 Master/tlpkg/tlperl/lib/abbrev.pl create mode 100644 Master/tlpkg/tlperl/lib/assert.pl create mode 100644 Master/tlpkg/tlperl/lib/attributes.pm create mode 100644 Master/tlpkg/tlperl/lib/autodie.pm create mode 100644 Master/tlpkg/tlperl/lib/autouse.pm create mode 100644 Master/tlpkg/tlperl/lib/base.pm create mode 100644 Master/tlpkg/tlperl/lib/bigfloat.pl create mode 100644 Master/tlpkg/tlperl/lib/bigint.pl create mode 100644 Master/tlpkg/tlperl/lib/bigint.pm create mode 100644 Master/tlpkg/tlperl/lib/bignum.pm create mode 100644 Master/tlpkg/tlperl/lib/bigrat.pl create mode 100644 Master/tlpkg/tlperl/lib/bigrat.pm create mode 100644 Master/tlpkg/tlperl/lib/blib.pm create mode 100644 Master/tlpkg/tlperl/lib/bytes.pm create mode 100644 Master/tlpkg/tlperl/lib/bytes_heavy.pl create mode 100644 Master/tlpkg/tlperl/lib/cacheout.pl create mode 100644 Master/tlpkg/tlperl/lib/charnames.pm create mode 100644 Master/tlpkg/tlperl/lib/complete.pl create mode 100644 Master/tlpkg/tlperl/lib/constant.pm create mode 100644 Master/tlpkg/tlperl/lib/ctime.pl create mode 100644 Master/tlpkg/tlperl/lib/deprecate.pm create mode 100644 Master/tlpkg/tlperl/lib/diagnostics.pm create mode 100644 Master/tlpkg/tlperl/lib/dotsh.pl create mode 100644 Master/tlpkg/tlperl/lib/dumpvar.pl create mode 100644 Master/tlpkg/tlperl/lib/encoding.pm create mode 100644 Master/tlpkg/tlperl/lib/exceptions.pl create mode 100644 Master/tlpkg/tlperl/lib/fastcwd.pl create mode 100644 Master/tlpkg/tlperl/lib/feature.pm create mode 100644 Master/tlpkg/tlperl/lib/fields.pm create mode 100644 Master/tlpkg/tlperl/lib/filetest.pm create mode 100644 Master/tlpkg/tlperl/lib/find.pl create mode 100644 Master/tlpkg/tlperl/lib/finddepth.pl create mode 100644 Master/tlpkg/tlperl/lib/flush.pl create mode 100644 Master/tlpkg/tlperl/lib/getcwd.pl create mode 100644 Master/tlpkg/tlperl/lib/getopt.pl create mode 100644 Master/tlpkg/tlperl/lib/getopts.pl create mode 100644 Master/tlpkg/tlperl/lib/hostname.pl create mode 100644 Master/tlpkg/tlperl/lib/if.pm create mode 100644 Master/tlpkg/tlperl/lib/importenv.pl create mode 100644 Master/tlpkg/tlperl/lib/integer.pm create mode 100644 Master/tlpkg/tlperl/lib/less.pm create mode 100644 Master/tlpkg/tlperl/lib/lib.pm create mode 100644 Master/tlpkg/tlperl/lib/locale.pm create mode 100644 Master/tlpkg/tlperl/lib/look.pl create mode 100644 Master/tlpkg/tlperl/lib/mro.pm create mode 100644 Master/tlpkg/tlperl/lib/newgetopt.pl create mode 100644 Master/tlpkg/tlperl/lib/open.pm create mode 100644 Master/tlpkg/tlperl/lib/open2.pl create mode 100644 Master/tlpkg/tlperl/lib/open3.pl create mode 100644 Master/tlpkg/tlperl/lib/ops.pm create mode 100644 Master/tlpkg/tlperl/lib/overload.pm create mode 100644 Master/tlpkg/tlperl/lib/overloading.pm create mode 100644 Master/tlpkg/tlperl/lib/parent.pm create mode 100644 Master/tlpkg/tlperl/lib/perl5db.pl create mode 100644 Master/tlpkg/tlperl/lib/perllocal.pod create mode 100644 Master/tlpkg/tlperl/lib/pwd.pl create mode 100644 Master/tlpkg/tlperl/lib/re.pm create mode 100644 Master/tlpkg/tlperl/lib/shellwords.pl create mode 100644 Master/tlpkg/tlperl/lib/sigtrap.pm create mode 100644 Master/tlpkg/tlperl/lib/sort.pm create mode 100644 Master/tlpkg/tlperl/lib/stat.pl create mode 100644 Master/tlpkg/tlperl/lib/strict.pm create mode 100644 Master/tlpkg/tlperl/lib/subs.pm create mode 100644 Master/tlpkg/tlperl/lib/syslog.pl create mode 100644 Master/tlpkg/tlperl/lib/tainted.pl create mode 100644 Master/tlpkg/tlperl/lib/termcap.pl create mode 100644 Master/tlpkg/tlperl/lib/threads.pm create mode 100644 Master/tlpkg/tlperl/lib/timelocal.pl create mode 100644 Master/tlpkg/tlperl/lib/utf8.pm create mode 100644 Master/tlpkg/tlperl/lib/utf8_heavy.pl create mode 100644 Master/tlpkg/tlperl/lib/validate.pl create mode 100644 Master/tlpkg/tlperl/lib/vars.pm create mode 100644 Master/tlpkg/tlperl/lib/version.pm create mode 100644 Master/tlpkg/tlperl/lib/version.pod create mode 100644 Master/tlpkg/tlperl/lib/vmsish.pm create mode 100644 Master/tlpkg/tlperl/lib/warnings.pm diff --git a/Master/tlpkg/tlperl/lib/.packlist b/Master/tlpkg/tlperl/lib/.packlist new file mode 100644 index 00000000000..d3638479fed --- /dev/null +++ b/Master/tlpkg/tlperl/lib/.packlist @@ -0,0 +1,2115 @@ +c:\perl\bin/a2p.exe type=file +c:\perl\bin/c2ph.bat type=file +c:\perl\bin/config_data.bat type=file +c:\perl\bin/corelist.bat type=file +c:\perl\bin/cpan.bat type=file +c:\perl\bin/cpan2dist.bat type=file +c:\perl\bin/cpanp-run-perl.bat type=file +c:\perl\bin/cpanp.bat type=file +c:\perl\bin/dprofpp.bat type=file +c:\perl\bin/enc2xs.bat type=file +c:\perl\bin/find2perl.bat type=file +c:\perl\bin/h2ph.bat type=file +c:\perl\bin/h2xs.bat type=file +c:\perl\bin/instmodsh.bat type=file +c:\perl\bin/libnetcfg.bat type=file +c:\perl\bin/perl.exe from=c:\perl\bin/perl5.12.3.exe type=link +c:\perl\bin/perl5.12.3.exe type=file +c:\perl\bin/perl512.dll type=file +c:\perl\bin/perlbug.bat type=file +c:\perl\bin/perldoc.bat type=file +c:\perl\bin/perlivp.bat type=file +c:\perl\bin/perlthanks.bat from=c:\perl\bin/perlbug.bat type=link +c:\perl\bin/piconv.bat type=file +c:\perl\bin/pl2pm.bat type=file +c:\perl\bin/pod2html.bat type=file +c:\perl\bin/pod2latex.bat type=file +c:\perl\bin/pod2man.bat type=file +c:\perl\bin/pod2text.bat type=file +c:\perl\bin/pod2usage.bat type=file +c:\perl\bin/podchecker.bat type=file +c:\perl\bin/podselect.bat type=file +c:\perl\bin/prove.bat type=file +c:\perl\bin/psed.bat from=c:\perl\bin/s2p.bat type=link +c:\perl\bin/pstruct.bat from=c:\perl\bin/c2ph.bat type=link +c:\perl\bin/ptar.bat type=file +c:\perl\bin/ptardiff.bat type=file +c:\perl\bin/s2p.bat type=file +c:\perl\bin/shasum.bat type=file +c:\perl\bin/splain.bat type=file +c:\perl\bin/xsubpp.bat type=file +c:\perl\lib/AnyDBM_File.pm type=file +c:\perl\lib/App/Cpan.pm type=file +c:\perl\lib/App/Prove.pm type=file +c:\perl\lib/App/Prove/State.pm type=file +c:\perl\lib/App/Prove/State/Result.pm type=file +c:\perl\lib/App/Prove/State/Result/Test.pm type=file +c:\perl\lib/Archive/Extract.pm type=file +c:\perl\lib/Archive/Tar.pm type=file +c:\perl\lib/Archive/Tar/Constant.pm type=file +c:\perl\lib/Archive/Tar/File.pm type=file +c:\perl\lib/Attribute/Handlers.pm type=file +c:\perl\lib/AutoLoader.pm type=file +c:\perl\lib/AutoSplit.pm type=file +c:\perl\lib/B.pm type=file +c:\perl\lib/B/Concise.pm type=file +c:\perl\lib/B/Debug.pm type=file +c:\perl\lib/B/Deparse.pm type=file +c:\perl\lib/B/Lint.pm type=file +c:\perl\lib/B/Lint/Debug.pm type=file +c:\perl\lib/B/Showlex.pm type=file +c:\perl\lib/B/Terse.pm type=file +c:\perl\lib/B/Xref.pm type=file +c:\perl\lib/Benchmark.pm type=file +c:\perl\lib/CGI.pm type=file +c:\perl\lib/CGI/Apache.pm type=file +c:\perl\lib/CGI/Carp.pm type=file +c:\perl\lib/CGI/Cookie.pm type=file +c:\perl\lib/CGI/Fast.pm type=file +c:\perl\lib/CGI/Pretty.pm type=file +c:\perl\lib/CGI/Push.pm type=file +c:\perl\lib/CGI/Switch.pm type=file +c:\perl\lib/CGI/Util.pm type=file +c:\perl\lib/CORE.pod type=file +c:\perl\lib/CORE/EXTERN.h type=file +c:\perl\lib/CORE/INTERN.h type=file +c:\perl\lib/CORE/XSUB.h type=file +c:\perl\lib/CORE/arpa/inet.h type=file +c:\perl\lib/CORE/av.h type=file +c:\perl\lib/CORE/bitcount.h type=file +c:\perl\lib/CORE/cc_runtime.h type=file +c:\perl\lib/CORE/config.h type=file +c:\perl\lib/CORE/cop.h type=file +c:\perl\lib/CORE/cv.h type=file +c:\perl\lib/CORE/dirent.h type=file +c:\perl\lib/CORE/dosish.h type=file +c:\perl\lib/CORE/embed.h type=file +c:\perl\lib/CORE/embedvar.h type=file +c:\perl\lib/CORE/fakesdio.h type=file +c:\perl\lib/CORE/fakethr.h type=file +c:\perl\lib/CORE/form.h type=file +c:\perl\lib/CORE/git_version.h type=file +c:\perl\lib/CORE/gv.h type=file +c:\perl\lib/CORE/handy.h type=file +c:\perl\lib/CORE/hv.h type=file +c:\perl\lib/CORE/intrpvar.h type=file +c:\perl\lib/CORE/iperlsys.h type=file +c:\perl\lib/CORE/keywords.h type=file +c:\perl\lib/CORE/libperl512.a type=file +c:\perl\lib/CORE/malloc_ctl.h type=file +c:\perl\lib/CORE/mg.h type=file +c:\perl\lib/CORE/mydtrace.h type=file +c:\perl\lib/CORE/netdb.h type=file +c:\perl\lib/CORE/nostdio.h type=file +c:\perl\lib/CORE/op.h type=file +c:\perl\lib/CORE/opcode.h type=file +c:\perl\lib/CORE/opnames.h type=file +c:\perl\lib/CORE/overload.h type=file +c:\perl\lib/CORE/pad.h type=file +c:\perl\lib/CORE/parser.h type=file +c:\perl\lib/CORE/patchlevel.h type=file +c:\perl\lib/CORE/perl.h type=file +c:\perl\lib/CORE/perlapi.h type=file +c:\perl\lib/CORE/perlhost.h type=file +c:\perl\lib/CORE/perlio.h type=file +c:\perl\lib/CORE/perliol.h type=file +c:\perl\lib/CORE/perlsdio.h type=file +c:\perl\lib/CORE/perlsfio.h type=file +c:\perl\lib/CORE/perlvars.h type=file +c:\perl\lib/CORE/perly.h type=file +c:\perl\lib/CORE/pp.h type=file +c:\perl\lib/CORE/pp_proto.h type=file +c:\perl\lib/CORE/proto.h type=file +c:\perl\lib/CORE/reentr.h type=file +c:\perl\lib/CORE/regcharclass.h type=file +c:\perl\lib/CORE/regcomp.h type=file +c:\perl\lib/CORE/regexp.h type=file +c:\perl\lib/CORE/regnodes.h type=file +c:\perl\lib/CORE/scope.h type=file +c:\perl\lib/CORE/sv.h type=file +c:\perl\lib/CORE/sys/socket.h type=file +c:\perl\lib/CORE/thread.h type=file +c:\perl\lib/CORE/time64.h type=file +c:\perl\lib/CORE/time64_config.h type=file +c:\perl\lib/CORE/uconfig.h type=file +c:\perl\lib/CORE/unixish.h type=file +c:\perl\lib/CORE/utf8.h type=file +c:\perl\lib/CORE/utfebcdic.h type=file +c:\perl\lib/CORE/util.h type=file +c:\perl\lib/CORE/uudmap.h type=file +c:\perl\lib/CORE/vdir.h type=file +c:\perl\lib/CORE/vmem.h type=file +c:\perl\lib/CORE/warnings.h type=file +c:\perl\lib/CORE/win32.h type=file +c:\perl\lib/CORE/win32iop-o.h type=file +c:\perl\lib/CORE/win32iop.h type=file +c:\perl\lib/CORE/win32thread.h type=file +c:\perl\lib/CORE/wince.h type=file +c:\perl\lib/CPAN.pm type=file +c:\perl\lib/CPAN/API/HOWTO.pod type=file +c:\perl\lib/CPAN/Author.pm type=file +c:\perl\lib/CPAN/Bundle.pm type=file +c:\perl\lib/CPAN/CacheMgr.pm type=file +c:\perl\lib/CPAN/Complete.pm type=file +c:\perl\lib/CPAN/Debug.pm type=file +c:\perl\lib/CPAN/DeferredCode.pm type=file +c:\perl\lib/CPAN/Distribution.pm type=file +c:\perl\lib/CPAN/Distroprefs.pm type=file +c:\perl\lib/CPAN/Distrostatus.pm type=file +c:\perl\lib/CPAN/Exception/RecursiveDependency.pm type=file +c:\perl\lib/CPAN/Exception/blocked_urllist.pm type=file +c:\perl\lib/CPAN/Exception/yaml_not_installed.pm type=file +c:\perl\lib/CPAN/FTP.pm type=file +c:\perl\lib/CPAN/FTP/netrc.pm type=file +c:\perl\lib/CPAN/FirstTime.pm type=file +c:\perl\lib/CPAN/HandleConfig.pm type=file +c:\perl\lib/CPAN/Index.pm type=file +c:\perl\lib/CPAN/InfoObj.pm type=file +c:\perl\lib/CPAN/Kwalify.pm type=file +c:\perl\lib/CPAN/Kwalify/distroprefs.dd type=file +c:\perl\lib/CPAN/Kwalify/distroprefs.yml type=file +c:\perl\lib/CPAN/LWP/UserAgent.pm type=file +c:\perl\lib/CPAN/Mirrors.pm type=file +c:\perl\lib/CPAN/Module.pm type=file +c:\perl\lib/CPAN/Nox.pm type=file +c:\perl\lib/CPAN/Prompt.pm type=file +c:\perl\lib/CPAN/Queue.pm type=file +c:\perl\lib/CPAN/Shell.pm type=file +c:\perl\lib/CPAN/Tarzip.pm type=file +c:\perl\lib/CPAN/URL.pm type=file +c:\perl\lib/CPAN/Version.pm type=file +c:\perl\lib/CPANPLUS.pm type=file +c:\perl\lib/CPANPLUS/Backend.pm type=file +c:\perl\lib/CPANPLUS/Backend/RV.pm type=file +c:\perl\lib/CPANPLUS/Config.pm type=file +c:\perl\lib/CPANPLUS/Configure.pm type=file +c:\perl\lib/CPANPLUS/Configure/Setup.pm type=file +c:\perl\lib/CPANPLUS/Dist.pm type=file +c:\perl\lib/CPANPLUS/Dist/Autobundle.pm type=file +c:\perl\lib/CPANPLUS/Dist/Base.pm type=file +c:\perl\lib/CPANPLUS/Dist/Build.pm type=file +c:\perl\lib/CPANPLUS/Dist/Build/Constants.pm type=file +c:\perl\lib/CPANPLUS/Dist/MM.pm type=file +c:\perl\lib/CPANPLUS/Dist/Sample.pm type=file +c:\perl\lib/CPANPLUS/Error.pm type=file +c:\perl\lib/CPANPLUS/FAQ.pod type=file +c:\perl\lib/CPANPLUS/Hacking.pod type=file +c:\perl\lib/CPANPLUS/Internals.pm type=file +c:\perl\lib/CPANPLUS/Internals/Constants.pm type=file +c:\perl\lib/CPANPLUS/Internals/Constants/Report.pm type=file +c:\perl\lib/CPANPLUS/Internals/Extract.pm type=file +c:\perl\lib/CPANPLUS/Internals/Fetch.pm type=file +c:\perl\lib/CPANPLUS/Internals/Report.pm type=file +c:\perl\lib/CPANPLUS/Internals/Search.pm type=file +c:\perl\lib/CPANPLUS/Internals/Source.pm type=file +c:\perl\lib/CPANPLUS/Internals/Source/Memory.pm type=file +c:\perl\lib/CPANPLUS/Internals/Source/SQLite.pm type=file +c:\perl\lib/CPANPLUS/Internals/Source/SQLite/Tie.pm type=file +c:\perl\lib/CPANPLUS/Internals/Utils.pm type=file +c:\perl\lib/CPANPLUS/Internals/Utils/Autoflush.pm type=file +c:\perl\lib/CPANPLUS/Module.pm type=file +c:\perl\lib/CPANPLUS/Module/Author.pm type=file +c:\perl\lib/CPANPLUS/Module/Author/Fake.pm type=file +c:\perl\lib/CPANPLUS/Module/Checksums.pm type=file +c:\perl\lib/CPANPLUS/Module/Fake.pm type=file +c:\perl\lib/CPANPLUS/Module/Signature.pm type=file +c:\perl\lib/CPANPLUS/Selfupdate.pm type=file +c:\perl\lib/CPANPLUS/Shell.pm type=file +c:\perl\lib/CPANPLUS/Shell/Classic.pm type=file +c:\perl\lib/CPANPLUS/Shell/Default.pm type=file +c:\perl\lib/CPANPLUS/Shell/Default/Plugins/CustomSource.pm type=file +c:\perl\lib/CPANPLUS/Shell/Default/Plugins/HOWTO.pod type=file +c:\perl\lib/CPANPLUS/Shell/Default/Plugins/Remote.pm type=file +c:\perl\lib/CPANPLUS/Shell/Default/Plugins/Source.pm type=file +c:\perl\lib/Carp.pm type=file +c:\perl\lib/Carp/Heavy.pm type=file +c:\perl\lib/Class/ISA.pm type=file +c:\perl\lib/Class/Struct.pm type=file +c:\perl\lib/Compress/Raw/Bzip2.pm type=file +c:\perl\lib/Compress/Raw/Zlib.pm type=file +c:\perl\lib/Compress/Zlib.pm type=file +c:\perl\lib/Config.pm type=file +c:\perl\lib/Config.pod type=file +c:\perl\lib/Config/Extensions.pm type=file +c:\perl\lib/Config_git.pl type=file +c:\perl\lib/Config_heavy.pl type=file +c:\perl\lib/Cwd.pm type=file +c:\perl\lib/DB.pm type=file +c:\perl\lib/DBM_Filter.pm type=file +c:\perl\lib/DBM_Filter/compress.pm type=file +c:\perl\lib/DBM_Filter/encode.pm type=file +c:\perl\lib/DBM_Filter/int32.pm type=file +c:\perl\lib/DBM_Filter/null.pm type=file +c:\perl\lib/DBM_Filter/utf8.pm type=file +c:\perl\lib/Data/Dumper.pm type=file +c:\perl\lib/Devel/DProf.pm type=file +c:\perl\lib/Devel/DProf/V.pm type=file +c:\perl\lib/Devel/DProf/test1_t type=file +c:\perl\lib/Devel/DProf/test1_v type=file +c:\perl\lib/Devel/DProf/test2_t type=file +c:\perl\lib/Devel/DProf/test2_v type=file +c:\perl\lib/Devel/DProf/test3_t type=file +c:\perl\lib/Devel/DProf/test3_v type=file +c:\perl\lib/Devel/DProf/test4_t type=file +c:\perl\lib/Devel/DProf/test4_v type=file +c:\perl\lib/Devel/DProf/test5_t type=file +c:\perl\lib/Devel/DProf/test5_v type=file +c:\perl\lib/Devel/DProf/test6_t type=file +c:\perl\lib/Devel/DProf/test6_v type=file +c:\perl\lib/Devel/DProf/test7_t type=file +c:\perl\lib/Devel/DProf/test7_v type=file +c:\perl\lib/Devel/DProf/test8_t type=file +c:\perl\lib/Devel/DProf/test8_v type=file +c:\perl\lib/Devel/InnerPackage.pm type=file +c:\perl\lib/Devel/PPPort.pm type=file +c:\perl\lib/Devel/Peek.pm type=file +c:\perl\lib/Devel/SelfStubber.pm type=file +c:\perl\lib/Digest.pm type=file +c:\perl\lib/Digest/MD5.pm type=file +c:\perl\lib/Digest/SHA.pm type=file +c:\perl\lib/Digest/base.pm type=file +c:\perl\lib/Digest/file.pm type=file +c:\perl\lib/DirHandle.pm type=file +c:\perl\lib/Dumpvalue.pm type=file +c:\perl\lib/DynaLoader.pm type=file +c:\perl\lib/Encode.pm type=file +c:\perl\lib/Encode/Alias.pm type=file +c:\perl\lib/Encode/Byte.pm type=file +c:\perl\lib/Encode/CJKConstants.pm type=file +c:\perl\lib/Encode/CN.pm type=file +c:\perl\lib/Encode/CN/HZ.pm type=file +c:\perl\lib/Encode/Changes.e2x type=file +c:\perl\lib/Encode/Config.pm type=file +c:\perl\lib/Encode/ConfigLocal_PM.e2x type=file +c:\perl\lib/Encode/EBCDIC.pm type=file +c:\perl\lib/Encode/Encoder.pm type=file +c:\perl\lib/Encode/Encoding.pm type=file +c:\perl\lib/Encode/GSM0338.pm type=file +c:\perl\lib/Encode/Guess.pm type=file +c:\perl\lib/Encode/JP.pm type=file +c:\perl\lib/Encode/JP/H2Z.pm type=file +c:\perl\lib/Encode/JP/JIS7.pm type=file +c:\perl\lib/Encode/KR.pm type=file +c:\perl\lib/Encode/KR/2022_KR.pm type=file +c:\perl\lib/Encode/MIME/Header.pm type=file +c:\perl\lib/Encode/MIME/Header/ISO_2022_JP.pm type=file +c:\perl\lib/Encode/MIME/Name.pm type=file +c:\perl\lib/Encode/Makefile_PL.e2x type=file +c:\perl\lib/Encode/PerlIO.pod type=file +c:\perl\lib/Encode/README.e2x type=file +c:\perl\lib/Encode/Supported.pod type=file +c:\perl\lib/Encode/Symbol.pm type=file +c:\perl\lib/Encode/TW.pm type=file +c:\perl\lib/Encode/Unicode.pm type=file +c:\perl\lib/Encode/Unicode/UTF7.pm type=file +c:\perl\lib/Encode/_PM.e2x type=file +c:\perl\lib/Encode/_T.e2x type=file +c:\perl\lib/Encode/encode.h type=file +c:\perl\lib/English.pm type=file +c:\perl\lib/Env.pm type=file +c:\perl\lib/Errno.pm type=file +c:\perl\lib/Exporter.pm type=file +c:\perl\lib/Exporter/Heavy.pm type=file +c:\perl\lib/ExtUtils/CBuilder.pm type=file +c:\perl\lib/ExtUtils/CBuilder/Base.pm type=file +c:\perl\lib/ExtUtils/CBuilder/Platform/Unix.pm type=file +c:\perl\lib/ExtUtils/CBuilder/Platform/VMS.pm type=file +c:\perl\lib/ExtUtils/CBuilder/Platform/Windows.pm type=file +c:\perl\lib/ExtUtils/CBuilder/Platform/Windows/BCC.pm type=file +c:\perl\lib/ExtUtils/CBuilder/Platform/Windows/GCC.pm type=file +c:\perl\lib/ExtUtils/CBuilder/Platform/Windows/MSVC.pm type=file +c:\perl\lib/ExtUtils/CBuilder/Platform/aix.pm type=file +c:\perl\lib/ExtUtils/CBuilder/Platform/cygwin.pm type=file +c:\perl\lib/ExtUtils/CBuilder/Platform/darwin.pm type=file +c:\perl\lib/ExtUtils/CBuilder/Platform/dec_osf.pm type=file +c:\perl\lib/ExtUtils/CBuilder/Platform/os2.pm type=file +c:\perl\lib/ExtUtils/Command.pm type=file +c:\perl\lib/ExtUtils/Command/MM.pm type=file +c:\perl\lib/ExtUtils/Constant.pm type=file +c:\perl\lib/ExtUtils/Constant/Base.pm type=file +c:\perl\lib/ExtUtils/Constant/ProxySubs.pm type=file +c:\perl\lib/ExtUtils/Constant/Utils.pm type=file +c:\perl\lib/ExtUtils/Constant/XS.pm type=file +c:\perl\lib/ExtUtils/Embed.pm type=file +c:\perl\lib/ExtUtils/Install.pm type=file +c:\perl\lib/ExtUtils/Installed.pm type=file +c:\perl\lib/ExtUtils/Liblist.pm type=file +c:\perl\lib/ExtUtils/Liblist/Kid.pm type=file +c:\perl\lib/ExtUtils/MANIFEST.SKIP type=file +c:\perl\lib/ExtUtils/MM.pm type=file +c:\perl\lib/ExtUtils/MM_AIX.pm type=file +c:\perl\lib/ExtUtils/MM_Any.pm type=file +c:\perl\lib/ExtUtils/MM_BeOS.pm type=file +c:\perl\lib/ExtUtils/MM_Cygwin.pm type=file +c:\perl\lib/ExtUtils/MM_DOS.pm type=file +c:\perl\lib/ExtUtils/MM_Darwin.pm type=file +c:\perl\lib/ExtUtils/MM_MacOS.pm type=file +c:\perl\lib/ExtUtils/MM_NW5.pm type=file +c:\perl\lib/ExtUtils/MM_OS2.pm type=file +c:\perl\lib/ExtUtils/MM_QNX.pm type=file +c:\perl\lib/ExtUtils/MM_UWIN.pm type=file +c:\perl\lib/ExtUtils/MM_Unix.pm type=file +c:\perl\lib/ExtUtils/MM_VMS.pm type=file +c:\perl\lib/ExtUtils/MM_VOS.pm type=file +c:\perl\lib/ExtUtils/MM_Win32.pm type=file +c:\perl\lib/ExtUtils/MM_Win95.pm type=file +c:\perl\lib/ExtUtils/MY.pm type=file +c:\perl\lib/ExtUtils/MakeMaker.pm type=file +c:\perl\lib/ExtUtils/MakeMaker/Config.pm type=file +c:\perl\lib/ExtUtils/MakeMaker/FAQ.pod type=file +c:\perl\lib/ExtUtils/MakeMaker/Tutorial.pod type=file +c:\perl\lib/ExtUtils/Manifest.pm type=file +c:\perl\lib/ExtUtils/Miniperl.pm type=file +c:\perl\lib/ExtUtils/Mkbootstrap.pm type=file +c:\perl\lib/ExtUtils/Mksymlists.pm type=file +c:\perl\lib/ExtUtils/Packlist.pm type=file +c:\perl\lib/ExtUtils/ParseXS.pm type=file +c:\perl\lib/ExtUtils/testlib.pm type=file +c:\perl\lib/ExtUtils/typemap type=file +c:\perl\lib/ExtUtils/xsubpp type=file +c:\perl\lib/Fatal.pm type=file +c:\perl\lib/Fcntl.pm type=file +c:\perl\lib/File/Basename.pm type=file +c:\perl\lib/File/CheckTree.pm type=file +c:\perl\lib/File/Compare.pm type=file +c:\perl\lib/File/Copy.pm type=file +c:\perl\lib/File/DosGlob.pm type=file +c:\perl\lib/File/Fetch.pm type=file +c:\perl\lib/File/Find.pm type=file +c:\perl\lib/File/Glob.pm type=file +c:\perl\lib/File/GlobMapper.pm type=file +c:\perl\lib/File/Path.pm type=file +c:\perl\lib/File/Spec.pm type=file +c:\perl\lib/File/Spec/Cygwin.pm type=file +c:\perl\lib/File/Spec/Epoc.pm type=file +c:\perl\lib/File/Spec/Functions.pm type=file +c:\perl\lib/File/Spec/Mac.pm type=file +c:\perl\lib/File/Spec/OS2.pm type=file +c:\perl\lib/File/Spec/Unix.pm type=file +c:\perl\lib/File/Spec/VMS.pm type=file +c:\perl\lib/File/Spec/Win32.pm type=file +c:\perl\lib/File/Temp.pm type=file +c:\perl\lib/File/stat.pm type=file +c:\perl\lib/FileCache.pm type=file +c:\perl\lib/FileHandle.pm type=file +c:\perl\lib/Filter/Simple.pm type=file +c:\perl\lib/Filter/Util/Call.pm type=file +c:\perl\lib/FindBin.pm type=file +c:\perl\lib/Getopt/Long.pm type=file +c:\perl\lib/Getopt/Std.pm type=file +c:\perl\lib/Hash/Util.pm type=file +c:\perl\lib/Hash/Util/FieldHash.pm type=file +c:\perl\lib/I18N/Collate.pm type=file +c:\perl\lib/I18N/LangTags.pm type=file +c:\perl\lib/I18N/LangTags/Detect.pm type=file +c:\perl\lib/I18N/LangTags/List.pm type=file +c:\perl\lib/IO.pm type=file +c:\perl\lib/IO/Compress/Adapter/Bzip2.pm type=file +c:\perl\lib/IO/Compress/Adapter/Deflate.pm type=file +c:\perl\lib/IO/Compress/Adapter/Identity.pm type=file +c:\perl\lib/IO/Compress/Base.pm type=file +c:\perl\lib/IO/Compress/Base/Common.pm type=file +c:\perl\lib/IO/Compress/Bzip2.pm type=file +c:\perl\lib/IO/Compress/Deflate.pm type=file +c:\perl\lib/IO/Compress/Gzip.pm type=file +c:\perl\lib/IO/Compress/Gzip/Constants.pm type=file +c:\perl\lib/IO/Compress/RawDeflate.pm type=file +c:\perl\lib/IO/Compress/Zip.pm type=file +c:\perl\lib/IO/Compress/Zip/Constants.pm type=file +c:\perl\lib/IO/Compress/Zlib/Constants.pm type=file +c:\perl\lib/IO/Compress/Zlib/Extra.pm type=file +c:\perl\lib/IO/Dir.pm type=file +c:\perl\lib/IO/File.pm type=file +c:\perl\lib/IO/Handle.pm type=file +c:\perl\lib/IO/Pipe.pm type=file +c:\perl\lib/IO/Poll.pm type=file +c:\perl\lib/IO/Seekable.pm type=file +c:\perl\lib/IO/Select.pm type=file +c:\perl\lib/IO/Socket.pm type=file +c:\perl\lib/IO/Socket/INET.pm type=file +c:\perl\lib/IO/Socket/UNIX.pm type=file +c:\perl\lib/IO/Uncompress/Adapter/Bunzip2.pm type=file +c:\perl\lib/IO/Uncompress/Adapter/Identity.pm type=file +c:\perl\lib/IO/Uncompress/Adapter/Inflate.pm type=file +c:\perl\lib/IO/Uncompress/AnyInflate.pm type=file +c:\perl\lib/IO/Uncompress/AnyUncompress.pm type=file +c:\perl\lib/IO/Uncompress/Base.pm type=file +c:\perl\lib/IO/Uncompress/Bunzip2.pm type=file +c:\perl\lib/IO/Uncompress/Gunzip.pm type=file +c:\perl\lib/IO/Uncompress/Inflate.pm type=file +c:\perl\lib/IO/Uncompress/RawInflate.pm type=file +c:\perl\lib/IO/Uncompress/Unzip.pm type=file +c:\perl\lib/IO/Zlib.pm type=file +c:\perl\lib/IPC/Cmd.pm type=file +c:\perl\lib/IPC/Open2.pm type=file +c:\perl\lib/IPC/Open3.pm type=file +c:\perl\lib/List/Util.pm type=file +c:\perl\lib/List/Util/PP.pm type=file +c:\perl\lib/List/Util/XS.pm type=file +c:\perl\lib/Locale/Constants.pm type=file +c:\perl\lib/Locale/Constants.pod type=file +c:\perl\lib/Locale/Country.pm type=file +c:\perl\lib/Locale/Country.pod type=file +c:\perl\lib/Locale/Currency.pm type=file +c:\perl\lib/Locale/Currency.pod type=file +c:\perl\lib/Locale/Language.pm type=file +c:\perl\lib/Locale/Language.pod type=file +c:\perl\lib/Locale/Maketext.pm type=file +c:\perl\lib/Locale/Maketext.pod type=file +c:\perl\lib/Locale/Maketext/Guts.pm type=file +c:\perl\lib/Locale/Maketext/GutsLoader.pm type=file +c:\perl\lib/Locale/Maketext/Simple.pm type=file +c:\perl\lib/Locale/Maketext/TPJ13.pod type=file +c:\perl\lib/Locale/Script.pm type=file +c:\perl\lib/Locale/Script.pod type=file +c:\perl\lib/Log/Message.pm type=file +c:\perl\lib/Log/Message/Config.pm type=file +c:\perl\lib/Log/Message/Handlers.pm type=file +c:\perl\lib/Log/Message/Item.pm type=file +c:\perl\lib/Log/Message/Simple.pm type=file +c:\perl\lib/MIME/Base64.pm type=file +c:\perl\lib/MIME/QuotedPrint.pm type=file +c:\perl\lib/Math/BigFloat.pm type=file +c:\perl\lib/Math/BigFloat/Trace.pm type=file +c:\perl\lib/Math/BigInt.pm type=file +c:\perl\lib/Math/BigInt/Calc.pm type=file +c:\perl\lib/Math/BigInt/CalcEmu.pm type=file +c:\perl\lib/Math/BigInt/FastCalc.pm type=file +c:\perl\lib/Math/BigInt/Trace.pm type=file +c:\perl\lib/Math/BigRat.pm type=file +c:\perl\lib/Math/Complex.pm type=file +c:\perl\lib/Math/Trig.pm type=file +c:\perl\lib/Memoize.pm type=file +c:\perl\lib/Memoize/AnyDBM_File.pm type=file +c:\perl\lib/Memoize/Expire.pm type=file +c:\perl\lib/Memoize/ExpireFile.pm type=file +c:\perl\lib/Memoize/ExpireTest.pm type=file +c:\perl\lib/Memoize/NDBM_File.pm type=file +c:\perl\lib/Memoize/SDBM_File.pm type=file +c:\perl\lib/Memoize/Storable.pm type=file +c:\perl\lib/Module/Build.pm type=file +c:\perl\lib/Module/Build/API.pod type=file +c:\perl\lib/Module/Build/Authoring.pod type=file +c:\perl\lib/Module/Build/Base.pm type=file +c:\perl\lib/Module/Build/Bundling.pod type=file +c:\perl\lib/Module/Build/Compat.pm type=file +c:\perl\lib/Module/Build/Config.pm type=file +c:\perl\lib/Module/Build/ConfigData.pm type=file +c:\perl\lib/Module/Build/Cookbook.pm type=file +c:\perl\lib/Module/Build/Dumper.pm type=file +c:\perl\lib/Module/Build/ModuleInfo.pm type=file +c:\perl\lib/Module/Build/Notes.pm type=file +c:\perl\lib/Module/Build/PPMMaker.pm type=file +c:\perl\lib/Module/Build/Platform/Amiga.pm type=file +c:\perl\lib/Module/Build/Platform/Default.pm type=file +c:\perl\lib/Module/Build/Platform/EBCDIC.pm type=file +c:\perl\lib/Module/Build/Platform/MPEiX.pm type=file +c:\perl\lib/Module/Build/Platform/MacOS.pm type=file +c:\perl\lib/Module/Build/Platform/RiscOS.pm type=file +c:\perl\lib/Module/Build/Platform/Unix.pm type=file +c:\perl\lib/Module/Build/Platform/VMS.pm type=file +c:\perl\lib/Module/Build/Platform/VOS.pm type=file +c:\perl\lib/Module/Build/Platform/Windows.pm type=file +c:\perl\lib/Module/Build/Platform/aix.pm type=file +c:\perl\lib/Module/Build/Platform/cygwin.pm type=file +c:\perl\lib/Module/Build/Platform/darwin.pm type=file +c:\perl\lib/Module/Build/Platform/os2.pm type=file +c:\perl\lib/Module/Build/PodParser.pm type=file +c:\perl\lib/Module/Build/Version.pm type=file +c:\perl\lib/Module/Build/YAML.pm type=file +c:\perl\lib/Module/CoreList.pm type=file +c:\perl\lib/Module/Load.pm type=file +c:\perl\lib/Module/Load/Conditional.pm type=file +c:\perl\lib/Module/Loaded.pm type=file +c:\perl\lib/Module/Pluggable.pm type=file +c:\perl\lib/Module/Pluggable/Object.pm type=file +c:\perl\lib/NEXT.pm type=file +c:\perl\lib/Net/Cmd.pm type=file +c:\perl\lib/Net/Config.pm type=file +c:\perl\lib/Net/Domain.pm type=file +c:\perl\lib/Net/FTP.pm type=file +c:\perl\lib/Net/FTP/A.pm type=file +c:\perl\lib/Net/FTP/E.pm type=file +c:\perl\lib/Net/FTP/I.pm type=file +c:\perl\lib/Net/FTP/L.pm type=file +c:\perl\lib/Net/FTP/dataconn.pm type=file +c:\perl\lib/Net/NNTP.pm type=file +c:\perl\lib/Net/Netrc.pm type=file +c:\perl\lib/Net/POP3.pm type=file +c:\perl\lib/Net/Ping.pm type=file +c:\perl\lib/Net/SMTP.pm type=file +c:\perl\lib/Net/Time.pm type=file +c:\perl\lib/Net/hostent.pm type=file +c:\perl\lib/Net/libnetFAQ.pod type=file +c:\perl\lib/Net/netent.pm type=file +c:\perl\lib/Net/protoent.pm type=file +c:\perl\lib/Net/servent.pm type=file +c:\perl\lib/O.pm type=file +c:\perl\lib/Object/Accessor.pm type=file +c:\perl\lib/Opcode.pm type=file +c:\perl\lib/POSIX.pm type=file +c:\perl\lib/POSIX.pod type=file +c:\perl\lib/Package/Constants.pm type=file +c:\perl\lib/Params/Check.pm type=file +c:\perl\lib/Parse/CPAN/Meta.pm type=file +c:\perl\lib/PerlIO.pm type=file +c:\perl\lib/PerlIO/encoding.pm type=file +c:\perl\lib/PerlIO/scalar.pm type=file +c:\perl\lib/PerlIO/via.pm type=file +c:\perl\lib/PerlIO/via/QuotedPrint.pm type=file +c:\perl\lib/Pod/Checker.pm type=file +c:\perl\lib/Pod/Escapes.pm type=file +c:\perl\lib/Pod/Find.pm type=file +c:\perl\lib/Pod/Functions.pm type=file +c:\perl\lib/Pod/Html.pm type=file +c:\perl\lib/Pod/InputObjects.pm type=file +c:\perl\lib/Pod/LaTeX.pm type=file +c:\perl\lib/Pod/Man.pm type=file +c:\perl\lib/Pod/ParseLink.pm type=file +c:\perl\lib/Pod/ParseUtils.pm type=file +c:\perl\lib/Pod/Parser.pm type=file +c:\perl\lib/Pod/Perldoc.pm type=file +c:\perl\lib/Pod/Perldoc/BaseTo.pm type=file +c:\perl\lib/Pod/Perldoc/GetOptsOO.pm type=file +c:\perl\lib/Pod/Perldoc/ToChecker.pm type=file +c:\perl\lib/Pod/Perldoc/ToMan.pm type=file +c:\perl\lib/Pod/Perldoc/ToNroff.pm type=file +c:\perl\lib/Pod/Perldoc/ToPod.pm type=file +c:\perl\lib/Pod/Perldoc/ToRtf.pm type=file +c:\perl\lib/Pod/Perldoc/ToText.pm type=file +c:\perl\lib/Pod/Perldoc/ToTk.pm type=file +c:\perl\lib/Pod/Perldoc/ToXml.pm type=file +c:\perl\lib/Pod/PlainText.pm type=file +c:\perl\lib/Pod/Plainer.pm type=file +c:\perl\lib/Pod/Select.pm type=file +c:\perl\lib/Pod/Simple.pm type=file +c:\perl\lib/Pod/Simple.pod type=file +c:\perl\lib/Pod/Simple/BlackBox.pm type=file +c:\perl\lib/Pod/Simple/Checker.pm type=file +c:\perl\lib/Pod/Simple/Debug.pm type=file +c:\perl\lib/Pod/Simple/DumpAsText.pm type=file +c:\perl\lib/Pod/Simple/DumpAsXML.pm type=file +c:\perl\lib/Pod/Simple/HTML.pm type=file +c:\perl\lib/Pod/Simple/HTMLBatch.pm type=file +c:\perl\lib/Pod/Simple/HTMLLegacy.pm type=file +c:\perl\lib/Pod/Simple/LinkSection.pm type=file +c:\perl\lib/Pod/Simple/Methody.pm type=file +c:\perl\lib/Pod/Simple/Progress.pm type=file +c:\perl\lib/Pod/Simple/PullParser.pm type=file +c:\perl\lib/Pod/Simple/PullParserEndToken.pm type=file +c:\perl\lib/Pod/Simple/PullParserStartToken.pm type=file +c:\perl\lib/Pod/Simple/PullParserTextToken.pm type=file +c:\perl\lib/Pod/Simple/PullParserToken.pm type=file +c:\perl\lib/Pod/Simple/RTF.pm type=file +c:\perl\lib/Pod/Simple/Search.pm type=file +c:\perl\lib/Pod/Simple/SimpleTree.pm type=file +c:\perl\lib/Pod/Simple/Subclassing.pod type=file +c:\perl\lib/Pod/Simple/Text.pm type=file +c:\perl\lib/Pod/Simple/TextContent.pm type=file +c:\perl\lib/Pod/Simple/TiedOutFH.pm type=file +c:\perl\lib/Pod/Simple/Transcode.pm type=file +c:\perl\lib/Pod/Simple/TranscodeDumb.pm type=file +c:\perl\lib/Pod/Simple/TranscodeSmart.pm type=file +c:\perl\lib/Pod/Simple/XHTML.pm type=file +c:\perl\lib/Pod/Simple/XMLOutStream.pm type=file +c:\perl\lib/Pod/Text.pm type=file +c:\perl\lib/Pod/Text/Color.pm type=file +c:\perl\lib/Pod/Text/Overstrike.pm type=file +c:\perl\lib/Pod/Text/Termcap.pm type=file +c:\perl\lib/Pod/Usage.pm type=file +c:\perl\lib/SDBM_File.pm type=file +c:\perl\lib/Safe.pm type=file +c:\perl\lib/Scalar/Util.pm type=file +c:\perl\lib/Scalar/Util/PP.pm type=file +c:\perl\lib/Search/Dict.pm type=file +c:\perl\lib/SelectSaver.pm type=file +c:\perl\lib/SelfLoader.pm type=file +c:\perl\lib/Shell.pm type=file +c:\perl\lib/Socket.pm type=file +c:\perl\lib/Storable.pm type=file +c:\perl\lib/Switch.pm type=file +c:\perl\lib/Symbol.pm type=file +c:\perl\lib/Sys/Hostname.pm type=file +c:\perl\lib/TAP/Base.pm type=file +c:\perl\lib/TAP/Formatter/Base.pm type=file +c:\perl\lib/TAP/Formatter/Color.pm type=file +c:\perl\lib/TAP/Formatter/Console.pm type=file +c:\perl\lib/TAP/Formatter/Console/ParallelSession.pm type=file +c:\perl\lib/TAP/Formatter/Console/Session.pm type=file +c:\perl\lib/TAP/Formatter/File.pm type=file +c:\perl\lib/TAP/Formatter/File/Session.pm type=file +c:\perl\lib/TAP/Formatter/Session.pm type=file +c:\perl\lib/TAP/Harness.pm type=file +c:\perl\lib/TAP/Object.pm type=file +c:\perl\lib/TAP/Parser.pm type=file +c:\perl\lib/TAP/Parser/Aggregator.pm type=file +c:\perl\lib/TAP/Parser/Grammar.pm type=file +c:\perl\lib/TAP/Parser/Iterator.pm type=file +c:\perl\lib/TAP/Parser/Iterator/Array.pm type=file +c:\perl\lib/TAP/Parser/Iterator/Process.pm type=file +c:\perl\lib/TAP/Parser/Iterator/Stream.pm type=file +c:\perl\lib/TAP/Parser/IteratorFactory.pm type=file +c:\perl\lib/TAP/Parser/Multiplexer.pm type=file +c:\perl\lib/TAP/Parser/Result.pm type=file +c:\perl\lib/TAP/Parser/Result/Bailout.pm type=file +c:\perl\lib/TAP/Parser/Result/Comment.pm type=file +c:\perl\lib/TAP/Parser/Result/Plan.pm type=file +c:\perl\lib/TAP/Parser/Result/Pragma.pm type=file +c:\perl\lib/TAP/Parser/Result/Test.pm type=file +c:\perl\lib/TAP/Parser/Result/Unknown.pm type=file +c:\perl\lib/TAP/Parser/Result/Version.pm type=file +c:\perl\lib/TAP/Parser/Result/YAML.pm type=file +c:\perl\lib/TAP/Parser/ResultFactory.pm type=file +c:\perl\lib/TAP/Parser/Scheduler.pm type=file +c:\perl\lib/TAP/Parser/Scheduler/Job.pm type=file +c:\perl\lib/TAP/Parser/Scheduler/Spinner.pm type=file +c:\perl\lib/TAP/Parser/Source.pm type=file +c:\perl\lib/TAP/Parser/Source/Perl.pm type=file +c:\perl\lib/TAP/Parser/Utils.pm type=file +c:\perl\lib/TAP/Parser/YAMLish/Reader.pm type=file +c:\perl\lib/TAP/Parser/YAMLish/Writer.pm type=file +c:\perl\lib/Term/ANSIColor.pm type=file +c:\perl\lib/Term/Cap.pm type=file +c:\perl\lib/Term/Complete.pm type=file +c:\perl\lib/Term/ReadLine.pm type=file +c:\perl\lib/Term/UI.pm type=file +c:\perl\lib/Term/UI/History.pm type=file +c:\perl\lib/Test.pm type=file +c:\perl\lib/Test/Builder.pm type=file +c:\perl\lib/Test/Builder/Module.pm type=file +c:\perl\lib/Test/Builder/Tester.pm type=file +c:\perl\lib/Test/Builder/Tester/Color.pm type=file +c:\perl\lib/Test/Harness.pm type=file +c:\perl\lib/Test/More.pm type=file +c:\perl\lib/Test/Simple.pm type=file +c:\perl\lib/Test/Tutorial.pod type=file +c:\perl\lib/Text/Abbrev.pm type=file +c:\perl\lib/Text/Balanced.pm type=file +c:\perl\lib/Text/ParseWords.pm type=file +c:\perl\lib/Text/Soundex.pm type=file +c:\perl\lib/Text/Tabs.pm type=file +c:\perl\lib/Text/Wrap.pm type=file +c:\perl\lib/Thread.pm type=file +c:\perl\lib/Thread/Queue.pm type=file +c:\perl\lib/Thread/Semaphore.pm type=file +c:\perl\lib/Tie/Array.pm type=file +c:\perl\lib/Tie/File.pm type=file +c:\perl\lib/Tie/Handle.pm type=file +c:\perl\lib/Tie/Hash.pm type=file +c:\perl\lib/Tie/Hash/NamedCapture.pm type=file +c:\perl\lib/Tie/Memoize.pm type=file +c:\perl\lib/Tie/RefHash.pm type=file +c:\perl\lib/Tie/Scalar.pm type=file +c:\perl\lib/Tie/StdHandle.pm type=file +c:\perl\lib/Tie/SubstrHash.pm type=file +c:\perl\lib/Time/HiRes.pm type=file +c:\perl\lib/Time/Local.pm type=file +c:\perl\lib/Time/Piece.pm type=file +c:\perl\lib/Time/Seconds.pm type=file +c:\perl\lib/Time/gmtime.pm type=file +c:\perl\lib/Time/localtime.pm type=file +c:\perl\lib/Time/tm.pm type=file +c:\perl\lib/UNIVERSAL.pm type=file +c:\perl\lib/Unicode/Collate.pm type=file +c:\perl\lib/Unicode/Collate/allkeys.txt type=file +c:\perl\lib/Unicode/Collate/keys.txt type=file +c:\perl\lib/Unicode/Normalize.pm type=file +c:\perl\lib/Unicode/UCD.pm type=file +c:\perl\lib/User/grent.pm type=file +c:\perl\lib/User/pwent.pm type=file +c:\perl\lib/Win32.pm type=file +c:\perl\lib/Win32API/File.pm type=file +c:\perl\lib/Win32API/File/cFile.pc type=file +c:\perl\lib/Win32CORE.pm type=file +c:\perl\lib/XSLoader.pm type=file +c:\perl\lib/abbrev.pl type=file +c:\perl\lib/assert.pl type=file +c:\perl\lib/attributes.pm type=file +c:\perl\lib/auto/B/B.dll type=file +c:\perl\lib/auto/Compress/Raw/Bzip2/Bzip2.dll type=file +c:\perl\lib/auto/Compress/Raw/Bzip2/autosplit.ix type=file +c:\perl\lib/auto/Compress/Raw/Zlib/Zlib.dll type=file +c:\perl\lib/auto/Compress/Raw/Zlib/autosplit.ix type=file +c:\perl\lib/auto/Compress/Zlib/autosplit.ix type=file +c:\perl\lib/auto/Cwd/Cwd.dll type=file +c:\perl\lib/auto/Data/Dumper/Dumper.dll type=file +c:\perl\lib/auto/Devel/DProf/DProf.dll type=file +c:\perl\lib/auto/Devel/PPPort/PPPort.dll type=file +c:\perl\lib/auto/Devel/Peek/Peek.dll type=file +c:\perl\lib/auto/Digest/MD5/MD5.dll type=file +c:\perl\lib/auto/Digest/SHA/SHA.dll type=file +c:\perl\lib/auto/DynaLoader/autosplit.ix type=file +c:\perl\lib/auto/DynaLoader/dl_expandspec.al type=file +c:\perl\lib/auto/DynaLoader/dl_find_symbol_anywhere.al type=file +c:\perl\lib/auto/DynaLoader/dl_findfile.al type=file +c:\perl\lib/auto/Encode/Byte/Byte.dll type=file +c:\perl\lib/auto/Encode/CN/CN.dll type=file +c:\perl\lib/auto/Encode/EBCDIC/EBCDIC.dll type=file +c:\perl\lib/auto/Encode/Encode.dll type=file +c:\perl\lib/auto/Encode/JP/JP.dll type=file +c:\perl\lib/auto/Encode/KR/KR.dll type=file +c:\perl\lib/auto/Encode/Symbol/Symbol.dll type=file +c:\perl\lib/auto/Encode/TW/TW.dll type=file +c:\perl\lib/auto/Encode/Unicode/Unicode.dll type=file +c:\perl\lib/auto/Fcntl/Fcntl.dll type=file +c:\perl\lib/auto/File/Glob/Glob.dll type=file +c:\perl\lib/auto/Filter/Util/Call/Call.dll type=file +c:\perl\lib/auto/Hash/Util/FieldHash/FieldHash.dll type=file +c:\perl\lib/auto/Hash/Util/Util.dll type=file +c:\perl\lib/auto/IO/IO.dll type=file +c:\perl\lib/auto/List/Util/Util.dll type=file +c:\perl\lib/auto/MIME/Base64/Base64.dll type=file +c:\perl\lib/auto/Math/BigInt/FastCalc/FastCalc.dll type=file +c:\perl\lib/auto/Opcode/Opcode.dll type=file +c:\perl\lib/auto/POSIX/POSIX.dll type=file +c:\perl\lib/auto/POSIX/SigAction/flags.al type=file +c:\perl\lib/auto/POSIX/SigAction/handler.al type=file +c:\perl\lib/auto/POSIX/SigAction/mask.al type=file +c:\perl\lib/auto/POSIX/SigAction/new.al type=file +c:\perl\lib/auto/POSIX/SigAction/safe.al type=file +c:\perl\lib/auto/POSIX/SigRt/CLEAR.al type=file +c:\perl\lib/auto/POSIX/SigRt/DELETE.al type=file +c:\perl\lib/auto/POSIX/SigRt/EXISTS.al type=file +c:\perl\lib/auto/POSIX/SigRt/FETCH.al type=file +c:\perl\lib/auto/POSIX/SigRt/SCALAR.al type=file +c:\perl\lib/auto/POSIX/SigRt/STORE.al type=file +c:\perl\lib/auto/POSIX/SigRt/_check.al type=file +c:\perl\lib/auto/POSIX/SigRt/_croak.al type=file +c:\perl\lib/auto/POSIX/SigRt/_exist.al type=file +c:\perl\lib/auto/POSIX/SigRt/_getsig.al type=file +c:\perl\lib/auto/POSIX/SigRt/_init.al type=file +c:\perl\lib/auto/POSIX/SigRt/new.al type=file +c:\perl\lib/auto/POSIX/abs.al type=file +c:\perl\lib/auto/POSIX/alarm.al type=file +c:\perl\lib/auto/POSIX/assert.al type=file +c:\perl\lib/auto/POSIX/atan2.al type=file +c:\perl\lib/auto/POSIX/atexit.al type=file +c:\perl\lib/auto/POSIX/atof.al type=file +c:\perl\lib/auto/POSIX/atoi.al type=file +c:\perl\lib/auto/POSIX/atol.al type=file +c:\perl\lib/auto/POSIX/autosplit.ix type=file +c:\perl\lib/auto/POSIX/bsearch.al type=file +c:\perl\lib/auto/POSIX/calloc.al type=file +c:\perl\lib/auto/POSIX/chdir.al type=file +c:\perl\lib/auto/POSIX/chmod.al type=file +c:\perl\lib/auto/POSIX/chown.al type=file +c:\perl\lib/auto/POSIX/clearerr.al type=file +c:\perl\lib/auto/POSIX/closedir.al type=file +c:\perl\lib/auto/POSIX/cos.al type=file +c:\perl\lib/auto/POSIX/creat.al type=file +c:\perl\lib/auto/POSIX/div.al type=file +c:\perl\lib/auto/POSIX/errno.al type=file +c:\perl\lib/auto/POSIX/execl.al type=file +c:\perl\lib/auto/POSIX/execle.al type=file +c:\perl\lib/auto/POSIX/execlp.al type=file +c:\perl\lib/auto/POSIX/execv.al type=file +c:\perl\lib/auto/POSIX/execve.al type=file +c:\perl\lib/auto/POSIX/execvp.al type=file +c:\perl\lib/auto/POSIX/exit.al type=file +c:\perl\lib/auto/POSIX/exp.al type=file +c:\perl\lib/auto/POSIX/fabs.al type=file +c:\perl\lib/auto/POSIX/fclose.al type=file +c:\perl\lib/auto/POSIX/fcntl.al type=file +c:\perl\lib/auto/POSIX/fdopen.al type=file +c:\perl\lib/auto/POSIX/feof.al type=file +c:\perl\lib/auto/POSIX/ferror.al type=file +c:\perl\lib/auto/POSIX/fflush.al type=file +c:\perl\lib/auto/POSIX/fgetc.al type=file +c:\perl\lib/auto/POSIX/fgetpos.al type=file +c:\perl\lib/auto/POSIX/fgets.al type=file +c:\perl\lib/auto/POSIX/fileno.al type=file +c:\perl\lib/auto/POSIX/fopen.al type=file +c:\perl\lib/auto/POSIX/fork.al type=file +c:\perl\lib/auto/POSIX/fprintf.al type=file +c:\perl\lib/auto/POSIX/fputc.al type=file +c:\perl\lib/auto/POSIX/fputs.al type=file +c:\perl\lib/auto/POSIX/fread.al type=file +c:\perl\lib/auto/POSIX/free.al type=file +c:\perl\lib/auto/POSIX/freopen.al type=file +c:\perl\lib/auto/POSIX/fscanf.al type=file +c:\perl\lib/auto/POSIX/fseek.al type=file +c:\perl\lib/auto/POSIX/fsetpos.al type=file +c:\perl\lib/auto/POSIX/fstat.al type=file +c:\perl\lib/auto/POSIX/fsync.al type=file +c:\perl\lib/auto/POSIX/ftell.al type=file +c:\perl\lib/auto/POSIX/fwrite.al type=file +c:\perl\lib/auto/POSIX/getc.al type=file +c:\perl\lib/auto/POSIX/getchar.al type=file +c:\perl\lib/auto/POSIX/getegid.al type=file +c:\perl\lib/auto/POSIX/getenv.al type=file +c:\perl\lib/auto/POSIX/geteuid.al type=file +c:\perl\lib/auto/POSIX/getgid.al type=file +c:\perl\lib/auto/POSIX/getgrgid.al type=file +c:\perl\lib/auto/POSIX/getgrnam.al type=file +c:\perl\lib/auto/POSIX/getgroups.al type=file +c:\perl\lib/auto/POSIX/getlogin.al type=file +c:\perl\lib/auto/POSIX/getpgrp.al type=file +c:\perl\lib/auto/POSIX/getpid.al type=file +c:\perl\lib/auto/POSIX/getppid.al type=file +c:\perl\lib/auto/POSIX/getpwnam.al type=file +c:\perl\lib/auto/POSIX/getpwuid.al type=file +c:\perl\lib/auto/POSIX/gets.al type=file +c:\perl\lib/auto/POSIX/getuid.al type=file +c:\perl\lib/auto/POSIX/gmtime.al type=file +c:\perl\lib/auto/POSIX/isatty.al type=file +c:\perl\lib/auto/POSIX/kill.al type=file +c:\perl\lib/auto/POSIX/labs.al type=file +c:\perl\lib/auto/POSIX/ldiv.al type=file +c:\perl\lib/auto/POSIX/link.al type=file +c:\perl\lib/auto/POSIX/load_imports.al type=file +c:\perl\lib/auto/POSIX/localtime.al type=file +c:\perl\lib/auto/POSIX/log.al type=file +c:\perl\lib/auto/POSIX/longjmp.al type=file +c:\perl\lib/auto/POSIX/malloc.al type=file +c:\perl\lib/auto/POSIX/memchr.al type=file +c:\perl\lib/auto/POSIX/memcmp.al type=file +c:\perl\lib/auto/POSIX/memcpy.al type=file +c:\perl\lib/auto/POSIX/memmove.al type=file +c:\perl\lib/auto/POSIX/memset.al type=file +c:\perl\lib/auto/POSIX/mkdir.al type=file +c:\perl\lib/auto/POSIX/offsetof.al type=file +c:\perl\lib/auto/POSIX/opendir.al type=file +c:\perl\lib/auto/POSIX/perror.al type=file +c:\perl\lib/auto/POSIX/pow.al type=file +c:\perl\lib/auto/POSIX/printf.al type=file +c:\perl\lib/auto/POSIX/putc.al type=file +c:\perl\lib/auto/POSIX/putchar.al type=file +c:\perl\lib/auto/POSIX/puts.al type=file +c:\perl\lib/auto/POSIX/qsort.al type=file +c:\perl\lib/auto/POSIX/raise.al type=file +c:\perl\lib/auto/POSIX/rand.al type=file +c:\perl\lib/auto/POSIX/readdir.al type=file +c:\perl\lib/auto/POSIX/realloc.al type=file +c:\perl\lib/auto/POSIX/redef.al type=file +c:\perl\lib/auto/POSIX/remove.al type=file +c:\perl\lib/auto/POSIX/rename.al type=file +c:\perl\lib/auto/POSIX/rewind.al type=file +c:\perl\lib/auto/POSIX/rewinddir.al type=file +c:\perl\lib/auto/POSIX/rmdir.al type=file +c:\perl\lib/auto/POSIX/scanf.al type=file +c:\perl\lib/auto/POSIX/setbuf.al type=file +c:\perl\lib/auto/POSIX/setjmp.al type=file +c:\perl\lib/auto/POSIX/setvbuf.al type=file +c:\perl\lib/auto/POSIX/siglongjmp.al type=file +c:\perl\lib/auto/POSIX/sigsetjmp.al type=file +c:\perl\lib/auto/POSIX/sin.al type=file +c:\perl\lib/auto/POSIX/sleep.al type=file +c:\perl\lib/auto/POSIX/sprintf.al type=file +c:\perl\lib/auto/POSIX/sqrt.al type=file +c:\perl\lib/auto/POSIX/srand.al type=file +c:\perl\lib/auto/POSIX/sscanf.al type=file +c:\perl\lib/auto/POSIX/stat.al type=file +c:\perl\lib/auto/POSIX/strcat.al type=file +c:\perl\lib/auto/POSIX/strchr.al type=file +c:\perl\lib/auto/POSIX/strcmp.al type=file +c:\perl\lib/auto/POSIX/strcpy.al type=file +c:\perl\lib/auto/POSIX/strcspn.al type=file +c:\perl\lib/auto/POSIX/strerror.al type=file +c:\perl\lib/auto/POSIX/strlen.al type=file +c:\perl\lib/auto/POSIX/strncat.al type=file +c:\perl\lib/auto/POSIX/strncmp.al type=file +c:\perl\lib/auto/POSIX/strncpy.al type=file +c:\perl\lib/auto/POSIX/strpbrk.al type=file +c:\perl\lib/auto/POSIX/strrchr.al type=file +c:\perl\lib/auto/POSIX/strspn.al type=file +c:\perl\lib/auto/POSIX/strstr.al type=file +c:\perl\lib/auto/POSIX/strtok.al type=file +c:\perl\lib/auto/POSIX/system.al type=file +c:\perl\lib/auto/POSIX/time.al type=file +c:\perl\lib/auto/POSIX/tmpfile.al type=file +c:\perl\lib/auto/POSIX/tolower.al type=file +c:\perl\lib/auto/POSIX/toupper.al type=file +c:\perl\lib/auto/POSIX/umask.al type=file +c:\perl\lib/auto/POSIX/ungetc.al type=file +c:\perl\lib/auto/POSIX/unimpl.al type=file +c:\perl\lib/auto/POSIX/unlink.al type=file +c:\perl\lib/auto/POSIX/usage.al type=file +c:\perl\lib/auto/POSIX/utime.al type=file +c:\perl\lib/auto/POSIX/vfprintf.al type=file +c:\perl\lib/auto/POSIX/vprintf.al type=file +c:\perl\lib/auto/POSIX/vsprintf.al type=file +c:\perl\lib/auto/POSIX/wait.al type=file +c:\perl\lib/auto/POSIX/waitpid.al type=file +c:\perl\lib/auto/PerlIO/encoding/encoding.dll type=file +c:\perl\lib/auto/PerlIO/scalar/scalar.dll type=file +c:\perl\lib/auto/PerlIO/via/via.dll type=file +c:\perl\lib/auto/SDBM_File/SDBM_File.dll type=file +c:\perl\lib/auto/Socket/Socket.dll type=file +c:\perl\lib/auto/Storable/BIN_VERSION_NV.al type=file +c:\perl\lib/auto/Storable/BIN_WRITE_VERSION_NV.al type=file +c:\perl\lib/auto/Storable/CAN_FLOCK.al type=file +c:\perl\lib/auto/Storable/Storable.dll type=file +c:\perl\lib/auto/Storable/_freeze.al type=file +c:\perl\lib/auto/Storable/_retrieve.al type=file +c:\perl\lib/auto/Storable/_store.al type=file +c:\perl\lib/auto/Storable/_store_fd.al type=file +c:\perl\lib/auto/Storable/autosplit.ix type=file +c:\perl\lib/auto/Storable/fd_retrieve.al type=file +c:\perl\lib/auto/Storable/file_magic.al type=file +c:\perl\lib/auto/Storable/freeze.al type=file +c:\perl\lib/auto/Storable/lock_nstore.al type=file +c:\perl\lib/auto/Storable/lock_retrieve.al type=file +c:\perl\lib/auto/Storable/lock_store.al type=file +c:\perl\lib/auto/Storable/logcarp.al type=file +c:\perl\lib/auto/Storable/logcroak.al type=file +c:\perl\lib/auto/Storable/nfreeze.al type=file +c:\perl\lib/auto/Storable/nstore.al type=file +c:\perl\lib/auto/Storable/nstore_fd.al type=file +c:\perl\lib/auto/Storable/read_magic.al type=file +c:\perl\lib/auto/Storable/retrieve.al type=file +c:\perl\lib/auto/Storable/show_file_magic.al type=file +c:\perl\lib/auto/Storable/store.al type=file +c:\perl\lib/auto/Storable/store_fd.al type=file +c:\perl\lib/auto/Storable/thaw.al type=file +c:\perl\lib/auto/Sys/Hostname/Hostname.dll type=file +c:\perl\lib/auto/Sys/Hostname/autosplit.ix type=file +c:\perl\lib/auto/Text/Soundex/Soundex.dll type=file +c:\perl\lib/auto/Time/HiRes/HiRes.dll type=file +c:\perl\lib/auto/Time/Piece/Piece.dll type=file +c:\perl\lib/auto/Unicode/Normalize/Normalize.dll type=file +c:\perl\lib/auto/Win32/Win32.dll type=file +c:\perl\lib/auto/Win32API/File/File.dll type=file +c:\perl\lib/auto/Win32CORE/extralibs.ld type=file +c:\perl\lib/auto/attributes/attributes.dll type=file +c:\perl\lib/auto/mro/mro.dll type=file +c:\perl\lib/auto/re/re.dll type=file +c:\perl\lib/auto/sdbm/extralibs.ld type=file +c:\perl\lib/auto/threads/shared/shared.dll type=file +c:\perl\lib/auto/threads/threads.dll type=file +c:\perl\lib/autodie.pm type=file +c:\perl\lib/autodie/exception.pm type=file +c:\perl\lib/autodie/exception/system.pm type=file +c:\perl\lib/autodie/hints.pm type=file +c:\perl\lib/autouse.pm type=file +c:\perl\lib/base.pm type=file +c:\perl\lib/bigfloat.pl type=file +c:\perl\lib/bigint.pl type=file +c:\perl\lib/bigint.pm type=file +c:\perl\lib/bignum.pm type=file +c:\perl\lib/bigrat.pl type=file +c:\perl\lib/bigrat.pm type=file +c:\perl\lib/blib.pm type=file +c:\perl\lib/bytes.pm type=file +c:\perl\lib/bytes_heavy.pl type=file +c:\perl\lib/cacheout.pl type=file +c:\perl\lib/charnames.pm type=file +c:\perl\lib/complete.pl type=file +c:\perl\lib/constant.pm type=file +c:\perl\lib/ctime.pl type=file +c:\perl\lib/deprecate.pm type=file +c:\perl\lib/diagnostics.pm type=file +c:\perl\lib/dotsh.pl type=file +c:\perl\lib/dumpvar.pl type=file +c:\perl\lib/encoding.pm type=file +c:\perl\lib/encoding/warnings.pm type=file +c:\perl\lib/exceptions.pl type=file +c:\perl\lib/fastcwd.pl type=file +c:\perl\lib/feature.pm type=file +c:\perl\lib/fields.pm type=file +c:\perl\lib/filetest.pm type=file +c:\perl\lib/find.pl type=file +c:\perl\lib/finddepth.pl type=file +c:\perl\lib/flush.pl type=file +c:\perl\lib/getcwd.pl type=file +c:\perl\lib/getopt.pl type=file +c:\perl\lib/getopts.pl type=file +c:\perl\lib/hostname.pl type=file +c:\perl\lib/if.pm type=file +c:\perl\lib/importenv.pl type=file +c:\perl\lib/inc/latest.pm type=file +c:\perl\lib/inc/latest/private.pm type=file +c:\perl\lib/integer.pm type=file +c:\perl\lib/less.pm type=file +c:\perl\lib/lib.pm type=file +c:\perl\lib/locale.pm type=file +c:\perl\lib/look.pl type=file +c:\perl\lib/mro.pm type=file +c:\perl\lib/newgetopt.pl type=file +c:\perl\lib/open.pm type=file +c:\perl\lib/open2.pl type=file +c:\perl\lib/open3.pl type=file +c:\perl\lib/ops.pm type=file +c:\perl\lib/overload.pm type=file +c:\perl\lib/overload/numbers.pm type=file +c:\perl\lib/overloading.pm type=file +c:\perl\lib/parent.pm type=file +c:\perl\lib/perl5db.pl type=file +c:\perl\lib/pods/a2p.pod type=file +c:\perl\lib/pods/perl.pod type=file +c:\perl\lib/pods/perl5004delta.pod type=file +c:\perl\lib/pods/perl5005delta.pod type=file +c:\perl\lib/pods/perl5100delta.pod type=file +c:\perl\lib/pods/perl5101delta.pod type=file +c:\perl\lib/pods/perl5110delta.pod type=file +c:\perl\lib/pods/perl5111delta.pod type=file +c:\perl\lib/pods/perl5112delta.pod type=file +c:\perl\lib/pods/perl5113delta.pod type=file +c:\perl\lib/pods/perl5114delta.pod type=file +c:\perl\lib/pods/perl5115delta.pod type=file +c:\perl\lib/pods/perl5120delta.pod type=file +c:\perl\lib/pods/perl5121delta.pod type=file +c:\perl\lib/pods/perl5122delta.pod type=file +c:\perl\lib/pods/perl5123delta.pod type=file +c:\perl\lib/pods/perl561delta.pod type=file +c:\perl\lib/pods/perl56delta.pod type=file +c:\perl\lib/pods/perl570delta.pod type=file +c:\perl\lib/pods/perl571delta.pod type=file +c:\perl\lib/pods/perl572delta.pod type=file +c:\perl\lib/pods/perl573delta.pod type=file +c:\perl\lib/pods/perl581delta.pod type=file +c:\perl\lib/pods/perl582delta.pod type=file +c:\perl\lib/pods/perl583delta.pod type=file +c:\perl\lib/pods/perl584delta.pod type=file +c:\perl\lib/pods/perl585delta.pod type=file +c:\perl\lib/pods/perl586delta.pod type=file +c:\perl\lib/pods/perl587delta.pod type=file +c:\perl\lib/pods/perl588delta.pod type=file +c:\perl\lib/pods/perl589delta.pod type=file +c:\perl\lib/pods/perl58delta.pod type=file +c:\perl\lib/pods/perl590delta.pod type=file +c:\perl\lib/pods/perl591delta.pod type=file +c:\perl\lib/pods/perl592delta.pod type=file +c:\perl\lib/pods/perl593delta.pod type=file +c:\perl\lib/pods/perl594delta.pod type=file +c:\perl\lib/pods/perl595delta.pod type=file +c:\perl\lib/pods/perlaix.pod type=file +c:\perl\lib/pods/perlamiga.pod type=file +c:\perl\lib/pods/perlapi.pod type=file +c:\perl\lib/pods/perlapio.pod type=file +c:\perl\lib/pods/perlapollo.pod type=file +c:\perl\lib/pods/perlartistic.pod type=file +c:\perl\lib/pods/perlbeos.pod type=file +c:\perl\lib/pods/perlbook.pod type=file +c:\perl\lib/pods/perlboot.pod type=file +c:\perl\lib/pods/perlbot.pod type=file +c:\perl\lib/pods/perlbs2000.pod type=file +c:\perl\lib/pods/perlcall.pod type=file +c:\perl\lib/pods/perlce.pod type=file +c:\perl\lib/pods/perlcheat.pod type=file +c:\perl\lib/pods/perlclib.pod type=file +c:\perl\lib/pods/perlcn.pod type=file +c:\perl\lib/pods/perlcommunity.pod type=file +c:\perl\lib/pods/perlcompile.pod type=file +c:\perl\lib/pods/perlcygwin.pod type=file +c:\perl\lib/pods/perldata.pod type=file +c:\perl\lib/pods/perldbmfilter.pod type=file +c:\perl\lib/pods/perldebguts.pod type=file +c:\perl\lib/pods/perldebtut.pod type=file +c:\perl\lib/pods/perldebug.pod type=file +c:\perl\lib/pods/perldelta.pod type=file +c:\perl\lib/pods/perldgux.pod type=file +c:\perl\lib/pods/perldiag.pod type=file +c:\perl\lib/pods/perldoc.pod type=file +c:\perl\lib/pods/perldos.pod type=file +c:\perl\lib/pods/perldsc.pod type=file +c:\perl\lib/pods/perlebcdic.pod type=file +c:\perl\lib/pods/perlembed.pod type=file +c:\perl\lib/pods/perlepoc.pod type=file +c:\perl\lib/pods/perlfaq.pod type=file +c:\perl\lib/pods/perlfaq1.pod type=file +c:\perl\lib/pods/perlfaq2.pod type=file +c:\perl\lib/pods/perlfaq3.pod type=file +c:\perl\lib/pods/perlfaq4.pod type=file +c:\perl\lib/pods/perlfaq5.pod type=file +c:\perl\lib/pods/perlfaq6.pod type=file +c:\perl\lib/pods/perlfaq7.pod type=file +c:\perl\lib/pods/perlfaq8.pod type=file +c:\perl\lib/pods/perlfaq9.pod type=file +c:\perl\lib/pods/perlfilter.pod type=file +c:\perl\lib/pods/perlfork.pod type=file +c:\perl\lib/pods/perlform.pod type=file +c:\perl\lib/pods/perlfreebsd.pod type=file +c:\perl\lib/pods/perlfunc.pod type=file +c:\perl\lib/pods/perlglossary.pod type=file +c:\perl\lib/pods/perlgpl.pod type=file +c:\perl\lib/pods/perlguts.pod type=file +c:\perl\lib/pods/perlhack.pod type=file +c:\perl\lib/pods/perlhaiku.pod type=file +c:\perl\lib/pods/perlhist.pod type=file +c:\perl\lib/pods/perlhpux.pod type=file +c:\perl\lib/pods/perlhurd.pod type=file +c:\perl\lib/pods/perlintern.pod type=file +c:\perl\lib/pods/perlintro.pod type=file +c:\perl\lib/pods/perliol.pod type=file +c:\perl\lib/pods/perlipc.pod type=file +c:\perl\lib/pods/perlirix.pod type=file +c:\perl\lib/pods/perljp.pod type=file +c:\perl\lib/pods/perlko.pod type=file +c:\perl\lib/pods/perllexwarn.pod type=file +c:\perl\lib/pods/perllinux.pod type=file +c:\perl\lib/pods/perllocale.pod type=file +c:\perl\lib/pods/perllol.pod type=file +c:\perl\lib/pods/perlmacos.pod type=file +c:\perl\lib/pods/perlmacosx.pod type=file +c:\perl\lib/pods/perlmod.pod type=file +c:\perl\lib/pods/perlmodinstall.pod type=file +c:\perl\lib/pods/perlmodlib.pod type=file +c:\perl\lib/pods/perlmodstyle.pod type=file +c:\perl\lib/pods/perlmpeix.pod type=file +c:\perl\lib/pods/perlmroapi.pod type=file +c:\perl\lib/pods/perlnetware.pod type=file +c:\perl\lib/pods/perlnewmod.pod type=file +c:\perl\lib/pods/perlnumber.pod type=file +c:\perl\lib/pods/perlobj.pod type=file +c:\perl\lib/pods/perlop.pod type=file +c:\perl\lib/pods/perlopenbsd.pod type=file +c:\perl\lib/pods/perlopentut.pod type=file +c:\perl\lib/pods/perlos2.pod type=file +c:\perl\lib/pods/perlos390.pod type=file +c:\perl\lib/pods/perlos400.pod type=file +c:\perl\lib/pods/perlpacktut.pod type=file +c:\perl\lib/pods/perlperf.pod type=file +c:\perl\lib/pods/perlplan9.pod type=file +c:\perl\lib/pods/perlpod.pod type=file +c:\perl\lib/pods/perlpodspec.pod type=file +c:\perl\lib/pods/perlpolicy.pod type=file +c:\perl\lib/pods/perlport.pod type=file +c:\perl\lib/pods/perlpragma.pod type=file +c:\perl\lib/pods/perlqnx.pod type=file +c:\perl\lib/pods/perlre.pod type=file +c:\perl\lib/pods/perlreapi.pod type=file +c:\perl\lib/pods/perlrebackslash.pod type=file +c:\perl\lib/pods/perlrecharclass.pod type=file +c:\perl\lib/pods/perlref.pod type=file +c:\perl\lib/pods/perlreftut.pod type=file +c:\perl\lib/pods/perlreguts.pod type=file +c:\perl\lib/pods/perlrepository.pod type=file +c:\perl\lib/pods/perlrequick.pod type=file +c:\perl\lib/pods/perlreref.pod type=file +c:\perl\lib/pods/perlretut.pod type=file +c:\perl\lib/pods/perlriscos.pod type=file +c:\perl\lib/pods/perlrun.pod type=file +c:\perl\lib/pods/perlsec.pod type=file +c:\perl\lib/pods/perlsolaris.pod type=file +c:\perl\lib/pods/perlstyle.pod type=file +c:\perl\lib/pods/perlsub.pod type=file +c:\perl\lib/pods/perlsymbian.pod type=file +c:\perl\lib/pods/perlsyn.pod type=file +c:\perl\lib/pods/perlthrtut.pod type=file +c:\perl\lib/pods/perltie.pod type=file +c:\perl\lib/pods/perltoc.pod type=file +c:\perl\lib/pods/perltodo.pod type=file +c:\perl\lib/pods/perltooc.pod type=file +c:\perl\lib/pods/perltoot.pod type=file +c:\perl\lib/pods/perltrap.pod type=file +c:\perl\lib/pods/perltru64.pod type=file +c:\perl\lib/pods/perltw.pod type=file +c:\perl\lib/pods/perlunicode.pod type=file +c:\perl\lib/pods/perlunifaq.pod type=file +c:\perl\lib/pods/perluniintro.pod type=file +c:\perl\lib/pods/perluniprops.pod type=file +c:\perl\lib/pods/perlunitut.pod type=file +c:\perl\lib/pods/perlutil.pod type=file +c:\perl\lib/pods/perluts.pod type=file +c:\perl\lib/pods/perlvar.pod type=file +c:\perl\lib/pods/perlvmesa.pod type=file +c:\perl\lib/pods/perlvms.pod type=file +c:\perl\lib/pods/perlvos.pod type=file +c:\perl\lib/pods/perlwin32.pod type=file +c:\perl\lib/pods/perlxs.pod type=file +c:\perl\lib/pods/perlxstut.pod type=file +c:\perl\lib/pwd.pl type=file +c:\perl\lib/re.pm type=file +c:\perl\lib/shellwords.pl type=file +c:\perl\lib/sigtrap.pm type=file +c:\perl\lib/sort.pm type=file +c:\perl\lib/stat.pl type=file +c:\perl\lib/strict.pm type=file +c:\perl\lib/subs.pm type=file +c:\perl\lib/syslog.pl type=file +c:\perl\lib/tainted.pl type=file +c:\perl\lib/termcap.pl type=file +c:\perl\lib/threads.pm type=file +c:\perl\lib/threads/shared.pm type=file +c:\perl\lib/timelocal.pl type=file +c:\perl\lib/unicore/ArabicShaping.txt type=file +c:\perl\lib/unicore/BidiMirroring.txt type=file +c:\perl\lib/unicore/Blocks.txt type=file +c:\perl\lib/unicore/CJKRadicals.txt type=file +c:\perl\lib/unicore/CaseFolding.txt type=file +c:\perl\lib/unicore/CombiningClass.pl type=file +c:\perl\lib/unicore/CompositionExclusions.txt type=file +c:\perl\lib/unicore/DAge.txt type=file +c:\perl\lib/unicore/DCoreProperties.txt type=file +c:\perl\lib/unicore/DNormalizationProps.txt type=file +c:\perl\lib/unicore/Decomposition.pl type=file +c:\perl\lib/unicore/EastAsianWidth.txt type=file +c:\perl\lib/unicore/HangulSyllableType.txt type=file +c:\perl\lib/unicore/Heavy.pl type=file +c:\perl\lib/unicore/Index.txt type=file +c:\perl\lib/unicore/Jamo.txt type=file +c:\perl\lib/unicore/LineBreak.txt type=file +c:\perl\lib/unicore/Name.pl type=file +c:\perl\lib/unicore/NameAliases.txt type=file +c:\perl\lib/unicore/NamedSequences.txt type=file +c:\perl\lib/unicore/NamedSqProv.txt type=file +c:\perl\lib/unicore/NamesList.txt type=file +c:\perl\lib/unicore/NormalizationCorrections.txt type=file +c:\perl\lib/unicore/PropList.txt type=file +c:\perl\lib/unicore/PropValueAliases.txt type=file +c:\perl\lib/unicore/PropertyAliases.txt type=file +c:\perl\lib/unicore/ReadMe.txt type=file +c:\perl\lib/unicore/Scripts.txt type=file +c:\perl\lib/unicore/SpecialCasing.txt type=file +c:\perl\lib/unicore/StandardizedVariants.txt type=file +c:\perl\lib/unicore/TestProp.pl type=file +c:\perl\lib/unicore/To/Bmg.pl type=file +c:\perl\lib/unicore/To/Digit.pl type=file +c:\perl\lib/unicore/To/Fold.pl type=file +c:\perl\lib/unicore/To/Lower.pl type=file +c:\perl\lib/unicore/To/NFKCCF.pl type=file +c:\perl\lib/unicore/To/Title.pl type=file +c:\perl\lib/unicore/To/Upper.pl type=file +c:\perl\lib/unicore/UnicodeData.txt type=file +c:\perl\lib/unicore/auxiliary/GCBTest.txt type=file +c:\perl\lib/unicore/auxiliary/GraphemeBreakProperty.txt type=file +c:\perl\lib/unicore/auxiliary/SentenceBreakProperty.txt type=file +c:\perl\lib/unicore/auxiliary/WordBreakProperty.txt type=file +c:\perl\lib/unicore/extracted/DBidiClass.txt type=file +c:\perl\lib/unicore/extracted/DBinaryProperties.txt type=file +c:\perl\lib/unicore/extracted/DCombiningClass.txt type=file +c:\perl\lib/unicore/extracted/DDecompositionType.txt type=file +c:\perl\lib/unicore/extracted/DEastAsianWidth.txt type=file +c:\perl\lib/unicore/extracted/DGeneralCategory.txt type=file +c:\perl\lib/unicore/extracted/DJoinGroup.txt type=file +c:\perl\lib/unicore/extracted/DJoinType.txt type=file +c:\perl\lib/unicore/extracted/DLineBreak.txt type=file +c:\perl\lib/unicore/extracted/DNumType.txt type=file +c:\perl\lib/unicore/extracted/DNumValues.txt type=file +c:\perl\lib/unicore/lib/AHex/N.pl type=file +c:\perl\lib/unicore/lib/AHex/Y.pl type=file +c:\perl\lib/unicore/lib/Age/1_1.pl type=file +c:\perl\lib/unicore/lib/Age/2_0.pl type=file +c:\perl\lib/unicore/lib/Age/2_1.pl type=file +c:\perl\lib/unicore/lib/Age/3_0.pl type=file +c:\perl\lib/unicore/lib/Age/3_1.pl type=file +c:\perl\lib/unicore/lib/Age/3_2.pl type=file +c:\perl\lib/unicore/lib/Age/4_0.pl type=file +c:\perl\lib/unicore/lib/Age/4_1.pl type=file +c:\perl\lib/unicore/lib/Age/5_0.pl type=file +c:\perl\lib/unicore/lib/Age/5_1.pl type=file +c:\perl\lib/unicore/lib/Age/5_2.pl type=file +c:\perl\lib/unicore/lib/Age/Unassign.pl type=file +c:\perl\lib/unicore/lib/Alpha/N.pl type=file +c:\perl\lib/unicore/lib/Alpha/Y.pl type=file +c:\perl\lib/unicore/lib/Bc/AL.pl type=file +c:\perl\lib/unicore/lib/Bc/AN.pl type=file +c:\perl\lib/unicore/lib/Bc/B.pl type=file +c:\perl\lib/unicore/lib/Bc/BN.pl type=file +c:\perl\lib/unicore/lib/Bc/CS.pl type=file +c:\perl\lib/unicore/lib/Bc/EN.pl type=file +c:\perl\lib/unicore/lib/Bc/ES.pl type=file +c:\perl\lib/unicore/lib/Bc/ET.pl type=file +c:\perl\lib/unicore/lib/Bc/L.pl type=file +c:\perl\lib/unicore/lib/Bc/LRE.pl type=file +c:\perl\lib/unicore/lib/Bc/LRO.pl type=file +c:\perl\lib/unicore/lib/Bc/NSM.pl type=file +c:\perl\lib/unicore/lib/Bc/ON.pl type=file +c:\perl\lib/unicore/lib/Bc/PDF.pl type=file +c:\perl\lib/unicore/lib/Bc/R.pl type=file +c:\perl\lib/unicore/lib/Bc/RLE.pl type=file +c:\perl\lib/unicore/lib/Bc/RLO.pl type=file +c:\perl\lib/unicore/lib/Bc/S.pl type=file +c:\perl\lib/unicore/lib/Bc/WS.pl type=file +c:\perl\lib/unicore/lib/BidiC/N.pl type=file +c:\perl\lib/unicore/lib/BidiC/Y.pl type=file +c:\perl\lib/unicore/lib/BidiM/N.pl type=file +c:\perl\lib/unicore/lib/BidiM/Y.pl type=file +c:\perl\lib/unicore/lib/Blk/ASCII.pl type=file +c:\perl\lib/unicore/lib/Blk/AegeanNu.pl type=file +c:\perl\lib/unicore/lib/Blk/Alphabet.pl type=file +c:\perl\lib/unicore/lib/Blk/Ancient2.pl type=file +c:\perl\lib/unicore/lib/Blk/AncientG.pl type=file +c:\perl\lib/unicore/lib/Blk/AncientS.pl type=file +c:\perl\lib/unicore/lib/Blk/Arabic.pl type=file +c:\perl\lib/unicore/lib/Blk/ArabicP2.pl type=file +c:\perl\lib/unicore/lib/Blk/ArabicPr.pl type=file +c:\perl\lib/unicore/lib/Blk/ArabicSu.pl type=file +c:\perl\lib/unicore/lib/Blk/Armenian.pl type=file +c:\perl\lib/unicore/lib/Blk/Arrows.pl type=file +c:\perl\lib/unicore/lib/Blk/Avestan.pl type=file +c:\perl\lib/unicore/lib/Blk/Balinese.pl type=file +c:\perl\lib/unicore/lib/Blk/Bamum.pl type=file +c:\perl\lib/unicore/lib/Blk/Bengali.pl type=file +c:\perl\lib/unicore/lib/Blk/BlockEle.pl type=file +c:\perl\lib/unicore/lib/Blk/Bopomof2.pl type=file +c:\perl\lib/unicore/lib/Blk/Bopomofo.pl type=file +c:\perl\lib/unicore/lib/Blk/BoxDrawi.pl type=file +c:\perl\lib/unicore/lib/Blk/BrailleP.pl type=file +c:\perl\lib/unicore/lib/Blk/Buginese.pl type=file +c:\perl\lib/unicore/lib/Blk/Buhid.pl type=file +c:\perl\lib/unicore/lib/Blk/Byzantin.pl type=file +c:\perl\lib/unicore/lib/Blk/CJKComp2.pl type=file +c:\perl\lib/unicore/lib/Blk/CJKComp3.pl type=file +c:\perl\lib/unicore/lib/Blk/CJKComp4.pl type=file +c:\perl\lib/unicore/lib/Blk/CJKCompa.pl type=file +c:\perl\lib/unicore/lib/Blk/CJKRadic.pl type=file +c:\perl\lib/unicore/lib/Blk/CJKStrok.pl type=file +c:\perl\lib/unicore/lib/Blk/CJKSymbo.pl type=file +c:\perl\lib/unicore/lib/Blk/CJKUnif2.pl type=file +c:\perl\lib/unicore/lib/Blk/CJKUnif3.pl type=file +c:\perl\lib/unicore/lib/Blk/CJKUnif4.pl type=file +c:\perl\lib/unicore/lib/Blk/CJKUnifi.pl type=file +c:\perl\lib/unicore/lib/Blk/Canadian.pl type=file +c:\perl\lib/unicore/lib/Blk/Carian.pl type=file +c:\perl\lib/unicore/lib/Blk/Cham.pl type=file +c:\perl\lib/unicore/lib/Blk/Cherokee.pl type=file +c:\perl\lib/unicore/lib/Blk/Combini2.pl type=file +c:\perl\lib/unicore/lib/Blk/Combini3.pl type=file +c:\perl\lib/unicore/lib/Blk/Combini4.pl type=file +c:\perl\lib/unicore/lib/Blk/Combinin.pl type=file +c:\perl\lib/unicore/lib/Blk/CommonIn.pl type=file +c:\perl\lib/unicore/lib/Blk/ControlP.pl type=file +c:\perl\lib/unicore/lib/Blk/Coptic.pl type=file +c:\perl\lib/unicore/lib/Blk/Counting.pl type=file +c:\perl\lib/unicore/lib/Blk/Cuneifo2.pl type=file +c:\perl\lib/unicore/lib/Blk/Cuneifor.pl type=file +c:\perl\lib/unicore/lib/Blk/Currency.pl type=file +c:\perl\lib/unicore/lib/Blk/CypriotS.pl type=file +c:\perl\lib/unicore/lib/Blk/Cyrilli2.pl type=file +c:\perl\lib/unicore/lib/Blk/Cyrilli3.pl type=file +c:\perl\lib/unicore/lib/Blk/Cyrilli4.pl type=file +c:\perl\lib/unicore/lib/Blk/Cyrillic.pl type=file +c:\perl\lib/unicore/lib/Blk/Deseret.pl type=file +c:\perl\lib/unicore/lib/Blk/Devanag2.pl type=file +c:\perl\lib/unicore/lib/Blk/Devanaga.pl type=file +c:\perl\lib/unicore/lib/Blk/Dingbats.pl type=file +c:\perl\lib/unicore/lib/Blk/DominoTi.pl type=file +c:\perl\lib/unicore/lib/Blk/Egyptian.pl type=file +c:\perl\lib/unicore/lib/Blk/Enclose2.pl type=file +c:\perl\lib/unicore/lib/Blk/Enclose3.pl type=file +c:\perl\lib/unicore/lib/Blk/Enclose4.pl type=file +c:\perl\lib/unicore/lib/Blk/Enclosed.pl type=file +c:\perl\lib/unicore/lib/Blk/Ethiopi2.pl type=file +c:\perl\lib/unicore/lib/Blk/Ethiopi3.pl type=file +c:\perl\lib/unicore/lib/Blk/Ethiopic.pl type=file +c:\perl\lib/unicore/lib/Blk/GeneralP.pl type=file +c:\perl\lib/unicore/lib/Blk/Geometri.pl type=file +c:\perl\lib/unicore/lib/Blk/Georgia2.pl type=file +c:\perl\lib/unicore/lib/Blk/Georgian.pl type=file +c:\perl\lib/unicore/lib/Blk/Glagolit.pl type=file +c:\perl\lib/unicore/lib/Blk/Gothic.pl type=file +c:\perl\lib/unicore/lib/Blk/Greek.pl type=file +c:\perl\lib/unicore/lib/Blk/GreekExt.pl type=file +c:\perl\lib/unicore/lib/Blk/Gujarati.pl type=file +c:\perl\lib/unicore/lib/Blk/Gurmukhi.pl type=file +c:\perl\lib/unicore/lib/Blk/Halfwidt.pl type=file +c:\perl\lib/unicore/lib/Blk/HangulCo.pl type=file +c:\perl\lib/unicore/lib/Blk/HangulJ2.pl type=file +c:\perl\lib/unicore/lib/Blk/HangulJ3.pl type=file +c:\perl\lib/unicore/lib/Blk/HangulJa.pl type=file +c:\perl\lib/unicore/lib/Blk/HangulSy.pl type=file +c:\perl\lib/unicore/lib/Blk/Hanunoo.pl type=file +c:\perl\lib/unicore/lib/Blk/Hebrew.pl type=file +c:\perl\lib/unicore/lib/Blk/HighPriv.pl type=file +c:\perl\lib/unicore/lib/Blk/HighSurr.pl type=file +c:\perl\lib/unicore/lib/Blk/Hiragana.pl type=file +c:\perl\lib/unicore/lib/Blk/IPAExten.pl type=file +c:\perl\lib/unicore/lib/Blk/Ideograp.pl type=file +c:\perl\lib/unicore/lib/Blk/Imperial.pl type=file +c:\perl\lib/unicore/lib/Blk/Inscrip2.pl type=file +c:\perl\lib/unicore/lib/Blk/Inscript.pl type=file +c:\perl\lib/unicore/lib/Blk/Javanese.pl type=file +c:\perl\lib/unicore/lib/Blk/Kaithi.pl type=file +c:\perl\lib/unicore/lib/Blk/Kanbun.pl type=file +c:\perl\lib/unicore/lib/Blk/KangxiRa.pl type=file +c:\perl\lib/unicore/lib/Blk/Kannada.pl type=file +c:\perl\lib/unicore/lib/Blk/Katakan2.pl type=file +c:\perl\lib/unicore/lib/Blk/Katakana.pl type=file +c:\perl\lib/unicore/lib/Blk/KayahLi.pl type=file +c:\perl\lib/unicore/lib/Blk/Kharosht.pl type=file +c:\perl\lib/unicore/lib/Blk/Khmer.pl type=file +c:\perl\lib/unicore/lib/Blk/KhmerSym.pl type=file +c:\perl\lib/unicore/lib/Blk/Lao.pl type=file +c:\perl\lib/unicore/lib/Blk/Latin1.pl type=file +c:\perl\lib/unicore/lib/Blk/LatinEx2.pl type=file +c:\perl\lib/unicore/lib/Blk/LatinEx3.pl type=file +c:\perl\lib/unicore/lib/Blk/LatinEx4.pl type=file +c:\perl\lib/unicore/lib/Blk/LatinEx5.pl type=file +c:\perl\lib/unicore/lib/Blk/LatinExt.pl type=file +c:\perl\lib/unicore/lib/Blk/Lepcha.pl type=file +c:\perl\lib/unicore/lib/Blk/Letterli.pl type=file +c:\perl\lib/unicore/lib/Blk/Limbu.pl type=file +c:\perl\lib/unicore/lib/Blk/LinearBI.pl type=file +c:\perl\lib/unicore/lib/Blk/LinearBS.pl type=file +c:\perl\lib/unicore/lib/Blk/Lisu.pl type=file +c:\perl\lib/unicore/lib/Blk/LowSurro.pl type=file +c:\perl\lib/unicore/lib/Blk/Lycian.pl type=file +c:\perl\lib/unicore/lib/Blk/Lydian.pl type=file +c:\perl\lib/unicore/lib/Blk/MahjongT.pl type=file +c:\perl\lib/unicore/lib/Blk/Malayala.pl type=file +c:\perl\lib/unicore/lib/Blk/Mathema2.pl type=file +c:\perl\lib/unicore/lib/Blk/Mathemat.pl type=file +c:\perl\lib/unicore/lib/Blk/MeeteiMa.pl type=file +c:\perl\lib/unicore/lib/Blk/Miscell2.pl type=file +c:\perl\lib/unicore/lib/Blk/Miscell3.pl type=file +c:\perl\lib/unicore/lib/Blk/Miscell4.pl type=file +c:\perl\lib/unicore/lib/Blk/Miscell5.pl type=file +c:\perl\lib/unicore/lib/Blk/Miscella.pl type=file +c:\perl\lib/unicore/lib/Blk/Modifier.pl type=file +c:\perl\lib/unicore/lib/Blk/Mongolia.pl type=file +c:\perl\lib/unicore/lib/Blk/MusicalS.pl type=file +c:\perl\lib/unicore/lib/Blk/Myanmar.pl type=file +c:\perl\lib/unicore/lib/Blk/MyanmarE.pl type=file +c:\perl\lib/unicore/lib/Blk/NKo.pl type=file +c:\perl\lib/unicore/lib/Blk/NewTaiLu.pl type=file +c:\perl\lib/unicore/lib/Blk/NoBlock.pl type=file +c:\perl\lib/unicore/lib/Blk/NumberFo.pl type=file +c:\perl\lib/unicore/lib/Blk/Ogham.pl type=file +c:\perl\lib/unicore/lib/Blk/OlChiki.pl type=file +c:\perl\lib/unicore/lib/Blk/OldItali.pl type=file +c:\perl\lib/unicore/lib/Blk/OldPersi.pl type=file +c:\perl\lib/unicore/lib/Blk/OldSouth.pl type=file +c:\perl\lib/unicore/lib/Blk/OldTurki.pl type=file +c:\perl\lib/unicore/lib/Blk/OpticalC.pl type=file +c:\perl\lib/unicore/lib/Blk/Oriya.pl type=file +c:\perl\lib/unicore/lib/Blk/Osmanya.pl type=file +c:\perl\lib/unicore/lib/Blk/PhagsPa.pl type=file +c:\perl\lib/unicore/lib/Blk/Phaistos.pl type=file +c:\perl\lib/unicore/lib/Blk/Phoenici.pl type=file +c:\perl\lib/unicore/lib/Blk/Phoneti2.pl type=file +c:\perl\lib/unicore/lib/Blk/Phonetic.pl type=file +c:\perl\lib/unicore/lib/Blk/PrivateU.pl type=file +c:\perl\lib/unicore/lib/Blk/Rejang.pl type=file +c:\perl\lib/unicore/lib/Blk/RumiNume.pl type=file +c:\perl\lib/unicore/lib/Blk/Runic.pl type=file +c:\perl\lib/unicore/lib/Blk/Samarita.pl type=file +c:\perl\lib/unicore/lib/Blk/Saurasht.pl type=file +c:\perl\lib/unicore/lib/Blk/Shavian.pl type=file +c:\perl\lib/unicore/lib/Blk/Sinhala.pl type=file +c:\perl\lib/unicore/lib/Blk/SmallFor.pl type=file +c:\perl\lib/unicore/lib/Blk/SpacingM.pl type=file +c:\perl\lib/unicore/lib/Blk/Specials.pl type=file +c:\perl\lib/unicore/lib/Blk/Sundanes.pl type=file +c:\perl\lib/unicore/lib/Blk/Superscr.pl type=file +c:\perl\lib/unicore/lib/Blk/Supplem2.pl type=file +c:\perl\lib/unicore/lib/Blk/Supplem3.pl type=file +c:\perl\lib/unicore/lib/Blk/Supplem4.pl type=file +c:\perl\lib/unicore/lib/Blk/Supplem5.pl type=file +c:\perl\lib/unicore/lib/Blk/Supplem6.pl type=file +c:\perl\lib/unicore/lib/Blk/Suppleme.pl type=file +c:\perl\lib/unicore/lib/Blk/SylotiNa.pl type=file +c:\perl\lib/unicore/lib/Blk/Syriac.pl type=file +c:\perl\lib/unicore/lib/Blk/Tagalog.pl type=file +c:\perl\lib/unicore/lib/Blk/Tagbanwa.pl type=file +c:\perl\lib/unicore/lib/Blk/Tags.pl type=file +c:\perl\lib/unicore/lib/Blk/TaiLe.pl type=file +c:\perl\lib/unicore/lib/Blk/TaiTham.pl type=file +c:\perl\lib/unicore/lib/Blk/TaiViet.pl type=file +c:\perl\lib/unicore/lib/Blk/TaiXuanJ.pl type=file +c:\perl\lib/unicore/lib/Blk/Tamil.pl type=file +c:\perl\lib/unicore/lib/Blk/Telugu.pl type=file +c:\perl\lib/unicore/lib/Blk/Thaana.pl type=file +c:\perl\lib/unicore/lib/Blk/Thai.pl type=file +c:\perl\lib/unicore/lib/Blk/Tibetan.pl type=file +c:\perl\lib/unicore/lib/Blk/Tifinagh.pl type=file +c:\perl\lib/unicore/lib/Blk/Ugaritic.pl type=file +c:\perl\lib/unicore/lib/Blk/UnifiedC.pl type=file +c:\perl\lib/unicore/lib/Blk/Vai.pl type=file +c:\perl\lib/unicore/lib/Blk/Variati2.pl type=file +c:\perl\lib/unicore/lib/Blk/Variatio.pl type=file +c:\perl\lib/unicore/lib/Blk/VedicExt.pl type=file +c:\perl\lib/unicore/lib/Blk/Vertical.pl type=file +c:\perl\lib/unicore/lib/Blk/YiRadica.pl type=file +c:\perl\lib/unicore/lib/Blk/YiSyllab.pl type=file +c:\perl\lib/unicore/lib/Blk/YijingHe.pl type=file +c:\perl\lib/unicore/lib/CE/N.pl type=file +c:\perl\lib/unicore/lib/CE/Y.pl type=file +c:\perl\lib/unicore/lib/CI/N.pl type=file +c:\perl\lib/unicore/lib/CI/Y.pl type=file +c:\perl\lib/unicore/lib/CWCF/N.pl type=file +c:\perl\lib/unicore/lib/CWCF/Y.pl type=file +c:\perl\lib/unicore/lib/CWCM/N.pl type=file +c:\perl\lib/unicore/lib/CWCM/Y.pl type=file +c:\perl\lib/unicore/lib/CWKCF/N.pl type=file +c:\perl\lib/unicore/lib/CWKCF/Y.pl type=file +c:\perl\lib/unicore/lib/CWL/N.pl type=file +c:\perl\lib/unicore/lib/CWL/Y.pl type=file +c:\perl\lib/unicore/lib/CWT/N.pl type=file +c:\perl\lib/unicore/lib/CWT/Y.pl type=file +c:\perl\lib/unicore/lib/CWU/N.pl type=file +c:\perl\lib/unicore/lib/CWU/Y.pl type=file +c:\perl\lib/unicore/lib/Cased/N.pl type=file +c:\perl\lib/unicore/lib/Cased/Y.pl type=file +c:\perl\lib/unicore/lib/Ccc/10.pl type=file +c:\perl\lib/unicore/lib/Ccc/103.pl type=file +c:\perl\lib/unicore/lib/Ccc/107.pl type=file +c:\perl\lib/unicore/lib/Ccc/11.pl type=file +c:\perl\lib/unicore/lib/Ccc/118.pl type=file +c:\perl\lib/unicore/lib/Ccc/12.pl type=file +c:\perl\lib/unicore/lib/Ccc/122.pl type=file +c:\perl\lib/unicore/lib/Ccc/129.pl type=file +c:\perl\lib/unicore/lib/Ccc/13.pl type=file +c:\perl\lib/unicore/lib/Ccc/130.pl type=file +c:\perl\lib/unicore/lib/Ccc/132.pl type=file +c:\perl\lib/unicore/lib/Ccc/14.pl type=file +c:\perl\lib/unicore/lib/Ccc/15.pl type=file +c:\perl\lib/unicore/lib/Ccc/16.pl type=file +c:\perl\lib/unicore/lib/Ccc/17.pl type=file +c:\perl\lib/unicore/lib/Ccc/18.pl type=file +c:\perl\lib/unicore/lib/Ccc/19.pl type=file +c:\perl\lib/unicore/lib/Ccc/20.pl type=file +c:\perl\lib/unicore/lib/Ccc/21.pl type=file +c:\perl\lib/unicore/lib/Ccc/22.pl type=file +c:\perl\lib/unicore/lib/Ccc/23.pl type=file +c:\perl\lib/unicore/lib/Ccc/24.pl type=file +c:\perl\lib/unicore/lib/Ccc/25.pl type=file +c:\perl\lib/unicore/lib/Ccc/26.pl type=file +c:\perl\lib/unicore/lib/Ccc/27.pl type=file +c:\perl\lib/unicore/lib/Ccc/28.pl type=file +c:\perl\lib/unicore/lib/Ccc/29.pl type=file +c:\perl\lib/unicore/lib/Ccc/30.pl type=file +c:\perl\lib/unicore/lib/Ccc/31.pl type=file +c:\perl\lib/unicore/lib/Ccc/32.pl type=file +c:\perl\lib/unicore/lib/Ccc/33.pl type=file +c:\perl\lib/unicore/lib/Ccc/34.pl type=file +c:\perl\lib/unicore/lib/Ccc/35.pl type=file +c:\perl\lib/unicore/lib/Ccc/36.pl type=file +c:\perl\lib/unicore/lib/Ccc/84.pl type=file +c:\perl\lib/unicore/lib/Ccc/91.pl type=file +c:\perl\lib/unicore/lib/Ccc/A.pl type=file +c:\perl\lib/unicore/lib/Ccc/AL.pl type=file +c:\perl\lib/unicore/lib/Ccc/AR.pl type=file +c:\perl\lib/unicore/lib/Ccc/ATA.pl type=file +c:\perl\lib/unicore/lib/Ccc/ATAR.pl type=file +c:\perl\lib/unicore/lib/Ccc/ATB.pl type=file +c:\perl\lib/unicore/lib/Ccc/ATBL.pl type=file +c:\perl\lib/unicore/lib/Ccc/B.pl type=file +c:\perl\lib/unicore/lib/Ccc/BL.pl type=file +c:\perl\lib/unicore/lib/Ccc/BR.pl type=file +c:\perl\lib/unicore/lib/Ccc/DA.pl type=file +c:\perl\lib/unicore/lib/Ccc/DB.pl type=file +c:\perl\lib/unicore/lib/Ccc/IS.pl type=file +c:\perl\lib/unicore/lib/Ccc/KV.pl type=file +c:\perl\lib/unicore/lib/Ccc/L.pl type=file +c:\perl\lib/unicore/lib/Ccc/NK.pl type=file +c:\perl\lib/unicore/lib/Ccc/NR.pl type=file +c:\perl\lib/unicore/lib/Ccc/OV.pl type=file +c:\perl\lib/unicore/lib/Ccc/R.pl type=file +c:\perl\lib/unicore/lib/Ccc/VR.pl type=file +c:\perl\lib/unicore/lib/CompEx/N.pl type=file +c:\perl\lib/unicore/lib/CompEx/Y.pl type=file +c:\perl\lib/unicore/lib/DI/N.pl type=file +c:\perl\lib/unicore/lib/DI/Y.pl type=file +c:\perl\lib/unicore/lib/Dash/N.pl type=file +c:\perl\lib/unicore/lib/Dash/Y.pl type=file +c:\perl\lib/unicore/lib/Dep/N.pl type=file +c:\perl\lib/unicore/lib/Dep/Y.pl type=file +c:\perl\lib/unicore/lib/Dia/N.pl type=file +c:\perl\lib/unicore/lib/Dia/Y.pl type=file +c:\perl\lib/unicore/lib/Dt/Com.pl type=file +c:\perl\lib/unicore/lib/Dt/Enc.pl type=file +c:\perl\lib/unicore/lib/Dt/Fin.pl type=file +c:\perl\lib/unicore/lib/Dt/Font.pl type=file +c:\perl\lib/unicore/lib/Dt/Fra.pl type=file +c:\perl\lib/unicore/lib/Dt/Init.pl type=file +c:\perl\lib/unicore/lib/Dt/Iso.pl type=file +c:\perl\lib/unicore/lib/Dt/Med.pl type=file +c:\perl\lib/unicore/lib/Dt/Nar.pl type=file +c:\perl\lib/unicore/lib/Dt/Nb.pl type=file +c:\perl\lib/unicore/lib/Dt/NonCanon.pl type=file +c:\perl\lib/unicore/lib/Dt/None.pl type=file +c:\perl\lib/unicore/lib/Dt/Sml.pl type=file +c:\perl\lib/unicore/lib/Dt/Sqr.pl type=file +c:\perl\lib/unicore/lib/Dt/Sub.pl type=file +c:\perl\lib/unicore/lib/Dt/Sup.pl type=file +c:\perl\lib/unicore/lib/Dt/Vert.pl type=file +c:\perl\lib/unicore/lib/Ea/A.pl type=file +c:\perl\lib/unicore/lib/Ea/F.pl type=file +c:\perl\lib/unicore/lib/Ea/H.pl type=file +c:\perl\lib/unicore/lib/Ea/N.pl type=file +c:\perl\lib/unicore/lib/Ea/Na.pl type=file +c:\perl\lib/unicore/lib/Ea/W.pl type=file +c:\perl\lib/unicore/lib/Ext/N.pl type=file +c:\perl\lib/unicore/lib/Ext/Y.pl type=file +c:\perl\lib/unicore/lib/GCB/CN.pl type=file +c:\perl\lib/unicore/lib/GCB/CR.pl type=file +c:\perl\lib/unicore/lib/GCB/EX.pl type=file +c:\perl\lib/unicore/lib/GCB/L.pl type=file +c:\perl\lib/unicore/lib/GCB/LF.pl type=file +c:\perl\lib/unicore/lib/GCB/LV.pl type=file +c:\perl\lib/unicore/lib/GCB/LVT.pl type=file +c:\perl\lib/unicore/lib/GCB/PP.pl type=file +c:\perl\lib/unicore/lib/GCB/SM.pl type=file +c:\perl\lib/unicore/lib/GCB/T.pl type=file +c:\perl\lib/unicore/lib/GCB/V.pl type=file +c:\perl\lib/unicore/lib/GCB/XX.pl type=file +c:\perl\lib/unicore/lib/Gc/C.pl type=file +c:\perl\lib/unicore/lib/Gc/Cc.pl type=file +c:\perl\lib/unicore/lib/Gc/Cf.pl type=file +c:\perl\lib/unicore/lib/Gc/Cn.pl type=file +c:\perl\lib/unicore/lib/Gc/Co.pl type=file +c:\perl\lib/unicore/lib/Gc/Cs.pl type=file +c:\perl\lib/unicore/lib/Gc/L.pl type=file +c:\perl\lib/unicore/lib/Gc/LC.pl type=file +c:\perl\lib/unicore/lib/Gc/Ll.pl type=file +c:\perl\lib/unicore/lib/Gc/Lm.pl type=file +c:\perl\lib/unicore/lib/Gc/Lo.pl type=file +c:\perl\lib/unicore/lib/Gc/Lt.pl type=file +c:\perl\lib/unicore/lib/Gc/Lu.pl type=file +c:\perl\lib/unicore/lib/Gc/M.pl type=file +c:\perl\lib/unicore/lib/Gc/Mc.pl type=file +c:\perl\lib/unicore/lib/Gc/Me.pl type=file +c:\perl\lib/unicore/lib/Gc/Mn.pl type=file +c:\perl\lib/unicore/lib/Gc/N.pl type=file +c:\perl\lib/unicore/lib/Gc/Nl.pl type=file +c:\perl\lib/unicore/lib/Gc/No.pl type=file +c:\perl\lib/unicore/lib/Gc/P.pl type=file +c:\perl\lib/unicore/lib/Gc/Pd.pl type=file +c:\perl\lib/unicore/lib/Gc/Pe.pl type=file +c:\perl\lib/unicore/lib/Gc/Pf.pl type=file +c:\perl\lib/unicore/lib/Gc/Pi.pl type=file +c:\perl\lib/unicore/lib/Gc/Po.pl type=file +c:\perl\lib/unicore/lib/Gc/Ps.pl type=file +c:\perl\lib/unicore/lib/Gc/S.pl type=file +c:\perl\lib/unicore/lib/Gc/Sc.pl type=file +c:\perl\lib/unicore/lib/Gc/Sk.pl type=file +c:\perl\lib/unicore/lib/Gc/Sm.pl type=file +c:\perl\lib/unicore/lib/Gc/So.pl type=file +c:\perl\lib/unicore/lib/Gc/Z.pl type=file +c:\perl\lib/unicore/lib/Gc/Zl.pl type=file +c:\perl\lib/unicore/lib/Gc/Zp.pl type=file +c:\perl\lib/unicore/lib/Gc/Zs.pl type=file +c:\perl\lib/unicore/lib/GrBase/N.pl type=file +c:\perl\lib/unicore/lib/GrBase/Y.pl type=file +c:\perl\lib/unicore/lib/GrExt/N.pl type=file +c:\perl\lib/unicore/lib/GrExt/Y.pl type=file +c:\perl\lib/unicore/lib/Hex/N.pl type=file +c:\perl\lib/unicore/lib/Hex/Y.pl type=file +c:\perl\lib/unicore/lib/Hst/NA.pl type=file +c:\perl\lib/unicore/lib/Hyphen/N.pl type=file +c:\perl\lib/unicore/lib/Hyphen/Y.pl type=file +c:\perl\lib/unicore/lib/IDC/N.pl type=file +c:\perl\lib/unicore/lib/IDC/Y.pl type=file +c:\perl\lib/unicore/lib/IDS/N.pl type=file +c:\perl\lib/unicore/lib/IDS/Y.pl type=file +c:\perl\lib/unicore/lib/IDSB/N.pl type=file +c:\perl\lib/unicore/lib/IDSB/Y.pl type=file +c:\perl\lib/unicore/lib/IDST/N.pl type=file +c:\perl\lib/unicore/lib/IDST/Y.pl type=file +c:\perl\lib/unicore/lib/Ideo/N.pl type=file +c:\perl\lib/unicore/lib/Ideo/Y.pl type=file +c:\perl\lib/unicore/lib/In/2_0.pl type=file +c:\perl\lib/unicore/lib/In/2_1.pl type=file +c:\perl\lib/unicore/lib/In/3_0.pl type=file +c:\perl\lib/unicore/lib/In/3_1.pl type=file +c:\perl\lib/unicore/lib/In/3_2.pl type=file +c:\perl\lib/unicore/lib/In/4_0.pl type=file +c:\perl\lib/unicore/lib/In/4_1.pl type=file +c:\perl\lib/unicore/lib/In/5_0.pl type=file +c:\perl\lib/unicore/lib/In/5_1.pl type=file +c:\perl\lib/unicore/lib/In/5_2.pl type=file +c:\perl\lib/unicore/lib/Jg/Ain.pl type=file +c:\perl\lib/unicore/lib/Jg/Alaph.pl type=file +c:\perl\lib/unicore/lib/Jg/Alef.pl type=file +c:\perl\lib/unicore/lib/Jg/Beh.pl type=file +c:\perl\lib/unicore/lib/Jg/Beth.pl type=file +c:\perl\lib/unicore/lib/Jg/Burushas.pl type=file +c:\perl\lib/unicore/lib/Jg/Dal.pl type=file +c:\perl\lib/unicore/lib/Jg/DalathRi.pl type=file +c:\perl\lib/unicore/lib/Jg/E.pl type=file +c:\perl\lib/unicore/lib/Jg/FarsiYeh.pl type=file +c:\perl\lib/unicore/lib/Jg/Fe.pl type=file +c:\perl\lib/unicore/lib/Jg/Feh.pl type=file +c:\perl\lib/unicore/lib/Jg/FinalSem.pl type=file +c:\perl\lib/unicore/lib/Jg/Gaf.pl type=file +c:\perl\lib/unicore/lib/Jg/Gamal.pl type=file +c:\perl\lib/unicore/lib/Jg/Hah.pl type=file +c:\perl\lib/unicore/lib/Jg/HamzaOnH.pl type=file +c:\perl\lib/unicore/lib/Jg/He.pl type=file +c:\perl\lib/unicore/lib/Jg/Heh.pl type=file +c:\perl\lib/unicore/lib/Jg/HehGoal.pl type=file +c:\perl\lib/unicore/lib/Jg/Heth.pl type=file +c:\perl\lib/unicore/lib/Jg/Kaf.pl type=file +c:\perl\lib/unicore/lib/Jg/Kaph.pl type=file +c:\perl\lib/unicore/lib/Jg/Khaph.pl type=file +c:\perl\lib/unicore/lib/Jg/KnottedH.pl type=file +c:\perl\lib/unicore/lib/Jg/Lam.pl type=file +c:\perl\lib/unicore/lib/Jg/Lamadh.pl type=file +c:\perl\lib/unicore/lib/Jg/Meem.pl type=file +c:\perl\lib/unicore/lib/Jg/Mim.pl type=file +c:\perl\lib/unicore/lib/Jg/NoJoinin.pl type=file +c:\perl\lib/unicore/lib/Jg/Noon.pl type=file +c:\perl\lib/unicore/lib/Jg/Nun.pl type=file +c:\perl\lib/unicore/lib/Jg/Nya.pl type=file +c:\perl\lib/unicore/lib/Jg/Pe.pl type=file +c:\perl\lib/unicore/lib/Jg/Qaf.pl type=file +c:\perl\lib/unicore/lib/Jg/Qaph.pl type=file +c:\perl\lib/unicore/lib/Jg/Reh.pl type=file +c:\perl\lib/unicore/lib/Jg/Reversed.pl type=file +c:\perl\lib/unicore/lib/Jg/Sad.pl type=file +c:\perl\lib/unicore/lib/Jg/Sadhe.pl type=file +c:\perl\lib/unicore/lib/Jg/Seen.pl type=file +c:\perl\lib/unicore/lib/Jg/Semkath.pl type=file +c:\perl\lib/unicore/lib/Jg/Shin.pl type=file +c:\perl\lib/unicore/lib/Jg/SwashKaf.pl type=file +c:\perl\lib/unicore/lib/Jg/SyriacWa.pl type=file +c:\perl\lib/unicore/lib/Jg/Tah.pl type=file +c:\perl\lib/unicore/lib/Jg/Taw.pl type=file +c:\perl\lib/unicore/lib/Jg/TehMarbu.pl type=file +c:\perl\lib/unicore/lib/Jg/Teth.pl type=file +c:\perl\lib/unicore/lib/Jg/Waw.pl type=file +c:\perl\lib/unicore/lib/Jg/Yeh.pl type=file +c:\perl\lib/unicore/lib/Jg/YehBarre.pl type=file +c:\perl\lib/unicore/lib/Jg/YehWithT.pl type=file +c:\perl\lib/unicore/lib/Jg/Yudh.pl type=file +c:\perl\lib/unicore/lib/Jg/YudhHe.pl type=file +c:\perl\lib/unicore/lib/Jg/Zain.pl type=file +c:\perl\lib/unicore/lib/Jg/Zhain.pl type=file +c:\perl\lib/unicore/lib/JoinC/N.pl type=file +c:\perl\lib/unicore/lib/JoinC/Y.pl type=file +c:\perl\lib/unicore/lib/Jt/C.pl type=file +c:\perl\lib/unicore/lib/Jt/D.pl type=file +c:\perl\lib/unicore/lib/Jt/R.pl type=file +c:\perl\lib/unicore/lib/Jt/T.pl type=file +c:\perl\lib/unicore/lib/Jt/U.pl type=file +c:\perl\lib/unicore/lib/LOE/N.pl type=file +c:\perl\lib/unicore/lib/Lb/AI.pl type=file +c:\perl\lib/unicore/lib/Lb/AL.pl type=file +c:\perl\lib/unicore/lib/Lb/B2.pl type=file +c:\perl\lib/unicore/lib/Lb/BA.pl type=file +c:\perl\lib/unicore/lib/Lb/BB.pl type=file +c:\perl\lib/unicore/lib/Lb/BK.pl type=file +c:\perl\lib/unicore/lib/Lb/CB.pl type=file +c:\perl\lib/unicore/lib/Lb/CL.pl type=file +c:\perl\lib/unicore/lib/Lb/CM.pl type=file +c:\perl\lib/unicore/lib/Lb/CP.pl type=file +c:\perl\lib/unicore/lib/Lb/EX.pl type=file +c:\perl\lib/unicore/lib/Lb/GL.pl type=file +c:\perl\lib/unicore/lib/Lb/HY.pl type=file +c:\perl\lib/unicore/lib/Lb/ID.pl type=file +c:\perl\lib/unicore/lib/Lb/IN.pl type=file +c:\perl\lib/unicore/lib/Lb/IS.pl type=file +c:\perl\lib/unicore/lib/Lb/NL.pl type=file +c:\perl\lib/unicore/lib/Lb/NS.pl type=file +c:\perl\lib/unicore/lib/Lb/NU.pl type=file +c:\perl\lib/unicore/lib/Lb/OP.pl type=file +c:\perl\lib/unicore/lib/Lb/PO.pl type=file +c:\perl\lib/unicore/lib/Lb/PR.pl type=file +c:\perl\lib/unicore/lib/Lb/QU.pl type=file +c:\perl\lib/unicore/lib/Lb/SA.pl type=file +c:\perl\lib/unicore/lib/Lb/SG.pl type=file +c:\perl\lib/unicore/lib/Lb/SP.pl type=file +c:\perl\lib/unicore/lib/Lb/SY.pl type=file +c:\perl\lib/unicore/lib/Lb/WJ.pl type=file +c:\perl\lib/unicore/lib/Lb/XX.pl type=file +c:\perl\lib/unicore/lib/Lb/ZW.pl type=file +c:\perl\lib/unicore/lib/Lower/N.pl type=file +c:\perl\lib/unicore/lib/Lower/Y.pl type=file +c:\perl\lib/unicore/lib/Math/N.pl type=file +c:\perl\lib/unicore/lib/Math/Y.pl type=file +c:\perl\lib/unicore/lib/NChar/N.pl type=file +c:\perl\lib/unicore/lib/NChar/Y.pl type=file +c:\perl\lib/unicore/lib/NFCQC/Y.pl type=file +c:\perl\lib/unicore/lib/NFDQC/N.pl type=file +c:\perl\lib/unicore/lib/NFDQC/Y.pl type=file +c:\perl\lib/unicore/lib/NFKCQC/M.pl type=file +c:\perl\lib/unicore/lib/NFKCQC/N.pl type=file +c:\perl\lib/unicore/lib/NFKCQC/Y.pl type=file +c:\perl\lib/unicore/lib/NFKDQC/N.pl type=file +c:\perl\lib/unicore/lib/Nt/De.pl type=file +c:\perl\lib/unicore/lib/Nt/Di.pl type=file +c:\perl\lib/unicore/lib/Nt/Nu.pl type=file +c:\perl\lib/unicore/lib/Nv/0.pl type=file +c:\perl\lib/unicore/lib/Nv/1.pl type=file +c:\perl\lib/unicore/lib/Nv/10.pl type=file +c:\perl\lib/unicore/lib/Nv/100.pl type=file +c:\perl\lib/unicore/lib/Nv/1000.pl type=file +c:\perl\lib/unicore/lib/Nv/10000.pl type=file +c:\perl\lib/unicore/lib/Nv/100000.pl type=file +c:\perl\lib/unicore/lib/Nv/10000000.pl type=file +c:\perl\lib/unicore/lib/Nv/10000002.pl type=file +c:\perl\lib/unicore/lib/Nv/11.pl type=file +c:\perl\lib/unicore/lib/Nv/11_2.pl type=file +c:\perl\lib/unicore/lib/Nv/12.pl type=file +c:\perl\lib/unicore/lib/Nv/13.pl type=file +c:\perl\lib/unicore/lib/Nv/13_2.pl type=file +c:\perl\lib/unicore/lib/Nv/14.pl type=file +c:\perl\lib/unicore/lib/Nv/15.pl type=file +c:\perl\lib/unicore/lib/Nv/15_2.pl type=file +c:\perl\lib/unicore/lib/Nv/16.pl type=file +c:\perl\lib/unicore/lib/Nv/17.pl type=file +c:\perl\lib/unicore/lib/Nv/17_2.pl type=file +c:\perl\lib/unicore/lib/Nv/18.pl type=file +c:\perl\lib/unicore/lib/Nv/19.pl type=file +c:\perl\lib/unicore/lib/Nv/1_10.pl type=file +c:\perl\lib/unicore/lib/Nv/1_16.pl type=file +c:\perl\lib/unicore/lib/Nv/1_2.pl type=file +c:\perl\lib/unicore/lib/Nv/1_3.pl type=file +c:\perl\lib/unicore/lib/Nv/1_4.pl type=file +c:\perl\lib/unicore/lib/Nv/1_5.pl type=file +c:\perl\lib/unicore/lib/Nv/1_6.pl type=file +c:\perl\lib/unicore/lib/Nv/1_7.pl type=file +c:\perl\lib/unicore/lib/Nv/1_8.pl type=file +c:\perl\lib/unicore/lib/Nv/1_9.pl type=file +c:\perl\lib/unicore/lib/Nv/2.pl type=file +c:\perl\lib/unicore/lib/Nv/20.pl type=file +c:\perl\lib/unicore/lib/Nv/200.pl type=file +c:\perl\lib/unicore/lib/Nv/2000.pl type=file +c:\perl\lib/unicore/lib/Nv/20000.pl type=file +c:\perl\lib/unicore/lib/Nv/21.pl type=file +c:\perl\lib/unicore/lib/Nv/22.pl type=file +c:\perl\lib/unicore/lib/Nv/23.pl type=file +c:\perl\lib/unicore/lib/Nv/24.pl type=file +c:\perl\lib/unicore/lib/Nv/25.pl type=file +c:\perl\lib/unicore/lib/Nv/26.pl type=file +c:\perl\lib/unicore/lib/Nv/27.pl type=file +c:\perl\lib/unicore/lib/Nv/28.pl type=file +c:\perl\lib/unicore/lib/Nv/29.pl type=file +c:\perl\lib/unicore/lib/Nv/2_3.pl type=file +c:\perl\lib/unicore/lib/Nv/2_5.pl type=file +c:\perl\lib/unicore/lib/Nv/3.pl type=file +c:\perl\lib/unicore/lib/Nv/30.pl type=file +c:\perl\lib/unicore/lib/Nv/300.pl type=file +c:\perl\lib/unicore/lib/Nv/3000.pl type=file +c:\perl\lib/unicore/lib/Nv/30000.pl type=file +c:\perl\lib/unicore/lib/Nv/31.pl type=file +c:\perl\lib/unicore/lib/Nv/32.pl type=file +c:\perl\lib/unicore/lib/Nv/33.pl type=file +c:\perl\lib/unicore/lib/Nv/34.pl type=file +c:\perl\lib/unicore/lib/Nv/35.pl type=file +c:\perl\lib/unicore/lib/Nv/36.pl type=file +c:\perl\lib/unicore/lib/Nv/37.pl type=file +c:\perl\lib/unicore/lib/Nv/38.pl type=file +c:\perl\lib/unicore/lib/Nv/39.pl type=file +c:\perl\lib/unicore/lib/Nv/3_16.pl type=file +c:\perl\lib/unicore/lib/Nv/3_2.pl type=file +c:\perl\lib/unicore/lib/Nv/3_4.pl type=file +c:\perl\lib/unicore/lib/Nv/3_5.pl type=file +c:\perl\lib/unicore/lib/Nv/3_8.pl type=file +c:\perl\lib/unicore/lib/Nv/4.pl type=file +c:\perl\lib/unicore/lib/Nv/40.pl type=file +c:\perl\lib/unicore/lib/Nv/400.pl type=file +c:\perl\lib/unicore/lib/Nv/4000.pl type=file +c:\perl\lib/unicore/lib/Nv/40000.pl type=file +c:\perl\lib/unicore/lib/Nv/41.pl type=file +c:\perl\lib/unicore/lib/Nv/42.pl type=file +c:\perl\lib/unicore/lib/Nv/43.pl type=file +c:\perl\lib/unicore/lib/Nv/44.pl type=file +c:\perl\lib/unicore/lib/Nv/45.pl type=file +c:\perl\lib/unicore/lib/Nv/46.pl type=file +c:\perl\lib/unicore/lib/Nv/47.pl type=file +c:\perl\lib/unicore/lib/Nv/48.pl type=file +c:\perl\lib/unicore/lib/Nv/49.pl type=file +c:\perl\lib/unicore/lib/Nv/4_5.pl type=file +c:\perl\lib/unicore/lib/Nv/5.pl type=file +c:\perl\lib/unicore/lib/Nv/50.pl type=file +c:\perl\lib/unicore/lib/Nv/500.pl type=file +c:\perl\lib/unicore/lib/Nv/5000.pl type=file +c:\perl\lib/unicore/lib/Nv/50000.pl type=file +c:\perl\lib/unicore/lib/Nv/5_2.pl type=file +c:\perl\lib/unicore/lib/Nv/5_6.pl type=file +c:\perl\lib/unicore/lib/Nv/5_8.pl type=file +c:\perl\lib/unicore/lib/Nv/6.pl type=file +c:\perl\lib/unicore/lib/Nv/60.pl type=file +c:\perl\lib/unicore/lib/Nv/600.pl type=file +c:\perl\lib/unicore/lib/Nv/6000.pl type=file +c:\perl\lib/unicore/lib/Nv/60000.pl type=file +c:\perl\lib/unicore/lib/Nv/7.pl type=file +c:\perl\lib/unicore/lib/Nv/70.pl type=file +c:\perl\lib/unicore/lib/Nv/700.pl type=file +c:\perl\lib/unicore/lib/Nv/7000.pl type=file +c:\perl\lib/unicore/lib/Nv/70000.pl type=file +c:\perl\lib/unicore/lib/Nv/7_2.pl type=file +c:\perl\lib/unicore/lib/Nv/7_8.pl type=file +c:\perl\lib/unicore/lib/Nv/8.pl type=file +c:\perl\lib/unicore/lib/Nv/80.pl type=file +c:\perl\lib/unicore/lib/Nv/800.pl type=file +c:\perl\lib/unicore/lib/Nv/8000.pl type=file +c:\perl\lib/unicore/lib/Nv/80000.pl type=file +c:\perl\lib/unicore/lib/Nv/9.pl type=file +c:\perl\lib/unicore/lib/Nv/90.pl type=file +c:\perl\lib/unicore/lib/Nv/900.pl type=file +c:\perl\lib/unicore/lib/Nv/9000.pl type=file +c:\perl\lib/unicore/lib/Nv/90000.pl type=file +c:\perl\lib/unicore/lib/Nv/9_2.pl type=file +c:\perl\lib/unicore/lib/Nv/NaN.pl type=file +c:\perl\lib/unicore/lib/Nv/_1_2.pl type=file +c:\perl\lib/unicore/lib/OAlpha/N.pl type=file +c:\perl\lib/unicore/lib/OAlpha/Y.pl type=file +c:\perl\lib/unicore/lib/ODI/N.pl type=file +c:\perl\lib/unicore/lib/ODI/Y.pl type=file +c:\perl\lib/unicore/lib/OGrExt/N.pl type=file +c:\perl\lib/unicore/lib/OGrExt/Y.pl type=file +c:\perl\lib/unicore/lib/OIDC/N.pl type=file +c:\perl\lib/unicore/lib/OIDC/Y.pl type=file +c:\perl\lib/unicore/lib/OIDS/N.pl type=file +c:\perl\lib/unicore/lib/OIDS/Y.pl type=file +c:\perl\lib/unicore/lib/OLower/N.pl type=file +c:\perl\lib/unicore/lib/OLower/Y.pl type=file +c:\perl\lib/unicore/lib/OMath/N.pl type=file +c:\perl\lib/unicore/lib/OMath/Y.pl type=file +c:\perl\lib/unicore/lib/OUpper/N.pl type=file +c:\perl\lib/unicore/lib/OUpper/Y.pl type=file +c:\perl\lib/unicore/lib/PatSyn/N.pl type=file +c:\perl\lib/unicore/lib/PatSyn/Y.pl type=file +c:\perl\lib/unicore/lib/PatWS/N.pl type=file +c:\perl\lib/unicore/lib/PatWS/Y.pl type=file +c:\perl\lib/unicore/lib/Perl/Alnum.pl type=file +c:\perl\lib/unicore/lib/Perl/Any.pl type=file +c:\perl\lib/unicore/lib/Perl/Assigned.pl type=file +c:\perl\lib/unicore/lib/Perl/Blank.pl type=file +c:\perl\lib/unicore/lib/Perl/Graph.pl type=file +c:\perl\lib/unicore/lib/Perl/PerlSpac.pl type=file +c:\perl\lib/unicore/lib/Perl/PerlWord.pl type=file +c:\perl\lib/unicore/lib/Perl/PosixAln.pl type=file +c:\perl\lib/unicore/lib/Perl/PosixAlp.pl type=file +c:\perl\lib/unicore/lib/Perl/PosixBla.pl type=file +c:\perl\lib/unicore/lib/Perl/PosixCnt.pl type=file +c:\perl\lib/unicore/lib/Perl/PosixDig.pl type=file +c:\perl\lib/unicore/lib/Perl/PosixGra.pl type=file +c:\perl\lib/unicore/lib/Perl/PosixLow.pl type=file +c:\perl\lib/unicore/lib/Perl/PosixPri.pl type=file +c:\perl\lib/unicore/lib/Perl/PosixPun.pl type=file +c:\perl\lib/unicore/lib/Perl/PosixSpa.pl type=file +c:\perl\lib/unicore/lib/Perl/PosixUpp.pl type=file +c:\perl\lib/unicore/lib/Perl/Print.pl type=file +c:\perl\lib/unicore/lib/Perl/SpacePer.pl type=file +c:\perl\lib/unicore/lib/Perl/VertSpac.pl type=file +c:\perl\lib/unicore/lib/Perl/Word.pl type=file +c:\perl\lib/unicore/lib/Perl/_XBegin.pl type=file +c:\perl\lib/unicore/lib/Perl/_XExtend.pl type=file +c:\perl\lib/unicore/lib/Perl/_XLVLVTV.pl type=file +c:\perl\lib/unicore/lib/QMark/N.pl type=file +c:\perl\lib/unicore/lib/QMark/Y.pl type=file +c:\perl\lib/unicore/lib/Radical/N.pl type=file +c:\perl\lib/unicore/lib/Radical/Y.pl type=file +c:\perl\lib/unicore/lib/SB/AT.pl type=file +c:\perl\lib/unicore/lib/SB/CL.pl type=file +c:\perl\lib/unicore/lib/SB/EX.pl type=file +c:\perl\lib/unicore/lib/SB/FO.pl type=file +c:\perl\lib/unicore/lib/SB/LE.pl type=file +c:\perl\lib/unicore/lib/SB/LO.pl type=file +c:\perl\lib/unicore/lib/SB/SC.pl type=file +c:\perl\lib/unicore/lib/SB/SE.pl type=file +c:\perl\lib/unicore/lib/SB/ST.pl type=file +c:\perl\lib/unicore/lib/SB/Sp.pl type=file +c:\perl\lib/unicore/lib/SB/UP.pl type=file +c:\perl\lib/unicore/lib/SB/XX.pl type=file +c:\perl\lib/unicore/lib/SD/N.pl type=file +c:\perl\lib/unicore/lib/SD/Y.pl type=file +c:\perl\lib/unicore/lib/STerm/N.pl type=file +c:\perl\lib/unicore/lib/STerm/Y.pl type=file +c:\perl\lib/unicore/lib/Sc/Arab.pl type=file +c:\perl\lib/unicore/lib/Sc/Armi.pl type=file +c:\perl\lib/unicore/lib/Sc/Armn.pl type=file +c:\perl\lib/unicore/lib/Sc/Avst.pl type=file +c:\perl\lib/unicore/lib/Sc/Bali.pl type=file +c:\perl\lib/unicore/lib/Sc/Bamu.pl type=file +c:\perl\lib/unicore/lib/Sc/Beng.pl type=file +c:\perl\lib/unicore/lib/Sc/Bopo.pl type=file +c:\perl\lib/unicore/lib/Sc/Bugi.pl type=file +c:\perl\lib/unicore/lib/Sc/Buhd.pl type=file +c:\perl\lib/unicore/lib/Sc/Cans.pl type=file +c:\perl\lib/unicore/lib/Sc/Cari.pl type=file +c:\perl\lib/unicore/lib/Sc/Cham.pl type=file +c:\perl\lib/unicore/lib/Sc/Cher.pl type=file +c:\perl\lib/unicore/lib/Sc/Copt.pl type=file +c:\perl\lib/unicore/lib/Sc/Cprt.pl type=file +c:\perl\lib/unicore/lib/Sc/Cyrl.pl type=file +c:\perl\lib/unicore/lib/Sc/Deva.pl type=file +c:\perl\lib/unicore/lib/Sc/Egyp.pl type=file +c:\perl\lib/unicore/lib/Sc/Ethi.pl type=file +c:\perl\lib/unicore/lib/Sc/Geor.pl type=file +c:\perl\lib/unicore/lib/Sc/Glag.pl type=file +c:\perl\lib/unicore/lib/Sc/Goth.pl type=file +c:\perl\lib/unicore/lib/Sc/Grek.pl type=file +c:\perl\lib/unicore/lib/Sc/Gujr.pl type=file +c:\perl\lib/unicore/lib/Sc/Guru.pl type=file +c:\perl\lib/unicore/lib/Sc/Han.pl type=file +c:\perl\lib/unicore/lib/Sc/Hang.pl type=file +c:\perl\lib/unicore/lib/Sc/Hano.pl type=file +c:\perl\lib/unicore/lib/Sc/Hebr.pl type=file +c:\perl\lib/unicore/lib/Sc/Hira.pl type=file +c:\perl\lib/unicore/lib/Sc/Ital.pl type=file +c:\perl\lib/unicore/lib/Sc/Java.pl type=file +c:\perl\lib/unicore/lib/Sc/Kana.pl type=file +c:\perl\lib/unicore/lib/Sc/Khar.pl type=file +c:\perl\lib/unicore/lib/Sc/Khmr.pl type=file +c:\perl\lib/unicore/lib/Sc/Knda.pl type=file +c:\perl\lib/unicore/lib/Sc/Kthi.pl type=file +c:\perl\lib/unicore/lib/Sc/Lana.pl type=file +c:\perl\lib/unicore/lib/Sc/Lao.pl type=file +c:\perl\lib/unicore/lib/Sc/Latn.pl type=file +c:\perl\lib/unicore/lib/Sc/Lepc.pl type=file +c:\perl\lib/unicore/lib/Sc/Limb.pl type=file +c:\perl\lib/unicore/lib/Sc/Linb.pl type=file +c:\perl\lib/unicore/lib/Sc/Lyci.pl type=file +c:\perl\lib/unicore/lib/Sc/Lydi.pl type=file +c:\perl\lib/unicore/lib/Sc/Mlym.pl type=file +c:\perl\lib/unicore/lib/Sc/Mong.pl type=file +c:\perl\lib/unicore/lib/Sc/Mtei.pl type=file +c:\perl\lib/unicore/lib/Sc/Mymr.pl type=file +c:\perl\lib/unicore/lib/Sc/Nko.pl type=file +c:\perl\lib/unicore/lib/Sc/Ogam.pl type=file +c:\perl\lib/unicore/lib/Sc/Orkh.pl type=file +c:\perl\lib/unicore/lib/Sc/Orya.pl type=file +c:\perl\lib/unicore/lib/Sc/Osma.pl type=file +c:\perl\lib/unicore/lib/Sc/Phag.pl type=file +c:\perl\lib/unicore/lib/Sc/Phli.pl type=file +c:\perl\lib/unicore/lib/Sc/Phnx.pl type=file +c:\perl\lib/unicore/lib/Sc/Prti.pl type=file +c:\perl\lib/unicore/lib/Sc/Rjng.pl type=file +c:\perl\lib/unicore/lib/Sc/Runr.pl type=file +c:\perl\lib/unicore/lib/Sc/Samr.pl type=file +c:\perl\lib/unicore/lib/Sc/Saur.pl type=file +c:\perl\lib/unicore/lib/Sc/Sinh.pl type=file +c:\perl\lib/unicore/lib/Sc/Sund.pl type=file +c:\perl\lib/unicore/lib/Sc/Sylo.pl type=file +c:\perl\lib/unicore/lib/Sc/Syrc.pl type=file +c:\perl\lib/unicore/lib/Sc/Tagb.pl type=file +c:\perl\lib/unicore/lib/Sc/Tale.pl type=file +c:\perl\lib/unicore/lib/Sc/Talu.pl type=file +c:\perl\lib/unicore/lib/Sc/Taml.pl type=file +c:\perl\lib/unicore/lib/Sc/Tavt.pl type=file +c:\perl\lib/unicore/lib/Sc/Telu.pl type=file +c:\perl\lib/unicore/lib/Sc/Tfng.pl type=file +c:\perl\lib/unicore/lib/Sc/Tglg.pl type=file +c:\perl\lib/unicore/lib/Sc/Thaa.pl type=file +c:\perl\lib/unicore/lib/Sc/Thai.pl type=file +c:\perl\lib/unicore/lib/Sc/Tibt.pl type=file +c:\perl\lib/unicore/lib/Sc/Ugar.pl type=file +c:\perl\lib/unicore/lib/Sc/Vai.pl type=file +c:\perl\lib/unicore/lib/Sc/Xpeo.pl type=file +c:\perl\lib/unicore/lib/Sc/Xsux.pl type=file +c:\perl\lib/unicore/lib/Sc/Yi.pl type=file +c:\perl\lib/unicore/lib/Sc/Zinh.pl type=file +c:\perl\lib/unicore/lib/Sc/Zyyy.pl type=file +c:\perl\lib/unicore/lib/Sc/Zzzz.pl type=file +c:\perl\lib/unicore/lib/Space/N.pl type=file +c:\perl\lib/unicore/lib/Space/Y.pl type=file +c:\perl\lib/unicore/lib/Term/N.pl type=file +c:\perl\lib/unicore/lib/Term/Y.pl type=file +c:\perl\lib/unicore/lib/UIdeo/N.pl type=file +c:\perl\lib/unicore/lib/UIdeo/Y.pl type=file +c:\perl\lib/unicore/lib/Upper/N.pl type=file +c:\perl\lib/unicore/lib/Upper/Y.pl type=file +c:\perl\lib/unicore/lib/VS/N.pl type=file +c:\perl\lib/unicore/lib/VS/Y.pl type=file +c:\perl\lib/unicore/lib/WB/EX.pl type=file +c:\perl\lib/unicore/lib/WB/FO.pl type=file +c:\perl\lib/unicore/lib/WB/KA.pl type=file +c:\perl\lib/unicore/lib/WB/LE.pl type=file +c:\perl\lib/unicore/lib/WB/MB.pl type=file +c:\perl\lib/unicore/lib/WB/ML.pl type=file +c:\perl\lib/unicore/lib/WB/MN.pl type=file +c:\perl\lib/unicore/lib/WB/NL.pl type=file +c:\perl\lib/unicore/lib/WB/NU.pl type=file +c:\perl\lib/unicore/lib/WB/XX.pl type=file +c:\perl\lib/unicore/lib/XIDC/N.pl type=file +c:\perl\lib/unicore/lib/XIDC/Y.pl type=file +c:\perl\lib/unicore/lib/XIDS/N.pl type=file +c:\perl\lib/unicore/lib/XIDS/Y.pl type=file +c:\perl\lib/unicore/mktables type=file +c:\perl\lib/unicore/mktables.lst type=file +c:\perl\lib/unicore/version type=file +c:\perl\lib/utf8.pm type=file +c:\perl\lib/utf8_heavy.pl type=file +c:\perl\lib/validate.pl type=file +c:\perl\lib/vars.pm type=file +c:\perl\lib/version.pm type=file +c:\perl\lib/version.pod type=file +c:\perl\lib/version/Internals.pod type=file +c:\perl\lib/vmsish.pm type=file +c:\perl\lib/warnings.pm type=file +c:\perl\lib/warnings/register.pm type=file diff --git a/Master/tlpkg/tlperl/lib/AnyDBM_File.pm b/Master/tlpkg/tlperl/lib/AnyDBM_File.pm new file mode 100644 index 00000000000..d73abab0f9e --- /dev/null +++ b/Master/tlpkg/tlperl/lib/AnyDBM_File.pm @@ -0,0 +1,93 @@ +package AnyDBM_File; + +use 5.006_001; +our $VERSION = '1.00'; +our @ISA = qw(NDBM_File DB_File GDBM_File SDBM_File ODBM_File) unless @ISA; + +my $mod; +for $mod (@ISA) { + if (eval "require $mod") { + @ISA = ($mod); # if we leave @ISA alone, warnings abound + return 1; + } +} + +die "No DBM package was successfully found or installed"; +#return 0; + +=head1 NAME + +AnyDBM_File - provide framework for multiple DBMs + +NDBM_File, DB_File, GDBM_File, SDBM_File, ODBM_File - various DBM implementations + +=head1 SYNOPSIS + + use AnyDBM_File; + +=head1 DESCRIPTION + +This module is a "pure virtual base class"--it has nothing of its own. +It's just there to inherit from one of the various DBM packages. It +prefers ndbm for compatibility reasons with Perl 4, then Berkeley DB (See +L), GDBM, SDBM (which is always there--it comes with Perl), and +finally ODBM. This way old programs that used to use NDBM via dbmopen() +can still do so, but new ones can reorder @ISA: + + BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) } + use AnyDBM_File; + +Having multiple DBM implementations makes it trivial to copy database formats: + + use POSIX; use NDBM_File; use DB_File; + tie %newhash, 'DB_File', $new_filename, O_CREAT|O_RDWR; + tie %oldhash, 'NDBM_File', $old_filename, 1, 0; + %newhash = %oldhash; + +=head2 DBM Comparisons + +Here's a partial table of features the different packages offer: + + odbm ndbm sdbm gdbm bsd-db + ---- ---- ---- ---- ------ + Linkage comes w/ perl yes yes yes yes yes + Src comes w/ perl no no yes no no + Comes w/ many unix os yes yes[0] no no no + Builds ok on !unix ? ? yes yes ? + Code Size ? ? small big big + Database Size ? ? small big? ok[1] + Speed ? ? slow ok fast + FTPable no no yes yes yes + Easy to build N/A N/A yes yes ok[2] + Size limits 1k 4k 1k[3] none none + Byte-order independent no no no no yes + Licensing restrictions ? ? no yes no + + +=over 4 + +=item [0] + +on mixed universe machines, may be in the bsd compat library, +which is often shunned. + +=item [1] + +Can be trimmed if you compile for one access method. + +=item [2] + +See L. +Requires symbolic links. + +=item [3] + +By default, but can be redefined. + +=back + +=head1 SEE ALSO + +dbm(3), ndbm(3), DB_File(3), L + +=cut diff --git a/Master/tlpkg/tlperl/lib/AutoLoader.pm b/Master/tlpkg/tlperl/lib/AutoLoader.pm new file mode 100644 index 00000000000..06f986b50d6 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/AutoLoader.pm @@ -0,0 +1,429 @@ +package AutoLoader; + +use strict; +use 5.006_001; + +our($VERSION, $AUTOLOAD); + +my $is_dosish; +my $is_epoc; +my $is_vms; +my $is_macos; + +BEGIN { + $is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare'; + $is_epoc = $^O eq 'epoc'; + $is_vms = $^O eq 'VMS'; + $is_macos = $^O eq 'MacOS'; + $VERSION = '5.70'; +} + +AUTOLOAD { + my $sub = $AUTOLOAD; + my $filename = AutoLoader::find_filename( $sub ); + + my $save = $@; + local $!; # Do not munge the value. + eval { local $SIG{__DIE__}; require $filename }; + if ($@) { + if (substr($sub,-9) eq '::DESTROY') { + no strict 'refs'; + *$sub = sub {}; + $@ = undef; + } elsif ($@ =~ /^Can't locate/) { + # The load might just have failed because the filename was too + # long for some old SVR3 systems which treat long names as errors. + # If we can successfully truncate a long name then it's worth a go. + # There is a slight risk that we could pick up the wrong file here + # but autosplit should have warned about that when splitting. + if ($filename =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){ + eval { local $SIG{__DIE__}; require $filename }; + } + } + if ($@){ + $@ =~ s/ at .*\n//; + my $error = $@; + require Carp; + Carp::croak($error); + } + } + $@ = $save; + goto &$sub; +} + +sub find_filename { + my $sub = shift; + my $filename; + # Braces used to preserve $1 et al. + { + # Try to find the autoloaded file from the package-qualified + # name of the sub. e.g., if the sub needed is + # Getopt::Long::GetOptions(), then $INC{Getopt/Long.pm} is + # something like '/usr/lib/perl5/Getopt/Long.pm', and the + # autoload file is '/usr/lib/perl5/auto/Getopt/Long/GetOptions.al'. + # + # However, if @INC is a relative path, this might not work. If, + # for example, @INC = ('lib'), then $INC{Getopt/Long.pm} is + # 'lib/Getopt/Long.pm', and we want to require + # 'auto/Getopt/Long/GetOptions.al' (without the leading 'lib'). + # In this case, we simple prepend the 'auto/' and let the + # C take care of the searching for us. + + my ($pkg,$func) = ($sub =~ /(.*)::([^:]+)$/); + $pkg =~ s#::#/#g; + if (defined($filename = $INC{"$pkg.pm"})) { + if ($is_macos) { + $pkg =~ tr#/#:#; + $filename = undef + unless $filename =~ s#^(.*)$pkg\.pm\z#$1auto:$pkg:$func.al#s; + } else { + $filename = undef + unless $filename =~ s#^(.*)$pkg\.pm\z#$1auto/$pkg/$func.al#s; + } + + # if the file exists, then make sure that it is a + # a fully anchored path (i.e either '/usr/lib/auto/foo/bar.al', + # or './lib/auto/foo/bar.al'. This avoids C searching + # (and failing) to find the 'lib/auto/foo/bar.al' because it + # looked for 'lib/lib/auto/foo/bar.al', given @INC = ('lib'). + + if (defined $filename and -r $filename) { + unless ($filename =~ m|^/|s) { + if ($is_dosish) { + unless ($filename =~ m{^([a-z]:)?[\\/]}is) { + if ($^O ne 'NetWare') { + $filename = "./$filename"; + } else { + $filename = "$filename"; + } + } + } + elsif ($is_epoc) { + unless ($filename =~ m{^([a-z?]:)?[\\/]}is) { + $filename = "./$filename"; + } + } + elsif ($is_vms) { + # XXX todo by VMSmiths + $filename = "./$filename"; + } + elsif (!$is_macos) { + $filename = "./$filename"; + } + } + } + else { + $filename = undef; + } + } + unless (defined $filename) { + # let C do the searching + $filename = "auto/$sub.al"; + $filename =~ s#::#/#g; + } + } + return $filename; +} + +sub import { + my $pkg = shift; + my $callpkg = caller; + + # + # Export symbols, but not by accident of inheritance. + # + + if ($pkg eq 'AutoLoader') { + if ( @_ and $_[0] =~ /^&?AUTOLOAD$/ ) { + no strict 'refs'; + *{ $callpkg . '::AUTOLOAD' } = \&AUTOLOAD; + } + } + + # + # Try to find the autosplit index file. Eg., if the call package + # is POSIX, then $INC{POSIX.pm} is something like + # '/usr/local/lib/perl5/POSIX.pm', and the autosplit index file is in + # '/usr/local/lib/perl5/auto/POSIX/autosplit.ix', so we require that. + # + # However, if @INC is a relative path, this might not work. If, + # for example, @INC = ('lib'), then + # $INC{POSIX.pm} is 'lib/POSIX.pm', and we want to require + # 'auto/POSIX/autosplit.ix' (without the leading 'lib'). + # + + (my $calldir = $callpkg) =~ s#::#/#g; + my $path = $INC{$calldir . '.pm'}; + if (defined($path)) { + # Try absolute path name, but only eval it if the + # transformation from module path to autosplit.ix path + # succeeded! + my $replaced_okay; + if ($is_macos) { + (my $malldir = $calldir) =~ tr#/#:#; + $replaced_okay = ($path =~ s#^(.*)$malldir\.pm\z#$1auto:$malldir:autosplit.ix#s); + } else { + $replaced_okay = ($path =~ s#^(.*)$calldir\.pm\z#$1auto/$calldir/autosplit.ix#); + } + + eval { require $path; } if $replaced_okay; + # If that failed, try relative path with normal @INC searching. + if (!$replaced_okay or $@) { + $path ="auto/$calldir/autosplit.ix"; + eval { require $path; }; + } + if ($@) { + my $error = $@; + require Carp; + Carp::carp($error); + } + } +} + +sub unimport { + my $callpkg = caller; + + no strict 'refs'; + + for my $exported (qw( AUTOLOAD )) { + my $symname = $callpkg . '::' . $exported; + undef *{ $symname } if \&{ $symname } == \&{ $exported }; + *{ $symname } = \&{ $symname }; + } +} + +1; + +__END__ + +=head1 NAME + +AutoLoader - load subroutines only on demand + +=head1 SYNOPSIS + + package Foo; + use AutoLoader 'AUTOLOAD'; # import the default AUTOLOAD subroutine + + package Bar; + use AutoLoader; # don't import AUTOLOAD, define our own + sub AUTOLOAD { + ... + $AutoLoader::AUTOLOAD = "..."; + goto &AutoLoader::AUTOLOAD; + } + +=head1 DESCRIPTION + +The B module works with the B module and the +C<__END__> token to defer the loading of some subroutines until they are +used rather than loading them all at once. + +To use B, the author of a module has to place the +definitions of subroutines to be autoloaded after an C<__END__> token. +(See L.) The B module can then be run manually to +extract the definitions into individual files F. + +B implements an AUTOLOAD subroutine. When an undefined +subroutine in is called in a client module of B, +B's AUTOLOAD subroutine attempts to locate the subroutine in a +file with a name related to the location of the file from which the +client module was read. As an example, if F is located in +F, B will look for perl +subroutines B in F, where +the C<.al> file has the same name as the subroutine, sans package. If +such a file exists, AUTOLOAD will read and evaluate it, +thus (presumably) defining the needed subroutine. AUTOLOAD will then +C the newly defined subroutine. + +Once this process completes for a given function, it is defined, so +future calls to the subroutine will bypass the AUTOLOAD mechanism. + +=head2 Subroutine Stubs + +In order for object method lookup and/or prototype checking to operate +correctly even when methods have not yet been defined it is necessary to +"forward declare" each subroutine (as in C). See +L. Such forward declaration creates "subroutine +stubs", which are place holders with no code. + +The AutoSplit and B modules automate the creation of forward +declarations. The AutoSplit module creates an 'index' file containing +forward declarations of all the AutoSplit subroutines. When the +AutoLoader module is 'use'd it loads these declarations into its callers +package. + +Because of this mechanism it is important that B is always +Cd and not Cd. + +=head2 Using B's AUTOLOAD Subroutine + +In order to use B's AUTOLOAD subroutine you I +explicitly import it: + + use AutoLoader 'AUTOLOAD'; + +=head2 Overriding B's AUTOLOAD Subroutine + +Some modules, mainly extensions, provide their own AUTOLOAD subroutines. +They typically need to check for some special cases (such as constants) +and then fallback to B's AUTOLOAD for the rest. + +Such modules should I import B's AUTOLOAD subroutine. +Instead, they should define their own AUTOLOAD subroutines along these +lines: + + use AutoLoader; + use Carp; + + sub AUTOLOAD { + my $sub = $AUTOLOAD; + (my $constname = $sub) =~ s/.*:://; + my $val = constant($constname, @_ ? $_[0] : 0); + if ($! != 0) { + if ($! =~ /Invalid/ || $!{EINVAL}) { + $AutoLoader::AUTOLOAD = $sub; + goto &AutoLoader::AUTOLOAD; + } + else { + croak "Your vendor has not defined constant $constname"; + } + } + *$sub = sub { $val }; # same as: eval "sub $sub { $val }"; + goto &$sub; + } + +If any module's own AUTOLOAD subroutine has no need to fallback to the +AutoLoader's AUTOLOAD subroutine (because it doesn't have any AutoSplit +subroutines), then that module should not use B at all. + +=head2 Package Lexicals + +Package lexicals declared with C in the main block of a package +using B will not be visible to auto-loaded subroutines, due to +the fact that the given scope ends at the C<__END__> marker. A module +using such variables as package globals will not work properly under the +B. + +The C pragma (see L) may be used in such +situations as an alternative to explicitly qualifying all globals with +the package namespace. Variables pre-declared with this pragma will be +visible to any autoloaded routines (but will not be invisible outside +the package, unfortunately). + +=head2 Not Using AutoLoader + +You can stop using AutoLoader by simply + + no AutoLoader; + +=head2 B vs. B + +The B is similar in purpose to B: both delay the +loading of subroutines. + +B uses the C<__DATA__> marker rather than C<__END__>. +While this avoids the use of a hierarchy of disk files and the +associated open/close for each routine loaded, B suffers a +startup speed disadvantage in the one-time parsing of the lines after +C<__DATA__>, after which routines are cached. B can also +handle multiple packages in a file. + +B only reads code as it is requested, and in many cases +should be faster, but requires a mechanism like B be used to +create the individual files. L will invoke +B automatically if B is used in a module source +file. + +=head1 CAVEATS + +AutoLoaders prior to Perl 5.002 had a slightly different interface. Any +old modules which use B should be changed to the new calling +style. Typically this just means changing a require to a use, adding +the explicit C<'AUTOLOAD'> import if needed, and removing B +from C<@ISA>. + +On systems with restrictions on file name length, the file corresponding +to a subroutine may have a shorter name that the routine itself. This +can lead to conflicting file names. The I package warns of +these potential conflicts when used to split a module. + +AutoLoader may fail to find the autosplit files (or even find the wrong +ones) in cases where C<@INC> contains relative paths, B the program +does C. + +=head1 SEE ALSO + +L - an autoloader that doesn't use external files. + +=head1 AUTHOR + +C is maintained by the perl5-porters. Please direct +any questions to the canonical mailing list. Anything that +is applicable to the CPAN release can be sent to its maintainer, +though. + +Author and Maintainer: The Perl5-Porters + +Maintainer of the CPAN release: Steffen Mueller + +=head1 COPYRIGHT AND LICENSE + +This package has been part of the perl core since the first release +of perl5. It has been released separately to CPAN so older installations +can benefit from bug fixes. + +This package has the same copyright and license as the perl core: + + Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, + 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 + by Larry Wall and others + + All rights reserved. + + This program is free software; you can redistribute it and/or modify + it under the terms of either: + + a) the GNU General Public License as published by the Free + Software Foundation; either version 1, or (at your option) any + later version, or + + b) the "Artistic License" which comes with this Kit. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either + the GNU General Public License or the Artistic License for more details. + + You should have received a copy of the Artistic License with this + Kit, in the file named "Artistic". If not, I'll be glad to provide one. + + You should also have received a copy of the GNU General Public License + along with this program in the file named "Copying". If not, write to the + Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA + 02111-1307, USA or visit their web page on the internet at + http://www.gnu.org/copyleft/gpl.html. + + For those of you that choose to use the GNU General Public License, + my interpretation of the GNU General Public License is that no Perl + script falls under the terms of the GPL unless you explicitly put + said script under the terms of the GPL yourself. Furthermore, any + object code linked with perl does not automatically fall under the + terms of the GPL, provided such object code only adds definitions + of subroutines and variables, and does not otherwise impair the + resulting interpreter from executing any standard Perl script. I + consider linking in C subroutines in this manner to be the moral + equivalent of defining subroutines in the Perl language itself. You + may sell such an object file as proprietary provided that you provide + or offer to provide the Perl source, as specified by the GNU General + Public License. (This is merely an alternate way of specifying input + to the program.) You may also sell a binary produced by the dumping of + a running Perl script that belongs to you, provided that you provide or + offer to provide the Perl source as specified by the GPL. (The + fact that a Perl interpreter and your code are in the same binary file + is, in this case, a form of mere aggregation.) This is my interpretation + of the GPL. If you still have concerns or difficulties understanding + my intent, feel free to contact me. Of course, the Artistic License + spells all this out for your protection, so you may prefer to use that. + +=cut diff --git a/Master/tlpkg/tlperl/lib/AutoSplit.pm b/Master/tlpkg/tlperl/lib/AutoSplit.pm new file mode 100644 index 00000000000..c093f2dd24b --- /dev/null +++ b/Master/tlpkg/tlperl/lib/AutoSplit.pm @@ -0,0 +1,592 @@ +package AutoSplit; + +use Exporter (); +use Config qw(%Config); +use File::Basename (); +use File::Path qw(mkpath); +use File::Spec::Functions qw(curdir catfile catdir); +use strict; +our($VERSION, @ISA, @EXPORT, @EXPORT_OK, $Verbose, $Keep, $Maxlen, + $CheckForAutoloader, $CheckModTime); + +$VERSION = "1.06"; +@ISA = qw(Exporter); +@EXPORT = qw(&autosplit &autosplit_lib_modules); +@EXPORT_OK = qw($Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime); + +=head1 NAME + +AutoSplit - split a package for autoloading + +=head1 SYNOPSIS + + autosplit($file, $dir, $keep, $check, $modtime); + + autosplit_lib_modules(@modules); + +=head1 DESCRIPTION + +This function will split up your program into files that the AutoLoader +module can handle. It is used by both the standard perl libraries and by +the MakeMaker utility, to automatically configure libraries for autoloading. + +The C interface splits the specified file into a hierarchy +rooted at the directory C<$dir>. It creates directories as needed to reflect +class hierarchy, and creates the file F. This file acts as +both forward declaration of all package routines, and as timestamp for the +last update of the hierarchy. + +The remaining three arguments to C govern other options to +the autosplitter. + +=over 2 + +=item $keep + +If the third argument, I<$keep>, is false, then any +pre-existing C<*.al> files in the autoload directory are removed if +they are no longer part of the module (obsoleted functions). +$keep defaults to 0. + +=item $check + +The +fourth argument, I<$check>, instructs C to check the module +currently being split to ensure that it includes a C +specification for the AutoLoader module, and skips the module if +AutoLoader is not detected. +$check defaults to 1. + +=item $modtime + +Lastly, the I<$modtime> argument specifies +that C is to check the modification time of the module +against that of the C file, and only split the module if +it is newer. +$modtime defaults to 1. + +=back + +Typical use of AutoSplit in the perl MakeMaker utility is via the command-line +with: + + perl -e 'use AutoSplit; autosplit($ARGV[0], $ARGV[1], 0, 1, 1)' + +Defined as a Make macro, it is invoked with file and directory arguments; +C will split the specified file into the specified directory and +delete obsolete C<.al> files, after checking first that the module does use +the AutoLoader, and ensuring that the module is not already currently split +in its current form (the modtime test). + +The C form is used in the building of perl. It takes +as input a list of files (modules) that are assumed to reside in a directory +B relative to the current directory. Each file is sent to the +autosplitter one at a time, to be split into the directory B. + +In both usages of the autosplitter, only subroutines defined following the +perl I<__END__> token are split out into separate files. Some +routines may be placed prior to this marker to force their immediate loading +and parsing. + +=head2 Multiple packages + +As of version 1.01 of the AutoSplit module it is possible to have +multiple packages within a single file. Both of the following cases +are supported: + + package NAME; + __END__ + sub AAA { ... } + package NAME::option1; + sub BBB { ... } + package NAME::option2; + sub BBB { ... } + + package NAME; + __END__ + sub AAA { ... } + sub NAME::option1::BBB { ... } + sub NAME::option2::BBB { ... } + +=head1 DIAGNOSTICS + +C will inform the user if it is necessary to create the +top-level directory specified in the invocation. It is preferred that +the script or installation process that invokes C have +created the full directory path ahead of time. This warning may +indicate that the module is being split into an incorrect path. + +C will warn the user of all subroutines whose name causes +potential file naming conflicts on machines with drastically limited +(8 characters or less) file name length. Since the subroutine name is +used as the file name, these warnings can aid in portability to such +systems. + +Warnings are issued and the file skipped if C cannot locate +either the I<__END__> marker or a "package Name;"-style specification. + +C will also emit general diagnostics for inability to +create directories or files. + +=head1 AUTHOR + +C is maintained by the perl5-porters. Please direct +any questions to the canonical mailing list. Anything that +is applicable to the CPAN release can be sent to its maintainer, +though. + +Author and Maintainer: The Perl5-Porters + +Maintainer of the CPAN release: Steffen Mueller + +=head1 COPYRIGHT AND LICENSE + +This package has been part of the perl core since the first release +of perl5. It has been released separately to CPAN so older installations +can benefit from bug fixes. + +This package has the same copyright and license as the perl core: + + Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, + 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 + by Larry Wall and others + + All rights reserved. + + This program is free software; you can redistribute it and/or modify + it under the terms of either: + + a) the GNU General Public License as published by the Free + Software Foundation; either version 1, or (at your option) any + later version, or + + b) the "Artistic License" which comes with this Kit. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either + the GNU General Public License or the Artistic License for more details. + + You should have received a copy of the Artistic License with this + Kit, in the file named "Artistic". If not, I'll be glad to provide one. + + You should also have received a copy of the GNU General Public License + along with this program in the file named "Copying". If not, write to the + Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA + 02111-1307, USA or visit their web page on the internet at + http://www.gnu.org/copyleft/gpl.html. + + For those of you that choose to use the GNU General Public License, + my interpretation of the GNU General Public License is that no Perl + script falls under the terms of the GPL unless you explicitly put + said script under the terms of the GPL yourself. Furthermore, any + object code linked with perl does not automatically fall under the + terms of the GPL, provided such object code only adds definitions + of subroutines and variables, and does not otherwise impair the + resulting interpreter from executing any standard Perl script. I + consider linking in C subroutines in this manner to be the moral + equivalent of defining subroutines in the Perl language itself. You + may sell such an object file as proprietary provided that you provide + or offer to provide the Perl source, as specified by the GNU General + Public License. (This is merely an alternate way of specifying input + to the program.) You may also sell a binary produced by the dumping of + a running Perl script that belongs to you, provided that you provide or + offer to provide the Perl source as specified by the GPL. (The + fact that a Perl interpreter and your code are in the same binary file + is, in this case, a form of mere aggregation.) This is my interpretation + of the GPL. If you still have concerns or difficulties understanding + my intent, feel free to contact me. Of course, the Artistic License + spells all this out for your protection, so you may prefer to use that. + +=cut + +# for portability warn about names longer than $maxlen +$Maxlen = 8; # 8 for dos, 11 (14-".al") for SYSVR3 +$Verbose = 1; # 0=none, 1=minimal, 2=list .al files +$Keep = 0; +$CheckForAutoloader = 1; +$CheckModTime = 1; + +my $IndexFile = "autosplit.ix"; # file also serves as timestamp +my $maxflen = 255; +$maxflen = 14 if $Config{'d_flexfnam'} ne 'define'; +if (defined (&Dos::UseLFN)) { + $maxflen = Dos::UseLFN() ? 255 : 11; +} +my $Is_VMS = ($^O eq 'VMS'); + +# allow checking for valid ': attrlist' attachments. +# extra jugglery required to support both 5.8 and 5.9/5.10 features +# (support for 5.8 required for cross-compiling environments) + +my $attr_list = + $] >= 5.009005 ? + eval <<'__QR__' + qr{ + \s* : \s* + (?: + # one attribute + (?> # no backtrack + (?! \d) \w+ + (? \( (?: [^()]++ | (?&nested)++ )*+ \) ) ? + ) + (?: \s* : \s* | \s+ (?! :) ) + )* + }x +__QR__ + : + do { + # In pre-5.9.5 world we have to do dirty tricks. + # (we use 'our' rather than 'my' here, due to the rather complex and buggy + # behaviour of lexicals with qr// and (??{$lex}) ) + our $trick1; # yes, cannot our and assign at the same time. + $trick1 = qr{ \( (?: (?> [^()]+ ) | (??{ $trick1 }) )* \) }x; + our $trick2 = qr{ (?> (?! \d) \w+ (?:$trick1)? ) (?:\s*\:\s*|\s+(?!\:)) }x; + qr{ \s* : \s* (?: $trick2 )* }x; + }; + +sub autosplit{ + my($file, $autodir, $keep, $ckal, $ckmt) = @_; + # $file - the perl source file to be split (after __END__) + # $autodir - the ".../auto" dir below which to write split subs + # Handle optional flags: + $keep = $Keep unless defined $keep; + $ckal = $CheckForAutoloader unless defined $ckal; + $ckmt = $CheckModTime unless defined $ckmt; + autosplit_file($file, $autodir, $keep, $ckal, $ckmt); +} + +sub carp{ + require Carp; + goto &Carp::carp; +} + +# This function is used during perl building/installation +# ./miniperl -e 'use AutoSplit; autosplit_lib_modules(@ARGV)' ... + +sub autosplit_lib_modules { + my(@modules) = @_; # list of Module names + local $_; # Avoid clobber. + while (defined($_ = shift @modules)) { + while (m#([^:]+)::([^:].*)#) { # in case specified as ABC::XYZ + $_ = catfile($1, $2); + } + s|\\|/|g; # bug in ksh OS/2 + s#^lib/##s; # incase specified as lib/*.pm + my($lib) = catfile(curdir(), "lib"); + if ($Is_VMS) { # may need to convert VMS-style filespecs + $lib =~ s#^\[\]#.\/#; + } + s#^$lib\W+##s; # incase specified as ./lib/*.pm + if ($Is_VMS && /[:>\]]/) { # may need to convert VMS-style filespecs + my ($dir,$name) = (/(.*])(.*)/s); + $dir =~ s/.*lib[\.\]]//s; + $dir =~ s#[\.\]]#/#g; + $_ = $dir . $name; + } + autosplit_file(catfile($lib, $_), catfile($lib, "auto"), + $Keep, $CheckForAutoloader, $CheckModTime); + } + 0; +} + + +# private functions + +my $self_mod_time = (stat __FILE__)[9]; + +sub autosplit_file { + my($filename, $autodir, $keep, $check_for_autoloader, $check_mod_time) + = @_; + my(@outfiles); + local($_); + local($/) = "\n"; + + # where to write output files + $autodir ||= catfile(curdir(), "lib", "auto"); + if ($Is_VMS) { + ($autodir = VMS::Filespec::unixpath($autodir)) =~ s|/\z||; + $filename = VMS::Filespec::unixify($filename); # may have dirs + } + unless (-d $autodir){ + mkpath($autodir,0,0755); + # We should never need to create the auto dir + # here. installperl (or similar) should have done + # it. Expecting it to exist is a valuable sanity check against + # autosplitting into some random directory by mistake. + print "Warning: AutoSplit had to create top-level " . + "$autodir unexpectedly.\n"; + } + + # allow just a package name to be used + $filename .= ".pm" unless ($filename =~ m/\.pm\z/); + + open(my $in, "<$filename") or die "AutoSplit: Can't open $filename: $!\n"; + my($pm_mod_time) = (stat($filename))[9]; + my($autoloader_seen) = 0; + my($in_pod) = 0; + my($def_package,$last_package,$this_package,$fnr); + while (<$in>) { + # Skip pod text. + $fnr++; + $in_pod = 1 if /^=\w/; + $in_pod = 0 if /^=cut/; + next if ($in_pod || /^=cut/); + next if /^\s*#/; + + # record last package name seen + $def_package = $1 if (m/^\s*package\s+([\w:]+)\s*;/); + ++$autoloader_seen if m/^\s*(use|require)\s+AutoLoader\b/; + ++$autoloader_seen if m/\bISA\s*=.*\bAutoLoader\b/; + last if /^__END__/; + } + if ($check_for_autoloader && !$autoloader_seen){ + print "AutoSplit skipped $filename: no AutoLoader used\n" + if ($Verbose>=2); + return 0; + } + $_ or die "Can't find __END__ in $filename\n"; + + $def_package or die "Can't find 'package Name;' in $filename\n"; + + my($modpname) = _modpname($def_package); + + # this _has_ to match so we have a reasonable timestamp file + die "Package $def_package ($modpname.pm) does not ". + "match filename $filename" + unless ($filename =~ m/\Q$modpname.pm\E$/ or + ($^O eq 'dos') or ($^O eq 'MSWin32') or ($^O eq 'NetWare') or + $Is_VMS && $filename =~ m/$modpname.pm/i); + + my($al_idx_file) = catfile($autodir, $modpname, $IndexFile); + + if ($check_mod_time){ + my($al_ts_time) = (stat("$al_idx_file"))[9] || 1; + if ($al_ts_time >= $pm_mod_time and + $al_ts_time >= $self_mod_time){ + print "AutoSplit skipped ($al_idx_file newer than $filename)\n" + if ($Verbose >= 2); + return undef; # one undef, not a list + } + } + + my($modnamedir) = catdir($autodir, $modpname); + print "AutoSplitting $filename ($modnamedir)\n" + if $Verbose; + + unless (-d $modnamedir){ + mkpath($modnamedir,0,0777); + } + + # We must try to deal with some SVR3 systems with a limit of 14 + # characters for file names. Sadly we *cannot* simply truncate all + # file names to 14 characters on these systems because we *must* + # create filenames which exactly match the names used by AutoLoader.pm. + # This is a problem because some systems silently truncate the file + # names while others treat long file names as an error. + + my $Is83 = $maxflen==11; # plain, case INSENSITIVE dos filenames + + my(@subnames, $subname, %proto, %package); + my @cache = (); + my $caching = 1; + $last_package = ''; + my $out; + while (<$in>) { + $fnr++; + $in_pod = 1 if /^=\w/; + $in_pod = 0 if /^=cut/; + next if ($in_pod || /^=cut/); + # the following (tempting) old coding gives big troubles if a + # cut is forgotten at EOF: + # next if /^=\w/ .. /^=cut/; + if (/^package\s+([\w:]+)\s*;/) { + $this_package = $def_package = $1; + } + + if (/^sub\s+([\w:]+)(\s*(?:\(.*?\))?(?:$attr_list)?)/) { + print $out "# end of $last_package\::$subname\n1;\n" + if $last_package; + $subname = $1; + my $proto = $2 || ''; + if ($subname =~ s/(.*):://){ + $this_package = $1; + } else { + $this_package = $def_package; + } + my $fq_subname = "$this_package\::$subname"; + $package{$fq_subname} = $this_package; + $proto{$fq_subname} = $proto; + push(@subnames, $fq_subname); + my($lname, $sname) = ($subname, substr($subname,0,$maxflen-3)); + $modpname = _modpname($this_package); + my($modnamedir) = catdir($autodir, $modpname); + mkpath($modnamedir,0,0777); + my($lpath) = catfile($modnamedir, "$lname.al"); + my($spath) = catfile($modnamedir, "$sname.al"); + my $path; + + if (!$Is83 and open($out, ">$lpath")){ + $path=$lpath; + print " writing $lpath\n" if ($Verbose>=2); + } else { + open($out, ">$spath") or die "Can't create $spath: $!\n"; + $path=$spath; + print " writing $spath (with truncated name)\n" + if ($Verbose>=1); + } + push(@outfiles, $path); + my $lineno = $fnr - @cache; + print $out < lc($_) } @outfiles; + } else { + @outfiles{@outfiles} = @outfiles; + } + my(%outdirs,@outdirs); + for (@outfiles) { + $outdirs{File::Basename::dirname($_)}||=1; + } + for my $dir (keys %outdirs) { + opendir(my $outdir,$dir); + foreach (sort readdir($outdir)){ + next unless /\.al\z/; + my($file) = catfile($dir, $_); + $file = lc $file if $Is83 or $Is_VMS; + next if $outfiles{$file}; + print " deleting $file\n" if ($Verbose>=2); + my($deleted,$thistime); # catch all versions on VMS + do { $deleted += ($thistime = unlink $file) } while ($thistime); + carp ("Unable to delete $file: $!") unless $deleted; + } + closedir($outdir); + } + } + + open(my $ts,">$al_idx_file") or + carp ("AutoSplit: unable to create timestamp file ($al_idx_file): $!"); + print $ts "# Index created by AutoSplit for $filename\n"; + print $ts "# (file acts as timestamp)\n"; + $last_package = ''; + for my $fqs (@subnames) { + my($subname) = $fqs; + $subname =~ s/.*:://; + print $ts "package $package{$fqs};\n" + unless $last_package eq $package{$fqs}; + print $ts "sub $subname $proto{$fqs};\n"; + $last_package = $package{$fqs}; + } + print $ts "1;\n"; + close($ts); + + _check_unique($filename, $Maxlen, 1, @outfiles); + + @outfiles; +} + +sub _modpname ($) { + my($package) = @_; + my $modpname = $package; + if ($^O eq 'MSWin32') { + $modpname =~ s#::#\\#g; + } else { + my @modpnames = (); + while ($modpname =~ m#(.*?[^:])::([^:].*)#) { + push @modpnames, $1; + $modpname = $2; + } + $modpname = catfile(@modpnames, $modpname); + } + if ($Is_VMS) { + $modpname = VMS::Filespec::unixify($modpname); # may have dirs + } + $modpname; +} + +sub _check_unique { + my($filename, $maxlen, $warn, @outfiles) = @_; + my(%notuniq) = (); + my(%shorts) = (); + my(@toolong) = grep( + length(File::Basename::basename($_)) + > $maxlen, + @outfiles + ); + + foreach (@toolong){ + my($dir) = File::Basename::dirname($_); + my($file) = File::Basename::basename($_); + my($trunc) = substr($file,0,$maxlen); + $notuniq{$dir}{$trunc} = 1 if $shorts{$dir}{$trunc}; + $shorts{$dir}{$trunc} = $shorts{$dir}{$trunc} ? + "$shorts{$dir}{$trunc}, $file" : $file; + } + if (%notuniq && $warn){ + print "$filename: some names are not unique when " . + "truncated to $maxlen characters:\n"; + foreach my $dir (sort keys %notuniq){ + print " directory $dir:\n"; + foreach my $trunc (sort keys %{$notuniq{$dir}}) { + print " $shorts{$dir}{$trunc} truncate to $trunc\n"; + } + } + } +} + +1; +__END__ + +# test functions so AutoSplit.pm can be applied to itself: +sub test1 ($) { "test 1\n"; } +sub test2 ($$) { "test 2\n"; } +sub test3 ($$$) { "test 3\n"; } +sub testtesttesttest4_1 { "test 4\n"; } +sub testtesttesttest4_2 { "duplicate test 4\n"; } +sub Just::Another::test5 { "another test 5\n"; } +sub test6 { return join ":", __FILE__,__LINE__; } +package Yet::Another::AutoSplit; +sub testtesttesttest4_1 ($) { "another test 4\n"; } +sub testtesttesttest4_2 ($$) { "another duplicate test 4\n"; } +package Yet::More::Attributes; +sub test_a1 ($) : locked :locked { 1; } +sub test_a2 : locked { 1; } diff --git a/Master/tlpkg/tlperl/lib/B.pm b/Master/tlpkg/tlperl/lib/B.pm new file mode 100644 index 00000000000..f7d22f11478 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/B.pm @@ -0,0 +1,1189 @@ +# B.pm +# +# Copyright (c) 1996, 1997, 1998 Malcolm Beattie +# +# You may distribute under the terms of either the GNU General Public +# License or the Artistic License, as specified in the README file. +# +package B; + +our $VERSION = '1.23'; + +use XSLoader (); +require Exporter; +@ISA = qw(Exporter); + +# walkoptree_slow comes from B.pm (you are there), +# walkoptree comes from B.xs +@EXPORT_OK = qw(minus_c ppname save_BEGINs + class peekop cast_I32 cstring cchar hash threadsv_names + main_root main_start main_cv svref_2object opnumber + sub_generation amagic_generation perlstring + walkoptree_slow walkoptree walkoptree_exec walksymtable + parents comppadlist sv_undef compile_stats timing_info + begin_av init_av check_av end_av regex_padav dowarn defstash + curstash warnhook diehook inc_gv @optype @specialsv_name + ); +push @EXPORT_OK, qw(unitcheck_av) if $] > 5.009; + +sub OPf_KIDS (); +use strict; +@B::SV::ISA = 'B::OBJECT'; +@B::NULL::ISA = 'B::SV'; +@B::PV::ISA = 'B::SV'; +@B::IV::ISA = 'B::SV'; +@B::NV::ISA = 'B::SV'; +# RV is eliminated with 5.11.0, but effectively is a specialisation of IV now. +@B::RV::ISA = $] >= 5.011 ? 'B::IV' : 'B::SV'; +@B::PVIV::ISA = qw(B::PV B::IV); +@B::PVNV::ISA = qw(B::PVIV B::NV); +@B::PVMG::ISA = 'B::PVNV'; +@B::REGEXP::ISA = 'B::PVMG' if $] >= 5.011; +# Change in the inheritance hierarchy post 5.9.0 +@B::PVLV::ISA = $] > 5.009 ? 'B::GV' : 'B::PVMG'; +# BM is eliminated post 5.9.5, but effectively is a specialisation of GV now. +@B::BM::ISA = $] > 5.009005 ? 'B::GV' : 'B::PVMG'; +@B::AV::ISA = 'B::PVMG'; +@B::GV::ISA = 'B::PVMG'; +@B::HV::ISA = 'B::PVMG'; +@B::CV::ISA = 'B::PVMG'; +@B::IO::ISA = 'B::PVMG'; +@B::FM::ISA = 'B::CV'; + +@B::OP::ISA = 'B::OBJECT'; +@B::UNOP::ISA = 'B::OP'; +@B::BINOP::ISA = 'B::UNOP'; +@B::LOGOP::ISA = 'B::UNOP'; +@B::LISTOP::ISA = 'B::BINOP'; +@B::SVOP::ISA = 'B::OP'; +@B::PADOP::ISA = 'B::OP'; +@B::PVOP::ISA = 'B::OP'; +@B::LOOP::ISA = 'B::LISTOP'; +@B::PMOP::ISA = 'B::LISTOP'; +@B::COP::ISA = 'B::OP'; + +@B::SPECIAL::ISA = 'B::OBJECT'; + +@B::optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP); +# bytecode.pl contained the following comment: +# Nullsv *must* come first in the following so that the condition +# ($$sv == 0) can continue to be used to test (sv == Nullsv). +@B::specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no + (SV*)pWARN_ALL (SV*)pWARN_NONE (SV*)pWARN_STD); + +{ + # Stop "-w" from complaining about the lack of a real B::OBJECT class + package B::OBJECT; +} + +sub B::GV::SAFENAME { + my $name = (shift())->NAME; + + # The regex below corresponds to the isCONTROLVAR macro + # from toke.c + + $name =~ s/^([\cA-\cZ\c\\c[\c]\c?\c_\c^])/"^". + chr( utf8::unicode_to_native( 64 ^ ord($1) ))/e; + + # When we say unicode_to_native we really mean ascii_to_native, + # which matters iff this is a non-ASCII platform (EBCDIC). + + return $name; +} + +sub B::IV::int_value { + my ($self) = @_; + return (($self->FLAGS() & SVf_IVisUV()) ? $self->UVX : $self->IV); +} + +sub B::NULL::as_string() {""} +sub B::IV::as_string() {goto &B::IV::int_value} +sub B::PV::as_string() {goto &B::PV::PV} + +my $debug; +my $op_count = 0; +my @parents = (); + +sub debug { + my ($class, $value) = @_; + $debug = $value; + walkoptree_debug($value); +} + +sub class { + my $obj = shift; + my $name = ref $obj; + $name =~ s/^.*:://; + return $name; +} + +sub parents { \@parents } + +# For debugging +sub peekop { + my $op = shift; + return sprintf("%s (0x%x) %s", class($op), $$op, $op->name); +} + +sub walkoptree_slow { + my($op, $method, $level) = @_; + $op_count++; # just for statistics + $level ||= 0; + warn(sprintf("walkoptree: %d. %s\n", $level, peekop($op))) if $debug; + $op->$method($level) if $op->can($method); + if ($$op && ($op->flags & OPf_KIDS)) { + my $kid; + unshift(@parents, $op); + for ($kid = $op->first; $$kid; $kid = $kid->sibling) { + walkoptree_slow($kid, $method, $level + 1); + } + shift @parents; + } + if (class($op) eq 'PMOP' + && ref($op->pmreplroot) + && ${$op->pmreplroot} + && $op->pmreplroot->isa( 'B::OP' )) + { + unshift(@parents, $op); + walkoptree_slow($op->pmreplroot, $method, $level + 1); + shift @parents; + } +} + +sub compile_stats { + return "Total number of OPs processed: $op_count\n"; +} + +sub timing_info { + my ($sec, $min, $hr) = localtime; + my ($user, $sys) = times; + sprintf("%02d:%02d:%02d user=$user sys=$sys", + $hr, $min, $sec, $user, $sys); +} + +my %symtable; + +sub clearsym { + %symtable = (); +} + +sub savesym { + my ($obj, $value) = @_; +# warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug + $symtable{sprintf("sym_%x", $$obj)} = $value; +} + +sub objsym { + my $obj = shift; + return $symtable{sprintf("sym_%x", $$obj)}; +} + +sub walkoptree_exec { + my ($op, $method, $level) = @_; + $level ||= 0; + my ($sym, $ppname); + my $prefix = " " x $level; + for (; $$op; $op = $op->next) { + $sym = objsym($op); + if (defined($sym)) { + print $prefix, "goto $sym\n"; + return; + } + savesym($op, sprintf("%s (0x%lx)", class($op), $$op)); + $op->$method($level); + $ppname = $op->name; + if ($ppname =~ + /^(d?or(assign)?|and(assign)?|mapwhile|grepwhile|entertry|range|cond_expr)$/) + { + print $prefix, uc($1), " => {\n"; + walkoptree_exec($op->other, $method, $level + 1); + print $prefix, "}\n"; + } elsif ($ppname eq "match" || $ppname eq "subst") { + my $pmreplstart = $op->pmreplstart; + if ($$pmreplstart) { + print $prefix, "PMREPLSTART => {\n"; + walkoptree_exec($pmreplstart, $method, $level + 1); + print $prefix, "}\n"; + } + } elsif ($ppname eq "substcont") { + print $prefix, "SUBSTCONT => {\n"; + walkoptree_exec($op->other->pmreplstart, $method, $level + 1); + print $prefix, "}\n"; + $op = $op->other; + } elsif ($ppname eq "enterloop") { + print $prefix, "REDO => {\n"; + walkoptree_exec($op->redoop, $method, $level + 1); + print $prefix, "}\n", $prefix, "NEXT => {\n"; + walkoptree_exec($op->nextop, $method, $level + 1); + print $prefix, "}\n", $prefix, "LAST => {\n"; + walkoptree_exec($op->lastop, $method, $level + 1); + print $prefix, "}\n"; + } elsif ($ppname eq "subst") { + my $replstart = $op->pmreplstart; + if ($$replstart) { + print $prefix, "SUBST => {\n"; + walkoptree_exec($replstart, $method, $level + 1); + print $prefix, "}\n"; + } + } + } +} + +sub walksymtable { + my ($symref, $method, $recurse, $prefix) = @_; + my $sym; + my $ref; + my $fullname; + no strict 'refs'; + $prefix = '' unless defined $prefix; + while (($sym, $ref) = each %$symref) { + $fullname = "*main::".$prefix.$sym; + if ($sym =~ /::$/) { + $sym = $prefix . $sym; + if (svref_2object(\*$sym)->NAME ne "main::" && $sym ne "::" && &$recurse($sym)) { + walksymtable(\%$fullname, $method, $recurse, $sym); + } + } else { + svref_2object(\*$fullname)->$method(); + } + } +} + +{ + package B::Section; + my $output_fh; + my %sections; + + sub new { + my ($class, $section, $symtable, $default) = @_; + $output_fh ||= FileHandle->new_tmpfile; + my $obj = bless [-1, $section, $symtable, $default], $class; + $sections{$section} = $obj; + return $obj; + } + + sub get { + my ($class, $section) = @_; + return $sections{$section}; + } + + sub add { + my $section = shift; + while (defined($_ = shift)) { + print $output_fh "$section->[1]\t$_\n"; + $section->[0]++; + } + } + + sub index { + my $section = shift; + return $section->[0]; + } + + sub name { + my $section = shift; + return $section->[1]; + } + + sub symtable { + my $section = shift; + return $section->[2]; + } + + sub default { + my $section = shift; + return $section->[3]; + } + + sub output { + my ($section, $fh, $format) = @_; + my $name = $section->name; + my $sym = $section->symtable || {}; + my $default = $section->default; + + seek($output_fh, 0, 0); + while (<$output_fh>) { + chomp; + s/^(.*?)\t//; + if ($1 eq $name) { + s{(s\\_[0-9a-f]+)} { + exists($sym->{$1}) ? $sym->{$1} : $default; + }ge; + printf $fh $format, $_; + } + } + } +} + +XSLoader::load 'B'; + +1; + +__END__ + +=head1 NAME + +B - The Perl Compiler Backend + +=head1 SYNOPSIS + + use B; + +=head1 DESCRIPTION + +The C module supplies classes which allow a Perl program to delve +into its own innards. It is the module used to implement the +"backends" of the Perl compiler. Usage of the compiler does not +require knowledge of this module: see the F module for the +user-visible part. The C module is of use to those who want to +write new compiler backends. This documentation assumes that the +reader knows a fair amount about perl's internals including such +things as SVs, OPs and the internal symbol table and syntax tree +of a program. + +=head1 OVERVIEW + +The C module contains a set of utility functions for querying the +current state of the Perl interpreter; typically these functions +return objects from the B::SV and B::OP classes, or their derived +classes. These classes in turn define methods for querying the +resulting objects about their own internal state. + +=head1 Utility Functions + +The C module exports a variety of functions: some are simple +utility functions, others provide a Perl program with a way to +get an initial "handle" on an internal object. + +=head2 Functions Returning C, C, C, and C objects + +For descriptions of the class hierarchy of these objects and the +methods that can be called on them, see below, L<"OVERVIEW OF +CLASSES"> and L<"SV-RELATED CLASSES">. + +=over 4 + +=item sv_undef + +Returns the SV object corresponding to the C variable C. + +=item sv_yes + +Returns the SV object corresponding to the C variable C. + +=item sv_no + +Returns the SV object corresponding to the C variable C. + +=item svref_2object(SVREF) + +Takes a reference to any Perl value, and turns the referred-to value +into an object in the appropriate B::OP-derived or B::SV-derived +class. Apart from functions such as C, this is the primary +way to get an initial "handle" on an internal perl data structure +which can then be followed with the other access methods. + +The returned object will only be valid as long as the underlying OPs +and SVs continue to exist. Do not attempt to use the object after the +underlying structures are freed. + +=item amagic_generation + +Returns the SV object corresponding to the C variable C. + +=item init_av + +Returns the AV object (i.e. in class B::AV) representing INIT blocks. + +=item check_av + +Returns the AV object (i.e. in class B::AV) representing CHECK blocks. + +=item unitcheck_av + +Returns the AV object (i.e. in class B::AV) representing UNITCHECK blocks. + +=item begin_av + +Returns the AV object (i.e. in class B::AV) representing BEGIN blocks. + +=item end_av + +Returns the AV object (i.e. in class B::AV) representing END blocks. + +=item comppadlist + +Returns the AV object (i.e. in class B::AV) of the global comppadlist. + +=item regex_padav + +Only when perl was compiled with ithreads. + +=item main_cv + +Return the (faked) CV corresponding to the main part of the Perl +program. + +=back + +=head2 Functions for Examining the Symbol Table + +=over 4 + +=item walksymtable(SYMREF, METHOD, RECURSE, PREFIX) + +Walk the symbol table starting at SYMREF and call METHOD on each +symbol (a B::GV object) visited. When the walk reaches package +symbols (such as "Foo::") it invokes RECURSE, passing in the symbol +name, and only recurses into the package if that sub returns true. + +PREFIX is the name of the SYMREF you're walking. + +For example: + + # Walk CGI's symbol table calling print_subs on each symbol. + # Recurse only into CGI::Util:: + walksymtable(\%CGI::, 'print_subs', sub { $_[0] eq 'CGI::Util::' }, + 'CGI::'); + +print_subs() is a B::GV method you have declared. Also see L<"B::GV +Methods">, below. + +=back + +=head2 Functions Returning C objects or for walking op trees + +For descriptions of the class hierarchy of these objects and the +methods that can be called on them, see below, L<"OVERVIEW OF +CLASSES"> and L<"OP-RELATED CLASSES">. + +=over 4 + +=item main_root + +Returns the root op (i.e. an object in the appropriate B::OP-derived +class) of the main part of the Perl program. + +=item main_start + +Returns the starting op of the main part of the Perl program. + +=item walkoptree(OP, METHOD) + +Does a tree-walk of the syntax tree based at OP and calls METHOD on +each op it visits. Each node is visited before its children. If +C (see below) has been called to turn debugging on then +the method C is called on each op before METHOD is +called. + +=item walkoptree_debug(DEBUG) + +Returns the current debugging flag for C. If the optional +DEBUG argument is non-zero, it sets the debugging flag to that. See +the description of C above for what the debugging flag +does. + +=back + +=head2 Miscellaneous Utility Functions + +=over 4 + +=item ppname(OPNUM) + +Return the PP function name (e.g. "pp_add") of op number OPNUM. + +=item hash(STR) + +Returns a string in the form "0x..." representing the value of the +internal hash function used by perl on string STR. + +=item cast_I32(I) + +Casts I to the internal I32 type used by that perl. + +=item minus_c + +Does the equivalent of the C<-c> command-line option. Obviously, this +is only useful in a BEGIN block or else the flag is set too late. + +=item cstring(STR) + +Returns a double-quote-surrounded escaped version of STR which can +be used as a string in C source code. + +=item perlstring(STR) + +Returns a double-quote-surrounded escaped version of STR which can +be used as a string in Perl source code. + +=item class(OBJ) + +Returns the class of an object without the part of the classname +preceding the first C<"::">. This is used to turn C<"B::UNOP"> into +C<"UNOP"> for example. + +=item threadsv_names + +In a perl compiled for threads, this returns a list of the special +per-thread threadsv variables. + +=back + +=head2 Exported utility variabiles + +=over 4 + +=item @optype + + my $op_type = $optype[$op_type_num]; + +A simple mapping of the op type number to its type (like 'COP' or 'BINOP'). + +=item @specialsv_name + + my $sv_name = $specialsv_name[$sv_index]; + +Certain SV types are considered 'special'. They're represented by +B::SPECIAL and are referred to by a number from the specialsv_list. +This array maps that number back to the name of the SV (like 'Nullsv' +or '&PL_sv_undef'). + +=back + + +=head1 OVERVIEW OF CLASSES + +The C structures used by Perl's internals to hold SV and OP +information (PVIV, AV, HV, ..., OP, SVOP, UNOP, ...) are modelled on a +class hierarchy and the C module gives access to them via a true +object hierarchy. Structure fields which point to other objects +(whether types of SV or types of OP) are represented by the C +module as Perl objects of the appropriate class. + +The bulk of the C module is the methods for accessing fields of +these structures. + +Note that all access is read-only. You cannot modify the internals by +using this module. Also, note that the B::OP and B::SV objects created +by this module are only valid for as long as the underlying objects +exist; their creation doesn't increase the reference counts of the +underlying objects. Trying to access the fields of a freed object will +give incomprehensible results, or worse. + +=head2 SV-RELATED CLASSES + +B::IV, B::NV, B::RV, B::PV, B::PVIV, B::PVNV, B::PVMG, B::BM (5.9.5 and +earlier), B::PVLV, B::AV, B::HV, B::CV, B::GV, B::FM, B::IO. These classes +correspond in the obvious way to the underlying C structures of similar names. +The inheritance hierarchy mimics the underlying C "inheritance". For the +5.10.x branch, (I 5.10.0, 5.10.1 I) this is: + + B::SV + | + +------------+------------+------------+ + | | | | + B::PV B::IV B::NV B::RV + \ / / + \ / / + B::PVIV / + \ / + \ / + \ / + B::PVNV + | + | + B::PVMG + | + +-----+-----+-----+-----+ + | | | | | + B::AV B::GV B::HV B::CV B::IO + | | + | | + B::PVLV B::FM + +For 5.9.0 and earlier, PVLV is a direct subclass of PVMG, and BM is still +present as a distinct type, so the base of this diagram is + + + | + | + B::PVMG + | + +------+-----+-----+-----+-----+-----+ + | | | | | | | + B::PVLV B::BM B::AV B::GV B::HV B::CV B::IO + | + | + B::FM + +For 5.11.0 and later, B::RV is abolished, and IVs can be used to store +references, and a new type B::REGEXP is introduced, giving this structure: + + B::SV + | + +------------+------------+ + | | | + B::PV B::IV B::NV + \ / / + \ / / + B::PVIV / + \ / + \ / + \ / + B::PVNV + | + | + B::PVMG + | + +-------+-------+---+---+-------+-------+ + | | | | | | + B::AV B::GV B::HV B::CV B::IO B::REGEXP + | | + | | + B::PVLV B::FM + + +Access methods correspond to the underlying C macros for field access, +usually with the leading "class indication" prefix removed (Sv, Av, +Hv, ...). The leading prefix is only left in cases where its removal +would cause a clash in method name. For example, C stays +as-is since its abbreviation would clash with the "superclass" method +C (corresponding to the C function C). + +=head2 B::SV Methods + +=over 4 + +=item REFCNT + +=item FLAGS + +=item object_2svref + +Returns a reference to the regular scalar corresponding to this +B::SV object. In other words, this method is the inverse operation +to the svref_2object() subroutine. This scalar and other data it points +at should be considered read-only: modifying them is neither safe nor +guaranteed to have a sensible effect. + +=back + +=head2 B::IV Methods + +=over 4 + +=item IV + +Returns the value of the IV, I. This will be misleading +if C. Perhaps you want the +C method instead? + +=item IVX + +=item UVX + +=item int_value + +This method returns the value of the IV as an integer. +It differs from C in that it returns the correct +value regardless of whether it's stored signed or +unsigned. + +=item needs64bits + +=item packiv + +=back + +=head2 B::NV Methods + +=over 4 + +=item NV + +=item NVX + +=back + +=head2 B::RV Methods + +=over 4 + +=item RV + +=back + +=head2 B::PV Methods + +=over 4 + +=item PV + +This method is the one you usually want. It constructs a +string using the length and offset information in the struct: +for ordinary scalars it will return the string that you'd see +from Perl, even if it contains null characters. + +=item RV + +Same as B::RV::RV, except that it will die() if the PV isn't +a reference. + +=item PVX + +This method is less often useful. It assumes that the string +stored in the struct is null-terminated, and disregards the +length information. + +It is the appropriate method to use if you need to get the name +of a lexical variable from a padname array. Lexical variable names +are always stored with a null terminator, and the length field +(SvCUR) is overloaded for other purposes and can't be relied on here. + +=back + +=head2 B::PVMG Methods + +=over 4 + +=item MAGIC + +=item SvSTASH + +=back + +=head2 B::MAGIC Methods + +=over 4 + +=item MOREMAGIC + +=item precomp + +Only valid on r-magic, returns the string that generated the regexp. + +=item PRIVATE + +=item TYPE + +=item FLAGS + +=item OBJ + +Will die() if called on r-magic. + +=item PTR + +=item REGEX + +Only valid on r-magic, returns the integer value of the REGEX stored +in the MAGIC. + +=back + +=head2 B::PVLV Methods + +=over 4 + +=item TARGOFF + +=item TARGLEN + +=item TYPE + +=item TARG + +=back + +=head2 B::BM Methods + +=over 4 + +=item USEFUL + +=item PREVIOUS + +=item RARE + +=item TABLE + +=back + +=head2 B::GV Methods + +=over 4 + +=item is_empty + +This method returns TRUE if the GP field of the GV is NULL. + +=item NAME + +=item SAFENAME + +This method returns the name of the glob, but if the first +character of the name is a control character, then it converts +it to ^X first, so that *^G would return "^G" rather than "\cG". + +It's useful if you want to print out the name of a variable. +If you restrict yourself to globs which exist at compile-time +then the result ought to be unambiguous, because code like +C<${"^G"} = 1> is compiled as two ops - a constant string and +a dereference (rv2gv) - so that the glob is created at runtime. + +If you're working with globs at runtime, and need to disambiguate +*^G from *{"^G"}, then you should use the raw NAME method. + +=item STASH + +=item SV + +=item IO + +=item FORM + +=item AV + +=item HV + +=item EGV + +=item CV + +=item CVGEN + +=item LINE + +=item FILE + +=item FILEGV + +=item GvREFCNT + +=item FLAGS + +=back + +=head2 B::IO Methods + +=over 4 + +=item LINES + +=item PAGE + +=item PAGE_LEN + +=item LINES_LEFT + +=item TOP_NAME + +=item TOP_GV + +=item FMT_NAME + +=item FMT_GV + +=item BOTTOM_NAME + +=item BOTTOM_GV + +=item SUBPROCESS + +=item IoTYPE + +=item IoFLAGS + +=item IsSTD + +Takes one arguments ( 'stdin' | 'stdout' | 'stderr' ) and returns true +if the IoIFP of the object is equal to the handle whose name was +passed as argument ( i.e. $io->IsSTD('stderr') is true if +IoIFP($io) == PerlIO_stdin() ). + +=back + +=head2 B::AV Methods + +=over 4 + +=item FILL + +=item MAX + +=item ARRAY + +=item ARRAYelt + +Like C, but takes an index as an argument to get only one element, +rather than a list of all of them. + +=item OFF + +This method is deprecated if running under Perl 5.8, and is no longer present +if running under Perl 5.9 + +=item AvFLAGS + +This method returns the AV specific flags. In Perl 5.9 these are now stored +in with the main SV flags, so this method is no longer present. + +=back + +=head2 B::CV Methods + +=over 4 + +=item STASH + +=item START + +=item ROOT + +=item GV + +=item FILE + +=item DEPTH + +=item PADLIST + +=item OUTSIDE + +=item OUTSIDE_SEQ + +=item XSUB + +=item XSUBANY + +For constant subroutines, returns the constant SV returned by the subroutine. + +=item CvFLAGS + +=item const_sv + +=back + +=head2 B::HV Methods + +=over 4 + +=item FILL + +=item MAX + +=item KEYS + +=item RITER + +=item NAME + +=item ARRAY + +=item PMROOT + +This method is not present if running under Perl 5.9, as the PMROOT +information is no longer stored directly in the hash. + +=back + +=head2 OP-RELATED CLASSES + +C, C, C, C, C, C, +C, C, C, C, C. + +These classes correspond in the obvious way to the underlying C +structures of similar names. The inheritance hierarchy mimics the +underlying C "inheritance": + + B::OP + | + +---------------+--------+--------+-------+ + | | | | | + B::UNOP B::SVOP B::PADOP B::COP B::PVOP + ,' `-. + / `--. + B::BINOP B::LOGOP + | + | + B::LISTOP + ,' `. + / \ + B::LOOP B::PMOP + +Access methods correspond to the underlying C structre field names, +with the leading "class indication" prefix (C<"op_">) removed. + +=head2 B::OP Methods + +These methods get the values of similarly named fields within the OP +data structure. See top of C for more info. + +=over 4 + +=item next + +=item sibling + +=item name + +This returns the op name as a string (e.g. "add", "rv2av"). + +=item ppaddr + +This returns the function name as a string (e.g. "PL_ppaddr[OP_ADD]", +"PL_ppaddr[OP_RV2AV]"). + +=item desc + +This returns the op description from the global C PL_op_desc array +(e.g. "addition" "array deref"). + +=item targ + +=item type + +=item opt + +=item flags + +=item private + +=item spare + +=back + +=head2 B::UNOP METHOD + +=over 4 + +=item first + +=back + +=head2 B::BINOP METHOD + +=over 4 + +=item last + +=back + +=head2 B::LOGOP METHOD + +=over 4 + +=item other + +=back + +=head2 B::LISTOP METHOD + +=over 4 + +=item children + +=back + +=head2 B::PMOP Methods + +=over 4 + +=item pmreplroot + +=item pmreplstart + +=item pmnext + +Only up to Perl 5.9.4 + +=item pmregexp + +=item pmflags + +=item extflags + +Since Perl 5.9.5 + +=item precomp + +=item pmoffset + +Only when perl was compiled with ithreads. + +=back + +=head2 B::SVOP METHOD + +=over 4 + +=item sv + +=item gv + +=back + +=head2 B::PADOP METHOD + +=over 4 + +=item padix + +=back + +=head2 B::PVOP METHOD + +=over 4 + +=item pv + +=back + +=head2 B::LOOP Methods + +=over 4 + +=item redoop + +=item nextop + +=item lastop + +=back + +=head2 B::COP Methods + +=over 4 + +=item label + +=item stash + +=item stashpv + +=item file + +=item cop_seq + +=item arybase + +=item line + +=item warnings + +=item io + +=item hints + +=item hints_hash + +=back + + +=head1 AUTHOR + +Malcolm Beattie, C + +=cut diff --git a/Master/tlpkg/tlperl/lib/Benchmark.pm b/Master/tlpkg/tlperl/lib/Benchmark.pm new file mode 100644 index 00000000000..269674cfda5 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Benchmark.pm @@ -0,0 +1,1044 @@ +package Benchmark; + +use strict; + + +=head1 NAME + +Benchmark - benchmark running times of Perl code + +=head1 SYNOPSIS + + use Benchmark qw(:all) ; + + timethis ($count, "code"); + + # Use Perl code in strings... + timethese($count, { + 'Name1' => '...code1...', + 'Name2' => '...code2...', + }); + + # ... or use subroutine references. + timethese($count, { + 'Name1' => sub { ...code1... }, + 'Name2' => sub { ...code2... }, + }); + + # cmpthese can be used both ways as well + cmpthese($count, { + 'Name1' => '...code1...', + 'Name2' => '...code2...', + }); + + cmpthese($count, { + 'Name1' => sub { ...code1... }, + 'Name2' => sub { ...code2... }, + }); + + # ...or in two stages + $results = timethese($count, + { + 'Name1' => sub { ...code1... }, + 'Name2' => sub { ...code2... }, + }, + 'none' + ); + cmpthese( $results ) ; + + $t = timeit($count, '...other code...') + print "$count loops of other code took:",timestr($t),"\n"; + + $t = countit($time, '...other code...') + $count = $t->iters ; + print "$count loops of other code took:",timestr($t),"\n"; + + # enable hires wallclock timing if possible + use Benchmark ':hireswallclock'; + +=head1 DESCRIPTION + +The Benchmark module encapsulates a number of routines to help you +figure out how long it takes to execute some code. + +timethis - run a chunk of code several times + +timethese - run several chunks of code several times + +cmpthese - print results of timethese as a comparison chart + +timeit - run a chunk of code and see how long it goes + +countit - see how many times a chunk of code runs in a given time + + +=head2 Methods + +=over 10 + +=item new + +Returns the current time. Example: + + use Benchmark; + $t0 = Benchmark->new; + # ... your code here ... + $t1 = Benchmark->new; + $td = timediff($t1, $t0); + print "the code took:",timestr($td),"\n"; + +=item debug + +Enables or disable debugging by setting the C<$Benchmark::Debug> flag: + + Benchmark->debug(1); + $t = timeit(10, ' 5 ** $Global '); + Benchmark->debug(0); + +=item iters + +Returns the number of iterations. + +=back + +=head2 Standard Exports + +The following routines will be exported into your namespace +if you use the Benchmark module: + +=over 10 + +=item timeit(COUNT, CODE) + +Arguments: COUNT is the number of times to run the loop, and CODE is +the code to run. CODE may be either a code reference or a string to +be eval'd; either way it will be run in the caller's package. + +Returns: a Benchmark object. + +=item timethis ( COUNT, CODE, [ TITLE, [ STYLE ]] ) + +Time COUNT iterations of CODE. CODE may be a string to eval or a +code reference; either way the CODE will run in the caller's package. +Results will be printed to STDOUT as TITLE followed by the times. +TITLE defaults to "timethis COUNT" if none is provided. STYLE +determines the format of the output, as described for timestr() below. + +The COUNT can be zero or negative: this means the I to run. A zero signifies the default of 3 seconds. For +example to run at least for 10 seconds: + + timethis(-10, $code) + +or to run two pieces of code tests for at least 3 seconds: + + timethese(0, { test1 => '...', test2 => '...'}) + +CPU seconds is, in UNIX terms, the user time plus the system time of +the process itself, as opposed to the real (wallclock) time and the +time spent by the child processes. Less than 0.1 seconds is not +accepted (-0.01 as the count, for example, will cause a fatal runtime +exception). + +Note that the CPU seconds is the B time: CPU scheduling and +other operating system factors may complicate the attempt so that a +little bit more time is spent. The benchmark output will, however, +also tell the number of C<$code> runs/second, which should be a more +interesting number than the actually spent seconds. + +Returns a Benchmark object. + +=item timethese ( COUNT, CODEHASHREF, [ STYLE ] ) + +The CODEHASHREF is a reference to a hash containing names as keys +and either a string to eval or a code reference for each value. +For each (KEY, VALUE) pair in the CODEHASHREF, this routine will +call + + timethis(COUNT, VALUE, KEY, STYLE) + +The routines are called in string comparison order of KEY. + +The COUNT can be zero or negative, see timethis(). + +Returns a hash reference of Benchmark objects, keyed by name. + +=item timediff ( T1, T2 ) + +Returns the difference between two Benchmark times as a Benchmark +object suitable for passing to timestr(). + +=item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] ) + +Returns a string that formats the times in the TIMEDIFF object in +the requested STYLE. TIMEDIFF is expected to be a Benchmark object +similar to that returned by timediff(). + +STYLE can be any of 'all', 'none', 'noc', 'nop' or 'auto'. 'all' shows +each of the 5 times available ('wallclock' time, user time, system time, +user time of children, and system time of children). 'noc' shows all +except the two children times. 'nop' shows only wallclock and the +two children times. 'auto' (the default) will act as 'all' unless +the children times are both zero, in which case it acts as 'noc'. +'none' prevents output. + +FORMAT is the L-style format specifier (without the +leading '%') to use to print the times. It defaults to '5.2f'. + +=back + +=head2 Optional Exports + +The following routines will be exported into your namespace +if you specifically ask that they be imported: + +=over 10 + +=item clearcache ( COUNT ) + +Clear the cached time for COUNT rounds of the null loop. + +=item clearallcache ( ) + +Clear all cached times. + +=item cmpthese ( COUNT, CODEHASHREF, [ STYLE ] ) + +=item cmpthese ( RESULTSHASHREF, [ STYLE ] ) + +Optionally calls timethese(), then outputs comparison chart. This: + + cmpthese( -1, { a => "++\$i", b => "\$i *= 2" } ) ; + +outputs a chart like: + + Rate b a + b 2831802/s -- -61% + a 7208959/s 155% -- + +This chart is sorted from slowest to fastest, and shows the percent speed +difference between each pair of tests. + +C can also be passed the data structure that timethese() returns: + + $results = timethese( -1, { a => "++\$i", b => "\$i *= 2" } ) ; + cmpthese( $results ); + +in case you want to see both sets of results. +If the first argument is an unblessed hash reference, +that is RESULTSHASHREF; otherwise that is COUNT. + +Returns a reference to an ARRAY of rows, each row is an ARRAY of cells from the +above chart, including labels. This: + + my $rows = cmpthese( -1, { a => '++$i', b => '$i *= 2' }, "none" ); + +returns a data structure like: + + [ + [ '', 'Rate', 'b', 'a' ], + [ 'b', '2885232/s', '--', '-59%' ], + [ 'a', '7099126/s', '146%', '--' ], + ] + +B: This result value differs from previous versions, which returned +the C result structure. If you want that, just use the two +statement C...C idiom shown above. + +Incidently, note the variance in the result values between the two examples; +this is typical of benchmarking. If this were a real benchmark, you would +probably want to run a lot more iterations. + +=item countit(TIME, CODE) + +Arguments: TIME is the minimum length of time to run CODE for, and CODE is +the code to run. CODE may be either a code reference or a string to +be eval'd; either way it will be run in the caller's package. + +TIME is I negative. countit() will run the loop many times to +calculate the speed of CODE before running it for TIME. The actual +time run for will usually be greater than TIME due to system clock +resolution, so it's best to look at the number of iterations divided +by the times that you are concerned with, not just the iterations. + +Returns: a Benchmark object. + +=item disablecache ( ) + +Disable caching of timings for the null loop. This will force Benchmark +to recalculate these timings for each new piece of code timed. + +=item enablecache ( ) + +Enable caching of timings for the null loop. The time taken for COUNT +rounds of the null loop will be calculated only once for each +different COUNT used. + +=item timesum ( T1, T2 ) + +Returns the sum of two Benchmark times as a Benchmark object suitable +for passing to timestr(). + +=back + +=head2 :hireswallclock + +If the Time::HiRes module has been installed, you can specify the +special tag C<:hireswallclock> for Benchmark (if Time::HiRes is not +available, the tag will be silently ignored). This tag will cause the +wallclock time to be measured in microseconds, instead of integer +seconds. Note though that the speed computations are still conducted +in CPU time, not wallclock time. + +=head1 NOTES + +The data is stored as a list of values from the time and times +functions: + + ($real, $user, $system, $children_user, $children_system, $iters) + +in seconds for the whole loop (not divided by the number of rounds). + +The timing is done using time(3) and times(3). + +Code is executed in the caller's package. + +The time of the null loop (a loop with the same +number of rounds but empty loop body) is subtracted +from the time of the real loop. + +The null loop times can be cached, the key being the +number of rounds. The caching can be controlled using +calls like these: + + clearcache($key); + clearallcache(); + + disablecache(); + enablecache(); + +Caching is off by default, as it can (usually slightly) decrease +accuracy and does not usually noticably affect runtimes. + +=head1 EXAMPLES + +For example, + + use Benchmark qw( cmpthese ) ; + $x = 3; + cmpthese( -5, { + a => sub{$x*$x}, + b => sub{$x**2}, + } ); + +outputs something like this: + + Benchmark: running a, b, each for at least 5 CPU seconds... + Rate b a + b 1559428/s -- -62% + a 4152037/s 166% -- + + +while + + use Benchmark qw( timethese cmpthese ) ; + $x = 3; + $r = timethese( -5, { + a => sub{$x*$x}, + b => sub{$x**2}, + } ); + cmpthese $r; + +outputs something like this: + + Benchmark: running a, b, each for at least 5 CPU seconds... + a: 10 wallclock secs ( 5.14 usr + 0.13 sys = 5.27 CPU) @ 3835055.60/s (n=20210743) + b: 5 wallclock secs ( 5.41 usr + 0.00 sys = 5.41 CPU) @ 1574944.92/s (n=8520452) + Rate b a + b 1574945/s -- -59% + a 3835056/s 144% -- + + +=head1 INHERITANCE + +Benchmark inherits from no other class, except of course +for Exporter. + +=head1 CAVEATS + +Comparing eval'd strings with code references will give you +inaccurate results: a code reference will show a slightly slower +execution time than the equivalent eval'd string. + +The real time timing is done using time(2) and +the granularity is therefore only one second. + +Short tests may produce negative figures because perl +can appear to take longer to execute the empty loop +than a short test; try: + + timethis(100,'1'); + +The system time of the null loop might be slightly +more than the system time of the loop with the actual +code and therefore the difference might end up being E 0. + +=head1 SEE ALSO + +L - a Perl code profiler + +=head1 AUTHORS + +Jarkko Hietaniemi >, Tim Bunce > + +=head1 MODIFICATION HISTORY + +September 8th, 1994; by Tim Bunce. + +March 28th, 1997; by Hugo van der Sanden: added support for code +references and the already documented 'debug' method; revamped +documentation. + +April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time +functionality. + +September, 1999; by Barrie Slaymaker: math fixes and accuracy and +efficiency tweaks. Added cmpthese(). A result is now returned from +timethese(). Exposed countit() (was runfor()). + +December, 2001; by Nicholas Clark: make timestr() recognise the style 'none' +and return an empty string. If cmpthese is calling timethese, make it pass the +style in. (so that 'none' will suppress output). Make sub new dump its +debugging output to STDERR, to be consistent with everything else. +All bugs found while writing a regression test. + +September, 2002; by Jarkko Hietaniemi: add ':hireswallclock' special tag. + +February, 2004; by Chia-liang Kao: make cmpthese and timestr use time +statistics for children instead of parent when the style is 'nop'. + +November, 2007; by Christophe Grosjean: make cmpthese and timestr compute +time consistently with style argument, default is 'all' not 'noc' any more. + +=cut + +# evaluate something in a clean lexical environment +sub _doeval { no strict; eval shift } + +# +# put any lexicals at file scope AFTER here +# + +use Carp; +use Exporter; + +our(@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION); + +@ISA=qw(Exporter); +@EXPORT=qw(timeit timethis timethese timediff timestr); +@EXPORT_OK=qw(timesum cmpthese countit + clearcache clearallcache disablecache enablecache); +%EXPORT_TAGS=( all => [ @EXPORT, @EXPORT_OK ] ) ; + +$VERSION = 1.11; + +# --- ':hireswallclock' special handling + +my $hirestime; + +sub mytime () { time } + +init(); + +sub BEGIN { + if (eval 'require Time::HiRes') { + import Time::HiRes qw(time); + $hirestime = \&Time::HiRes::time; + } +} + +sub import { + my $class = shift; + if (grep { $_ eq ":hireswallclock" } @_) { + @_ = grep { $_ ne ":hireswallclock" } @_; + local $^W=0; + *mytime = $hirestime if defined $hirestime; + } + Benchmark->export_to_level(1, $class, @_); +} + +our($Debug, $Min_Count, $Min_CPU, $Default_Format, $Default_Style, + %_Usage, %Cache, $Do_Cache); + +sub init { + $Debug = 0; + $Min_Count = 4; + $Min_CPU = 0.4; + $Default_Format = '5.2f'; + $Default_Style = 'auto'; + # The cache can cause a slight loss of sys time accuracy. If a + # user does many tests (>10) with *very* large counts (>10000) + # or works on a very slow machine the cache may be useful. + disablecache(); + clearallcache(); +} + +sub debug { $Debug = ($_[1] != 0); } + +sub usage { + my $calling_sub = (caller(1))[3]; + $calling_sub =~ s/^Benchmark:://; + return $_Usage{$calling_sub} || ''; +} + +# The cache needs two branches: 's' for strings and 'c' for code. The +# empty loop is different in these two cases. + +$_Usage{clearcache} = <<'USAGE'; +usage: clearcache($count); +USAGE + +sub clearcache { + die usage unless @_ == 1; + delete $Cache{"$_[0]c"}; delete $Cache{"$_[0]s"}; +} + +$_Usage{clearallcache} = <<'USAGE'; +usage: clearallcache(); +USAGE + +sub clearallcache { + die usage if @_; + %Cache = (); +} + +$_Usage{enablecache} = <<'USAGE'; +usage: enablecache(); +USAGE + +sub enablecache { + die usage if @_; + $Do_Cache = 1; +} + +$_Usage{disablecache} = <<'USAGE'; +usage: disablecache(); +USAGE + +sub disablecache { + die usage if @_; + $Do_Cache = 0; +} + + +# --- Functions to process the 'time' data type + +sub new { my @t = (mytime, times, @_ == 2 ? $_[1] : 0); + print STDERR "new=@t\n" if $Debug; + bless \@t; } + +sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps ; } +sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $cu+$cs ; } +sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; } +sub real { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r ; } +sub iters { $_[0]->[5] ; } + + +$_Usage{timediff} = <<'USAGE'; +usage: $result_diff = timediff($result1, $result2); +USAGE + +sub timediff { + my($a, $b) = @_; + + die usage unless ref $a and ref $b; + + my @r; + for (my $i=0; $i < @$a; ++$i) { + push(@r, $a->[$i] - $b->[$i]); + } + #die "Bad timediff(): ($r[1] + $r[2]) <= 0 (@$a[1,2]|@$b[1,2])\n" + # if ($r[1] + $r[2]) < 0; + bless \@r; +} + +$_Usage{timesum} = <<'USAGE'; +usage: $sum = timesum($result1, $result2); +USAGE + +sub timesum { + my($a, $b) = @_; + + die usage unless ref $a and ref $b; + + my @r; + for (my $i=0; $i < @$a; ++$i) { + push(@r, $a->[$i] + $b->[$i]); + } + bless \@r; +} + + +$_Usage{timestr} = <<'USAGE'; +usage: $formatted_result = timestr($result1); +USAGE + +sub timestr { + my($tr, $style, $f) = @_; + + die usage unless ref $tr; + + my @t = @$tr; + warn "bad time value (@t)" unless @t==6; + my($r, $pu, $ps, $cu, $cs, $n) = @t; + my($pt, $ct, $tt) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a); + $f = $Default_Format unless defined $f; + # format a time in the required style, other formats may be added here + $style ||= $Default_Style; + return '' if $style eq 'none'; + $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto'; + my $s = "@t $style"; # default for unknown style + my $w = $hirestime ? "%2g" : "%2d"; + $s = sprintf("$w wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)", + $r,$pu,$ps,$cu,$cs,$tt) if $style eq 'all'; + $s = sprintf("$w wallclock secs (%$f usr + %$f sys = %$f CPU)", + $r,$pu,$ps,$pt) if $style eq 'noc'; + $s = sprintf("$w wallclock secs (%$f cusr + %$f csys = %$f CPU)", + $r,$cu,$cs,$ct) if $style eq 'nop'; + my $elapsed = do { + if ($style eq 'nop') {$cu+$cs} + elsif ($style eq 'noc') {$pu+$ps} + else {$cu+$cs+$pu+$ps} + }; + $s .= sprintf(" @ %$f/s (n=$n)",$n/($elapsed)) if $n && $elapsed; + $s; +} + +sub timedebug { + my($msg, $t) = @_; + print STDERR "$msg",timestr($t),"\n" if $Debug; +} + +# --- Functions implementing low-level support for timing loops + +$_Usage{runloop} = <<'USAGE'; +usage: runloop($number, [$string | $coderef]) +USAGE + +sub runloop { + my($n, $c) = @_; + + $n+=0; # force numeric now, so garbage won't creep into the eval + croak "negative loopcount $n" if $n<0; + confess usage unless defined $c; + my($t0, $t1, $td); # before, after, difference + + # find package of caller so we can execute code there + my($curpack) = caller(0); + my($i, $pack)= 0; + while (($pack) = caller(++$i)) { + last if $pack ne $curpack; + } + + my ($subcode, $subref); + if (ref $c eq 'CODE') { + $subcode = "sub { for (1 .. $n) { local \$_; package $pack; &\$c; } }"; + $subref = eval $subcode; + } + else { + $subcode = "sub { for (1 .. $n) { local \$_; package $pack; $c;} }"; + $subref = _doeval($subcode); + } + croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@; + print STDERR "runloop $n '$subcode'\n" if $Debug; + + # Wait for the user timer to tick. This makes the error range more like + # -0.01, +0. If we don't wait, then it's more like -0.01, +0.01. This + # may not seem important, but it significantly reduces the chances of + # getting a too low initial $n in the initial, 'find the minimum' loop + # in &countit. This, in turn, can reduce the number of calls to + # &runloop a lot, and thus reduce additive errors. + my $tbase = Benchmark->new(0)->[1]; + while ( ( $t0 = Benchmark->new(0) )->[1] == $tbase ) {} ; + $subref->(); + $t1 = Benchmark->new($n); + $td = &timediff($t1, $t0); + timedebug("runloop:",$td); + $td; +} + +$_Usage{timeit} = <<'USAGE'; +usage: $result = timeit($count, 'code' ); or + $result = timeit($count, sub { code } ); +USAGE + +sub timeit { + my($n, $code) = @_; + my($wn, $wc, $wd); + + die usage unless defined $code and + (!ref $code or ref $code eq 'CODE'); + + printf STDERR "timeit $n $code\n" if $Debug; + my $cache_key = $n . ( ref( $code ) ? 'c' : 's' ); + if ($Do_Cache && exists $Cache{$cache_key} ) { + $wn = $Cache{$cache_key}; + } else { + $wn = &runloop($n, ref( $code ) ? sub { } : '' ); + # Can't let our baseline have any iterations, or they get subtracted + # out of the result. + $wn->[5] = 0; + $Cache{$cache_key} = $wn; + } + + $wc = &runloop($n, $code); + + $wd = timediff($wc, $wn); + timedebug("timeit: ",$wc); + timedebug(" - ",$wn); + timedebug(" = ",$wd); + + $wd; +} + + +my $default_for = 3; +my $min_for = 0.1; + + +$_Usage{countit} = <<'USAGE'; +usage: $result = countit($time, 'code' ); or + $result = countit($time, sub { code } ); +USAGE + +sub countit { + my ( $tmax, $code ) = @_; + + die usage unless @_; + + if ( not defined $tmax or $tmax == 0 ) { + $tmax = $default_for; + } elsif ( $tmax < 0 ) { + $tmax = -$tmax; + } + + die "countit($tmax, ...): timelimit cannot be less than $min_for.\n" + if $tmax < $min_for; + + my ($n, $tc); + + # First find the minimum $n that gives a significant timing. + my $zeros=0; + for ($n = 1; ; $n *= 2 ) { + my $td = timeit($n, $code); + $tc = $td->[1] + $td->[2]; + if ( $tc <= 0 and $n > 1024 ) { + ++$zeros > 16 + and die "Timing is consistently zero in estimation loop, cannot benchmark. N=$n\n"; + } else { + $zeros = 0; + } + last if $tc > 0.1; + } + + my $nmin = $n; + + # Get $n high enough that we can guess the final $n with some accuracy. + my $tpra = 0.1 * $tmax; # Target/time practice. + while ( $tc < $tpra ) { + # The 5% fudge is to keep us from iterating again all + # that often (this speeds overall responsiveness when $tmax is big + # and we guess a little low). This does not noticably affect + # accuracy since we're not couting these times. + $n = int( $tpra * 1.05 * $n / $tc ); # Linear approximation. + my $td = timeit($n, $code); + my $new_tc = $td->[1] + $td->[2]; + # Make sure we are making progress. + $tc = $new_tc > 1.2 * $tc ? $new_tc : 1.2 * $tc; + } + + # Now, do the 'for real' timing(s), repeating until we exceed + # the max. + my $ntot = 0; + my $rtot = 0; + my $utot = 0.0; + my $stot = 0.0; + my $cutot = 0.0; + my $cstot = 0.0; + my $ttot = 0.0; + + # The 5% fudge is because $n is often a few % low even for routines + # with stable times and avoiding extra timeit()s is nice for + # accuracy's sake. + $n = int( $n * ( 1.05 * $tmax / $tc ) ); + $zeros=0; + while () { + my $td = timeit($n, $code); + $ntot += $n; + $rtot += $td->[0]; + $utot += $td->[1]; + $stot += $td->[2]; + $cutot += $td->[3]; + $cstot += $td->[4]; + $ttot = $utot + $stot; + last if $ttot >= $tmax; + if ( $ttot <= 0 ) { + ++$zeros > 16 + and die "Timing is consistently zero, cannot benchmark. N=$n\n"; + } else { + $zeros = 0; + } + $ttot = 0.01 if $ttot < 0.01; + my $r = $tmax / $ttot - 1; # Linear approximation. + $n = int( $r * $ntot ); + $n = $nmin if $n < $nmin; + } + + return bless [ $rtot, $utot, $stot, $cutot, $cstot, $ntot ]; +} + +# --- Functions implementing high-level time-then-print utilities + +sub n_to_for { + my $n = shift; + return $n == 0 ? $default_for : $n < 0 ? -$n : undef; +} + +$_Usage{timethis} = <<'USAGE'; +usage: $result = timethis($time, 'code' ); or + $result = timethis($time, sub { code } ); +USAGE + +sub timethis{ + my($n, $code, $title, $style) = @_; + my($t, $forn); + + die usage unless defined $code and + (!ref $code or ref $code eq 'CODE'); + + if ( $n > 0 ) { + croak "non-integer loopcount $n, stopped" if int($n)<$n; + $t = timeit($n, $code); + $title = "timethis $n" unless defined $title; + } else { + my $fort = n_to_for( $n ); + $t = countit( $fort, $code ); + $title = "timethis for $fort" unless defined $title; + $forn = $t->[-1]; + } + local $| = 1; + $style = "" unless defined $style; + printf("%10s: ", $title) unless $style eq 'none'; + print timestr($t, $style, $Default_Format),"\n" unless $style eq 'none'; + + $n = $forn if defined $forn; + + # A conservative warning to spot very silly tests. + # Don't assume that your benchmark is ok simply because + # you don't get this warning! + print " (warning: too few iterations for a reliable count)\n" + if $n < $Min_Count + || ($t->real < 1 && $n < 1000) + || $t->cpu_a < $Min_CPU; + $t; +} + + +$_Usage{timethese} = <<'USAGE'; +usage: timethese($count, { Name1 => 'code1', ... }); or + timethese($count, { Name1 => sub { code1 }, ... }); +USAGE + +sub timethese{ + my($n, $alt, $style) = @_; + die usage unless ref $alt eq 'HASH'; + + my @names = sort keys %$alt; + $style = "" unless defined $style; + print "Benchmark: " unless $style eq 'none'; + if ( $n > 0 ) { + croak "non-integer loopcount $n, stopped" if int($n)<$n; + print "timing $n iterations of" unless $style eq 'none'; + } else { + print "running" unless $style eq 'none'; + } + print " ", join(', ',@names) unless $style eq 'none'; + unless ( $n > 0 ) { + my $for = n_to_for( $n ); + print ", each" if $n > 1 && $style ne 'none'; + print " for at least $for CPU seconds" unless $style eq 'none'; + } + print "...\n" unless $style eq 'none'; + + # we could save the results in an array and produce a summary here + # sum, min, max, avg etc etc + my %results; + foreach my $name (@names) { + $results{$name} = timethis ($n, $alt -> {$name}, $name, $style); + } + + return \%results; +} + + +$_Usage{cmpthese} = <<'USAGE'; +usage: cmpthese($count, { Name1 => 'code1', ... }); or + cmpthese($count, { Name1 => sub { code1 }, ... }); or + cmpthese($result, $style); +USAGE + +sub cmpthese{ + my ($results, $style); + + # $count can be a blessed object. + if ( ref $_[0] eq 'HASH' ) { + ($results, $style) = @_; + } + else { + my($count, $code) = @_[0,1]; + $style = $_[2] if defined $_[2]; + + die usage unless ref $code eq 'HASH'; + + $results = timethese($count, $code, ($style || "none")); + } + + $style = "" unless defined $style; + + # Flatten in to an array of arrays with the name as the first field + my @vals = map{ [ $_, @{$results->{$_}} ] } keys %$results; + + for (@vals) { + # The epsilon fudge here is to prevent div by 0. Since clock + # resolutions are much larger, it's below the noise floor. + my $elapsed = do { + if ($style eq 'nop') {$_->[4]+$_->[5]} + elsif ($style eq 'noc') {$_->[2]+$_->[3]} + else {$_->[2]+$_->[3]+$_->[4]+$_->[5]} + }; + my $rate = $_->[6]/(($elapsed)+0.000000000000001); + $_->[7] = $rate; + } + + # Sort by rate + @vals = sort { $a->[7] <=> $b->[7] } @vals; + + # If more than half of the rates are greater than one... + my $display_as_rate = @vals ? ($vals[$#vals>>1]->[7] > 1) : 0; + + my @rows; + my @col_widths; + + my @top_row = ( + '', + $display_as_rate ? 'Rate' : 's/iter', + map { $_->[0] } @vals + ); + + push @rows, \@top_row; + @col_widths = map { length( $_ ) } @top_row; + + # Build the data rows + # We leave the last column in even though it never has any data. Perhaps + # it should go away. Also, perhaps a style for a single column of + # percentages might be nice. + for my $row_val ( @vals ) { + my @row; + + # Column 0 = test name + push @row, $row_val->[0]; + $col_widths[0] = length( $row_val->[0] ) + if length( $row_val->[0] ) > $col_widths[0]; + + # Column 1 = performance + my $row_rate = $row_val->[7]; + + # We assume that we'll never get a 0 rate. + my $rate = $display_as_rate ? $row_rate : 1 / $row_rate; + + # Only give a few decimal places before switching to sci. notation, + # since the results aren't usually that accurate anyway. + my $format = + $rate >= 100 ? + "%0.0f" : + $rate >= 10 ? + "%0.1f" : + $rate >= 1 ? + "%0.2f" : + $rate >= 0.1 ? + "%0.3f" : + "%0.2e"; + + $format .= "/s" + if $display_as_rate; + + my $formatted_rate = sprintf( $format, $rate ); + push @row, $formatted_rate; + $col_widths[1] = length( $formatted_rate ) + if length( $formatted_rate ) > $col_widths[1]; + + # Columns 2..N = performance ratios + my $skip_rest = 0; + for ( my $col_num = 0 ; $col_num < @vals ; ++$col_num ) { + my $col_val = $vals[$col_num]; + my $out; + if ( $skip_rest ) { + $out = ''; + } + elsif ( $col_val->[0] eq $row_val->[0] ) { + $out = "--"; + # $skip_rest = 1; + } + else { + my $col_rate = $col_val->[7]; + $out = sprintf( "%.0f%%", 100*$row_rate/$col_rate - 100 ); + } + push @row, $out; + $col_widths[$col_num+2] = length( $out ) + if length( $out ) > $col_widths[$col_num+2]; + + # A little wierdness to set the first column width properly + $col_widths[$col_num+2] = length( $col_val->[0] ) + if length( $col_val->[0] ) > $col_widths[$col_num+2]; + } + push @rows, \@row; + } + + return \@rows if $style eq "none"; + + # Equalize column widths in the chart as much as possible without + # exceeding 80 characters. This does not use or affect cols 0 or 1. + my @sorted_width_refs = + sort { $$a <=> $$b } map { \$_ } @col_widths[2..$#col_widths]; + my $max_width = ${$sorted_width_refs[-1]}; + + my $total = @col_widths - 1 ; + for ( @col_widths ) { $total += $_ } + + STRETCHER: + while ( $total < 80 ) { + my $min_width = ${$sorted_width_refs[0]}; + last + if $min_width == $max_width; + for ( @sorted_width_refs ) { + last + if $$_ > $min_width; + ++$$_; + ++$total; + last STRETCHER + if $total >= 80; + } + } + + # Dump the output + my $format = join( ' ', map { "%${_}s" } @col_widths ) . "\n"; + substr( $format, 1, 0 ) = '-'; + for ( @rows ) { + printf $format, @$_; + } + + return \@rows ; +} + + +1; diff --git a/Master/tlpkg/tlperl/lib/CGI.pm b/Master/tlpkg/tlperl/lib/CGI.pm new file mode 100644 index 00000000000..1f195606c10 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/CGI.pm @@ -0,0 +1,8096 @@ +package CGI; +require 5.004; +use Carp 'croak'; + +# See the bottom of this file for the POD documentation. Search for the +# string '=head'. + +# You can run this file through either pod2man or pod2html to produce pretty +# documentation in manual or html file format (these utilities are part of the +# Perl 5 distribution). + +# Copyright 1995-1998 Lincoln D. Stein. All rights reserved. +# It may be used and modified freely, but I do request that this copyright +# notice remain attached to the file. You may modify this module as you +# wish, but if you redistribute a modified version, please attach a note +# listing the modifications you have made. + +# The most recent version and complete docs are available at: +# http://stein.cshl.org/WWW/software/CGI/ + +$CGI::revision = '$Id: CGI.pm,v 1.266 2009/07/30 16:32:34 lstein Exp $'; +$CGI::VERSION='3.49'; + +# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES. +# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING. +# $CGITempFile::TMPDIRECTORY = '/usr/tmp'; +use CGI::Util qw(rearrange rearrange_header make_attributes unescape escape expires ebcdic2ascii ascii2ebcdic); + +#use constant XHTML_DTD => ['-//W3C//DTD XHTML Basic 1.0//EN', +# 'http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd']; + +use constant XHTML_DTD => ['-//W3C//DTD XHTML 1.0 Transitional//EN', + 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd']; + +{ + local $^W = 0; + $TAINTED = substr("$0$^X",0,0); +} + +$MOD_PERL = 0; # no mod_perl by default + +#global settings +$POST_MAX = -1; # no limit to uploaded files +$DISABLE_UPLOADS = 0; + +@SAVED_SYMBOLS = (); + + +# >>>>> Here are some globals that you might want to adjust <<<<<< +sub initialize_globals { + # Set this to 1 to enable copious autoloader debugging messages + $AUTOLOAD_DEBUG = 0; + + # Set this to 1 to generate XTML-compatible output + $XHTML = 1; + + # Change this to the preferred DTD to print in start_html() + # or use default_dtd('text of DTD to use'); + $DEFAULT_DTD = [ '-//W3C//DTD HTML 4.01 Transitional//EN', + 'http://www.w3.org/TR/html4/loose.dtd' ] ; + + # Set this to 1 to enable NOSTICKY scripts + # or: + # 1) use CGI '-nosticky'; + # 2) $CGI::NOSTICKY = 1; + $NOSTICKY = 0; + + # Set this to 1 to enable NPH scripts + # or: + # 1) use CGI qw(-nph) + # 2) CGI::nph(1) + # 3) print header(-nph=>1) + $NPH = 0; + + # Set this to 1 to enable debugging from @ARGV + # Set to 2 to enable debugging from STDIN + $DEBUG = 1; + + # Set this to 1 to make the temporary files created + # during file uploads safe from prying eyes + # or do... + # 1) use CGI qw(:private_tempfiles) + # 2) CGI::private_tempfiles(1); + $PRIVATE_TEMPFILES = 0; + + # Set this to 1 to generate automatic tab indexes + $TABINDEX = 0; + + # Set this to 1 to cause files uploaded in multipart documents + # to be closed, instead of caching the file handle + # or: + # 1) use CGI qw(:close_upload_files) + # 2) $CGI::close_upload_files(1); + # Uploads with many files run out of file handles. + # Also, for performance, since the file is already on disk, + # it can just be renamed, instead of read and written. + $CLOSE_UPLOAD_FILES = 0; + + # Automatically determined -- don't change + $EBCDIC = 0; + + # Change this to 1 to suppress redundant HTTP headers + $HEADERS_ONCE = 0; + + # separate the name=value pairs by semicolons rather than ampersands + $USE_PARAM_SEMICOLONS = 1; + + # Do not include undefined params parsed from query string + # use CGI qw(-no_undef_params); + $NO_UNDEF_PARAMS = 0; + + # return everything as utf-8 + $PARAM_UTF8 = 0; + + # Other globals that you shouldn't worry about. + undef $Q; + $BEEN_THERE = 0; + $DTD_PUBLIC_IDENTIFIER = ""; + undef @QUERY_PARAM; + undef %EXPORT; + undef $QUERY_CHARSET; + undef %QUERY_FIELDNAMES; + undef %QUERY_TMPFILES; + + # prevent complaints by mod_perl + 1; +} + +# ------------------ START OF THE LIBRARY ------------ + +#### Method: endform +# This method is DEPRECATED +*endform = \&end_form; + +# make mod_perlhappy +initialize_globals(); + +# FIGURE OUT THE OS WE'RE RUNNING UNDER +# Some systems support the $^O variable. If not +# available then require() the Config library +unless ($OS) { + unless ($OS = $^O) { + require Config; + $OS = $Config::Config{'osname'}; + } +} +if ($OS =~ /^MSWin/i) { + $OS = 'WINDOWS'; +} elsif ($OS =~ /^VMS/i) { + $OS = 'VMS'; +} elsif ($OS =~ /^dos/i) { + $OS = 'DOS'; +} elsif ($OS =~ /^MacOS/i) { + $OS = 'MACINTOSH'; +} elsif ($OS =~ /^os2/i) { + $OS = 'OS2'; +} elsif ($OS =~ /^epoc/i) { + $OS = 'EPOC'; +} elsif ($OS =~ /^cygwin/i) { + $OS = 'CYGWIN'; +} elsif ($OS =~ /^NetWare/i) { + $OS = 'NETWARE'; +} else { + $OS = 'UNIX'; +} + +# Some OS logic. Binary mode enabled on DOS, NT and VMS +$needs_binmode = $OS=~/^(WINDOWS|DOS|OS2|MSWin|CYGWIN|NETWARE)/; + +# This is the default class for the CGI object to use when all else fails. +$DefaultClass = 'CGI' unless defined $CGI::DefaultClass; + +# This is where to look for autoloaded routines. +$AutoloadClass = $DefaultClass unless defined $CGI::AutoloadClass; + +# The path separator is a slash, backslash or semicolon, depending +# on the paltform. +$SL = { + UNIX => '/', OS2 => '\\', EPOC => '/', CYGWIN => '/', NETWARE => '/', + WINDOWS => '\\', DOS => '\\', MACINTOSH => ':', VMS => '/' + }->{$OS}; + +# This no longer seems to be necessary +# Turn on NPH scripts by default when running under IIS server! +# $NPH++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/; +$IIS++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/; + +# Turn on special checking for ActiveState's PerlEx +$PERLEX++ if defined($ENV{'GATEWAY_INTERFACE'}) && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/; + +# Turn on special checking for Doug MacEachern's modperl +# PerlEx::DBI tries to fool DBI by setting MOD_PERL +if (exists $ENV{MOD_PERL} && ! $PERLEX) { + # mod_perl handlers may run system() on scripts using CGI.pm; + # Make sure so we don't get fooled by inherited $ENV{MOD_PERL} + if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) { + $MOD_PERL = 2; + require Apache2::Response; + require Apache2::RequestRec; + require Apache2::RequestUtil; + require Apache2::RequestIO; + require APR::Pool; + } else { + $MOD_PERL = 1; + require Apache; + } +} + +# Define the CRLF sequence. I can't use a simple "\r\n" because the meaning +# of "\n" is different on different OS's (sometimes it generates CRLF, sometimes LF +# and sometimes CR). The most popular VMS web server +# doesn't accept CRLF -- instead it wants a LR. EBCDIC machines don't +# use ASCII, so \015\012 means something different. I find this all +# really annoying. +$EBCDIC = "\t" ne "\011"; +if ($OS eq 'VMS') { + $CRLF = "\n"; +} elsif ($EBCDIC) { + $CRLF= "\r\n"; +} else { + $CRLF = "\015\012"; +} + +if ($needs_binmode) { + $CGI::DefaultClass->binmode(\*main::STDOUT); + $CGI::DefaultClass->binmode(\*main::STDIN); + $CGI::DefaultClass->binmode(\*main::STDERR); +} + +%EXPORT_TAGS = ( + ':html2'=>['h1'..'h6',qw/p br hr ol ul li dl dt dd menu code var strong em + tt u i b blockquote pre img a address cite samp dfn html head + base body Link nextid title meta kbd start_html end_html + input Select option comment charset escapeHTML/], + ':html3'=>[qw/div table caption th td TR Tr sup Sub strike applet Param nobr + embed basefont style span layer ilayer font frameset frame script small big Area Map/], + ':html4'=>[qw/abbr acronym bdo col colgroup del fieldset iframe + ins label legend noframes noscript object optgroup Q + thead tbody tfoot/], + ':netscape'=>[qw/blink fontsize center/], + ':form'=>[qw/textfield textarea filefield password_field hidden checkbox checkbox_group + submit reset defaults radio_group popup_menu button autoEscape + scrolling_list image_button start_form end_form startform endform + start_multipart_form end_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART/], + ':cgi'=>[qw/param upload path_info path_translated request_uri url self_url script_name + cookie Dump + raw_cookie request_method query_string Accept user_agent remote_host content_type + remote_addr referer server_name server_software server_port server_protocol virtual_port + virtual_host remote_ident auth_type http append + save_parameters restore_parameters param_fetch + remote_user user_name header redirect import_names put + Delete Delete_all url_param cgi_error/], + ':ssl' => [qw/https/], + ':cgi-lib' => [qw/ReadParse PrintHeader HtmlTop HtmlBot SplitParam Vars/], + ':html' => [qw/:html2 :html3 :html4 :netscape/], + ':standard' => [qw/:html2 :html3 :html4 :form :cgi/], + ':push' => [qw/multipart_init multipart_start multipart_end multipart_final/], + ':all' => [qw/:html2 :html3 :netscape :form :cgi :internal :html4/] + ); + +# Custom 'can' method for both autoloaded and non-autoloaded subroutines. +# Author: Cees Hek + +sub can { + my($class, $method) = @_; + + # See if UNIVERSAL::can finds it. + + if (my $func = $class -> SUPER::can($method) ){ + return $func; + } + + # Try to compile the function. + + eval { + # _compile looks at $AUTOLOAD for the function name. + + local $AUTOLOAD = join "::", $class, $method; + &_compile; + }; + + # Now that the function is loaded (if it exists) + # just use UNIVERSAL::can again to do the work. + + return $class -> SUPER::can($method); +} + +# to import symbols into caller +sub import { + my $self = shift; + + # This causes modules to clash. + undef %EXPORT_OK; + undef %EXPORT; + + $self->_setup_symbols(@_); + my ($callpack, $callfile, $callline) = caller; + + # To allow overriding, search through the packages + # Till we find one in which the correct subroutine is defined. + my @packages = ($self,@{"$self\:\:ISA"}); + for $sym (keys %EXPORT) { + my $pck; + my $def = ${"$self\:\:AutoloadClass"} || $DefaultClass; + for $pck (@packages) { + if (defined(&{"$pck\:\:$sym"})) { + $def = $pck; + last; + } + } + *{"${callpack}::$sym"} = \&{"$def\:\:$sym"}; + } +} + +sub compile { + my $pack = shift; + $pack->_setup_symbols('-compile',@_); +} + +sub expand_tags { + my($tag) = @_; + return ("start_$1","end_$1") if $tag=~/^(?:\*|start_|end_)(.+)/; + my(@r); + return ($tag) unless $EXPORT_TAGS{$tag}; + for (@{$EXPORT_TAGS{$tag}}) { + push(@r,&expand_tags($_)); + } + return @r; +} + +#### Method: new +# The new routine. This will check the current environment +# for an existing query string, and initialize itself, if so. +#### +sub new { + my($class,@initializer) = @_; + my $self = {}; + + bless $self,ref $class || $class || $DefaultClass; + + # always use a tempfile + $self->{'use_tempfile'} = 1; + + if (ref($initializer[0]) + && (UNIVERSAL::isa($initializer[0],'Apache') + || + UNIVERSAL::isa($initializer[0],'Apache2::RequestRec') + )) { + $self->r(shift @initializer); + } + if (ref($initializer[0]) + && (UNIVERSAL::isa($initializer[0],'CODE'))) { + $self->upload_hook(shift @initializer, shift @initializer); + $self->{'use_tempfile'} = shift @initializer if (@initializer > 0); + } + if ($MOD_PERL) { + if ($MOD_PERL == 1) { + $self->r(Apache->request) unless $self->r; + my $r = $self->r; + $r->register_cleanup(\&CGI::_reset_globals); + $self->_setup_symbols(@SAVED_SYMBOLS) if @SAVED_SYMBOLS; + } + else { + # XXX: once we have the new API + # will do a real PerlOptions -SetupEnv check + $self->r(Apache2::RequestUtil->request) unless $self->r; + my $r = $self->r; + $r->subprocess_env unless exists $ENV{REQUEST_METHOD}; + $r->pool->cleanup_register(\&CGI::_reset_globals); + $self->_setup_symbols(@SAVED_SYMBOLS) if @SAVED_SYMBOLS; + } + undef $NPH; + } + $self->_reset_globals if $PERLEX; + $self->init(@initializer); + return $self; +} + +# We provide a DESTROY method so that we can ensure that +# temporary files are closed (via Fh->DESTROY) before they +# are unlinked (via CGITempFile->DESTROY) because it is not +# possible to unlink an open file on Win32. We explicitly +# call DESTROY on each, rather than just undefing them and +# letting Perl DESTROY them by garbage collection, in case the +# user is still holding any reference to them as well. +sub DESTROY { + my $self = shift; + if ($OS eq 'WINDOWS') { + for my $href (values %{$self->{'.tmpfiles'}}) { + $href->{hndl}->DESTROY if defined $href->{hndl}; + $href->{name}->DESTROY if defined $href->{name}; + } + } +} + +sub r { + my $self = shift; + my $r = $self->{'.r'}; + $self->{'.r'} = shift if @_; + $r; +} + +sub upload_hook { + my $self; + if (ref $_[0] eq 'CODE') { + $CGI::Q = $self = $CGI::DefaultClass->new(@_); + } else { + $self = shift; + } + my ($hook,$data,$use_tempfile) = @_; + $self->{'.upload_hook'} = $hook; + $self->{'.upload_data'} = $data; + $self->{'use_tempfile'} = $use_tempfile if defined $use_tempfile; +} + +#### Method: param +# Returns the value(s)of a named parameter. +# If invoked in a list context, returns the +# entire list. Otherwise returns the first +# member of the list. +# If name is not provided, return a list of all +# the known parameters names available. +# If more than one argument is provided, the +# second and subsequent arguments are used to +# set the value of the parameter. +#### +sub param { + my($self,@p) = self_or_default(@_); + return $self->all_parameters unless @p; + my($name,$value,@other); + + # For compatibility between old calling style and use_named_parameters() style, + # we have to special case for a single parameter present. + if (@p > 1) { + ($name,$value,@other) = rearrange([NAME,[DEFAULT,VALUE,VALUES]],@p); + my(@values); + + if (substr($p[0],0,1) eq '-') { + @values = defined($value) ? (ref($value) && ref($value) eq 'ARRAY' ? @{$value} : $value) : (); + } else { + for ($value,@other) { + push(@values,$_) if defined($_); + } + } + # If values is provided, then we set it. + if (@values or defined $value) { + $self->add_parameter($name); + $self->{param}{$name}=[@values]; + } + } else { + $name = $p[0]; + } + + return unless defined($name) && $self->{param}{$name}; + + my @result = @{$self->{param}{$name}}; + + if ($PARAM_UTF8) { + eval "require Encode; 1;" unless Encode->can('decode'); # bring in these functions + @result = map {ref $_ ? $_ : $self->_decode_utf8($_) } @result; + } + + return wantarray ? @result : $result[0]; +} + +sub _decode_utf8 { + my ($self, $val) = @_; + + if (Encode::is_utf8($val)) { + return $val; + } + else { + return Encode::decode(utf8 => $val); + } +} + +sub self_or_default { + return @_ if defined($_[0]) && (!ref($_[0])) &&($_[0] eq 'CGI'); + unless (defined($_[0]) && + (ref($_[0]) eq 'CGI' || UNIVERSAL::isa($_[0],'CGI')) # slightly optimized for common case + ) { + $Q = $CGI::DefaultClass->new unless defined($Q); + unshift(@_,$Q); + } + return wantarray ? @_ : $Q; +} + +sub self_or_CGI { + local $^W=0; # prevent a warning + if (defined($_[0]) && + (substr(ref($_[0]),0,3) eq 'CGI' + || UNIVERSAL::isa($_[0],'CGI'))) { + return @_; + } else { + return ($DefaultClass,@_); + } +} + +######################################## +# THESE METHODS ARE MORE OR LESS PRIVATE +# GO TO THE __DATA__ SECTION TO SEE MORE +# PUBLIC METHODS +######################################## + +# Initialize the query object from the environment. +# If a parameter list is found, this object will be set +# to a hash in which parameter names are keys +# and the values are stored as lists +# If a keyword list is found, this method creates a bogus +# parameter list with the single parameter 'keywords'. + +sub init { + my $self = shift; + my($query_string,$meth,$content_length,$fh,@lines) = ('','','',''); + + my $is_xforms; + + my $initializer = shift; # for backward compatibility + local($/) = "\n"; + + # set autoescaping on by default + $self->{'escape'} = 1; + + # if we get called more than once, we want to initialize + # ourselves from the original query (which may be gone + # if it was read from STDIN originally.) + if (defined(@QUERY_PARAM) && !defined($initializer)) { + for my $name (@QUERY_PARAM) { + my $val = $QUERY_PARAM{$name}; # always an arrayref; + $self->param('-name'=>$name,'-value'=> $val); + if (defined $val and ref $val eq 'ARRAY') { + for my $fh (grep {defined(fileno($_))} @$val) { + seek($fh,0,0); # reset the filehandle. + } + + } + } + $self->charset($QUERY_CHARSET); + $self->{'.fieldnames'} = {%QUERY_FIELDNAMES}; + $self->{'.tmpfiles'} = {%QUERY_TMPFILES}; + return; + } + + $meth=$ENV{'REQUEST_METHOD'} if defined($ENV{'REQUEST_METHOD'}); + $content_length = defined($ENV{'CONTENT_LENGTH'}) ? $ENV{'CONTENT_LENGTH'} : 0; + + $fh = to_filehandle($initializer) if $initializer; + + # set charset to the safe ISO-8859-1 + $self->charset('ISO-8859-1'); + + METHOD: { + + # avoid unreasonably large postings + if (($POST_MAX > 0) && ($content_length > $POST_MAX)) { + #discard the post, unread + $self->cgi_error("413 Request entity too large"); + last METHOD; + } + + # Process multipart postings, but only if the initializer is + # not defined. + if ($meth eq 'POST' + && defined($ENV{'CONTENT_TYPE'}) + && $ENV{'CONTENT_TYPE'}=~m|^multipart/form-data| + && !defined($initializer) + ) { + my($boundary) = $ENV{'CONTENT_TYPE'} =~ /boundary=\"?([^\";,]+)\"?/; + $self->read_multipart($boundary,$content_length); + last METHOD; + } + + # Process XForms postings. We know that we have XForms in the + # following cases: + # method eq 'POST' && content-type eq 'application/xml' + # method eq 'POST' && content-type =~ /multipart\/related.+start=/ + # There are more cases, actually, but for now, we don't support other + # methods for XForm posts. + # In a XForm POST, the QUERY_STRING is parsed normally. + # If the content-type is 'application/xml', we just set the param + # XForms:Model (referring to the xml syntax) param containing the + # unparsed XML data. + # In the case of multipart/related we set XForms:Model as above, but + # the other parts are available as uploads with the Content-ID as the + # the key. + # See the URL below for XForms specs on this issue. + # http://www.w3.org/TR/2006/REC-xforms-20060314/slice11.html#submit-options + if ($meth eq 'POST' && defined($ENV{'CONTENT_TYPE'})) { + if ($ENV{'CONTENT_TYPE'} eq 'application/xml') { + my($param) = 'XForms:Model'; + my($value) = ''; + $self->add_parameter($param); + $self->read_from_client(\$value,$content_length,0) + if $content_length > 0; + push (@{$self->{param}{$param}},$value); + $is_xforms = 1; + } elsif ($ENV{'CONTENT_TYPE'} =~ /multipart\/related.+boundary=\"?([^\";,]+)\"?.+start=\"?\]+)\>?\"?/) { + my($boundary,$start) = ($1,$2); + my($param) = 'XForms:Model'; + $self->add_parameter($param); + my($value) = $self->read_multipart_related($start,$boundary,$content_length,0); + push (@{$self->{param}{$param}},$value); + if ($MOD_PERL) { + $query_string = $self->r->args; + } else { + $query_string = $ENV{'QUERY_STRING'} if defined $ENV{'QUERY_STRING'}; + $query_string ||= $ENV{'REDIRECT_QUERY_STRING'} if defined $ENV{'REDIRECT_QUERY_STRING'}; + } + $is_xforms = 1; + } + } + + + # If initializer is defined, then read parameters + # from it. + if (!$is_xforms && defined($initializer)) { + if (UNIVERSAL::isa($initializer,'CGI')) { + $query_string = $initializer->query_string; + last METHOD; + } + if (ref($initializer) && ref($initializer) eq 'HASH') { + for (keys %$initializer) { + $self->param('-name'=>$_,'-value'=>$initializer->{$_}); + } + last METHOD; + } + + if (defined($fh) && ($fh ne '')) { + while (my $line = <$fh>) { + chomp $line; + last if $line =~ /^=$/; + push(@lines,$line); + } + # massage back into standard format + if ("@lines" =~ /=/) { + $query_string=join("&",@lines); + } else { + $query_string=join("+",@lines); + } + last METHOD; + } + + # last chance -- treat it as a string + $initializer = $$initializer if ref($initializer) eq 'SCALAR'; + $query_string = $initializer; + + last METHOD; + } + + # If method is GET or HEAD, fetch the query from + # the environment. + if ($is_xforms || $meth=~/^(GET|HEAD)$/) { + if ($MOD_PERL) { + $query_string = $self->r->args; + } else { + $query_string = $ENV{'QUERY_STRING'} if defined $ENV{'QUERY_STRING'}; + $query_string ||= $ENV{'REDIRECT_QUERY_STRING'} if defined $ENV{'REDIRECT_QUERY_STRING'}; + } + last METHOD; + } + + if ($meth eq 'POST' || $meth eq 'PUT') { + if ( $content_length > 0 ) { + $self->read_from_client(\$query_string,$content_length,0); + } + elsif (not defined $ENV{CONTENT_LENGTH}) { + $self->read_from_stdin(\$query_string); + # should this be PUTDATA in case of PUT ? + my($param) = $meth . 'DATA' ; + $self->add_parameter($param) ; + push (@{$self->{param}{$param}},$query_string); + undef $query_string ; + } + # Some people want to have their cake and eat it too! + # Uncomment this line to have the contents of the query string + # APPENDED to the POST data. + # $query_string .= (length($query_string) ? '&' : '') . $ENV{'QUERY_STRING'} if defined $ENV{'QUERY_STRING'}; + last METHOD; + } + + # If $meth is not of GET, POST, PUT or HEAD, assume we're + # being debugged offline. + # Check the command line and then the standard input for data. + # We use the shellwords package in order to behave the way that + # UN*X programmers expect. + if ($DEBUG) + { + my $cmdline_ret = read_from_cmdline(); + $query_string = $cmdline_ret->{'query_string'}; + if (defined($cmdline_ret->{'subpath'})) + { + $self->path_info($cmdline_ret->{'subpath'}); + } + } + } + +# YL: Begin Change for XML handler 10/19/2001 + if (!$is_xforms && ($meth eq 'POST' || $meth eq 'PUT') + && defined($ENV{'CONTENT_TYPE'}) + && $ENV{'CONTENT_TYPE'} !~ m|^application/x-www-form-urlencoded| + && $ENV{'CONTENT_TYPE'} !~ m|^multipart/form-data| ) { + my($param) = $meth . 'DATA' ; + $self->add_parameter($param) ; + push (@{$self->{param}{$param}},$query_string); + undef $query_string ; + } +# YL: End Change for XML handler 10/19/2001 + + # We now have the query string in hand. We do slightly + # different things for keyword lists and parameter lists. + if (defined $query_string && length $query_string) { + if ($query_string =~ /[&=;]/) { + $self->parse_params($query_string); + } else { + $self->add_parameter('keywords'); + $self->{param}{'keywords'} = [$self->parse_keywordlist($query_string)]; + } + } + + # Special case. Erase everything if there is a field named + # .defaults. + if ($self->param('.defaults')) { + $self->delete_all(); + } + + # hash containing our defined fieldnames + $self->{'.fieldnames'} = {}; + for ($self->param('.cgifields')) { + $self->{'.fieldnames'}->{$_}++; + } + + # Clear out our default submission button flag if present + $self->delete('.submit'); + $self->delete('.cgifields'); + + $self->save_request unless defined $initializer; +} + +# FUNCTIONS TO OVERRIDE: +# Turn a string into a filehandle +sub to_filehandle { + my $thingy = shift; + return undef unless $thingy; + return $thingy if UNIVERSAL::isa($thingy,'GLOB'); + return $thingy if UNIVERSAL::isa($thingy,'FileHandle'); + if (!ref($thingy)) { + my $caller = 1; + while (my $package = caller($caller++)) { + my($tmp) = $thingy=~/[\':]/ ? $thingy : "$package\:\:$thingy"; + return $tmp if defined(fileno($tmp)); + } + } + return undef; +} + +# send output to the browser +sub put { + my($self,@p) = self_or_default(@_); + $self->print(@p); +} + +# print to standard output (for overriding in mod_perl) +sub print { + shift; + CORE::print(@_); +} + +# get/set last cgi_error +sub cgi_error { + my ($self,$err) = self_or_default(@_); + $self->{'.cgi_error'} = $err if defined $err; + return $self->{'.cgi_error'}; +} + +sub save_request { + my($self) = @_; + # We're going to play with the package globals now so that if we get called + # again, we initialize ourselves in exactly the same way. This allows + # us to have several of these objects. + @QUERY_PARAM = $self->param; # save list of parameters + for (@QUERY_PARAM) { + next unless defined $_; + $QUERY_PARAM{$_}=$self->{param}{$_}; + } + $QUERY_CHARSET = $self->charset; + %QUERY_FIELDNAMES = %{$self->{'.fieldnames'}}; + %QUERY_TMPFILES = %{ $self->{'.tmpfiles'} || {} }; +} + +sub parse_params { + my($self,$tosplit) = @_; + my(@pairs) = split(/[&;]/,$tosplit); + my($param,$value); + for (@pairs) { + ($param,$value) = split('=',$_,2); + next unless defined $param; + next if $NO_UNDEF_PARAMS and not defined $value; + $value = '' unless defined $value; + $param = unescape($param); + $value = unescape($value); + $self->add_parameter($param); + push (@{$self->{param}{$param}},$value); + } +} + +sub add_parameter { + my($self,$param)=@_; + return unless defined $param; + push (@{$self->{'.parameters'}},$param) + unless defined($self->{param}{$param}); +} + +sub all_parameters { + my $self = shift; + return () unless defined($self) && $self->{'.parameters'}; + return () unless @{$self->{'.parameters'}}; + return @{$self->{'.parameters'}}; +} + +# put a filehandle into binary mode (DOS) +sub binmode { + return unless defined($_[1]) && defined fileno($_[1]); + CORE::binmode($_[1]); +} + +sub _make_tag_func { + my ($self,$tagname) = @_; + my $func = qq( + sub $tagname { + my (\$q,\$a,\@rest) = self_or_default(\@_); + my(\$attr) = ''; + if (ref(\$a) && ref(\$a) eq 'HASH') { + my(\@attr) = make_attributes(\$a,\$q->{'escape'}); + \$attr = " \@attr" if \@attr; + } else { + unshift \@rest,\$a if defined \$a; + } + ); + if ($tagname=~/start_(\w+)/i) { + $func .= qq! return "<\L$1\E\$attr>";} !; + } elsif ($tagname=~/end_(\w+)/i) { + $func .= qq! return "<\L/$1\E>"; } !; + } else { + $func .= qq# + return \$XHTML ? "\L<$tagname\E\$attr />" : "\L<$tagname\E\$attr>" unless \@rest; + my(\$tag,\$untag) = ("\L<$tagname\E\$attr>","\L\E"); + my \@result = map { "\$tag\$_\$untag" } + (ref(\$rest[0]) eq 'ARRAY') ? \@{\$rest[0]} : "\@rest"; + return "\@result"; + }#; + } +return $func; +} + +sub AUTOLOAD { + print STDERR "CGI::AUTOLOAD for $AUTOLOAD\n" if $CGI::AUTOLOAD_DEBUG; + my $func = &_compile; + goto &$func; +} + +sub _compile { + my($func) = $AUTOLOAD; + my($pack,$func_name); + { + local($1,$2); # this fixes an obscure variable suicide problem. + $func=~/(.+)::([^:]+)$/; + ($pack,$func_name) = ($1,$2); + $pack=~s/::SUPER$//; # fix another obscure problem + $pack = ${"$pack\:\:AutoloadClass"} || $CGI::DefaultClass + unless defined(${"$pack\:\:AUTOLOADED_ROUTINES"}); + + my($sub) = \%{"$pack\:\:SUBS"}; + unless (%$sub) { + my($auto) = \${"$pack\:\:AUTOLOADED_ROUTINES"}; + local ($@,$!); + eval "package $pack; $$auto"; + croak("$AUTOLOAD: $@") if $@; + $$auto = ''; # Free the unneeded storage (but don't undef it!!!) + } + my($code) = $sub->{$func_name}; + + $code = "sub $AUTOLOAD { }" if (!$code and $func_name eq 'DESTROY'); + if (!$code) { + (my $base = $func_name) =~ s/^(start_|end_)//i; + if ($EXPORT{':any'} || + $EXPORT{'-any'} || + $EXPORT{$base} || + (%EXPORT_OK || grep(++$EXPORT_OK{$_},&expand_tags(':html'))) + && $EXPORT_OK{$base}) { + $code = $CGI::DefaultClass->_make_tag_func($func_name); + } + } + croak("Undefined subroutine $AUTOLOAD\n") unless $code; + local ($@,$!); + eval "package $pack; $code"; + if ($@) { + $@ =~ s/ at .*\n//; + croak("$AUTOLOAD: $@"); + } + } + CORE::delete($sub->{$func_name}); #free storage + return "$pack\:\:$func_name"; +} + +sub _selected { + my $self = shift; + my $value = shift; + return '' unless $value; + return $XHTML ? qq(selected="selected" ) : qq(selected ); +} + +sub _checked { + my $self = shift; + my $value = shift; + return '' unless $value; + return $XHTML ? qq(checked="checked" ) : qq(checked ); +} + +sub _reset_globals { initialize_globals(); } + +sub _setup_symbols { + my $self = shift; + my $compile = 0; + + # to avoid reexporting unwanted variables + undef %EXPORT; + + for (@_) { + $HEADERS_ONCE++, next if /^[:-]unique_headers$/; + $NPH++, next if /^[:-]nph$/; + $NOSTICKY++, next if /^[:-]nosticky$/; + $DEBUG=0, next if /^[:-]no_?[Dd]ebug$/; + $DEBUG=2, next if /^[:-][Dd]ebug$/; + $USE_PARAM_SEMICOLONS++, next if /^[:-]newstyle_urls$/; + $PARAM_UTF8++, next if /^[:-]utf8$/; + $XHTML++, next if /^[:-]xhtml$/; + $XHTML=0, next if /^[:-]no_?xhtml$/; + $USE_PARAM_SEMICOLONS=0, next if /^[:-]oldstyle_urls$/; + $PRIVATE_TEMPFILES++, next if /^[:-]private_tempfiles$/; + $TABINDEX++, next if /^[:-]tabindex$/; + $CLOSE_UPLOAD_FILES++, next if /^[:-]close_upload_files$/; + $EXPORT{$_}++, next if /^[:-]any$/; + $compile++, next if /^[:-]compile$/; + $NO_UNDEF_PARAMS++, next if /^[:-]no_undef_params$/; + + # This is probably extremely evil code -- to be deleted some day. + if (/^[-]autoload$/) { + my($pkg) = caller(1); + *{"${pkg}::AUTOLOAD"} = sub { + my($routine) = $AUTOLOAD; + $routine =~ s/^.*::/CGI::/; + &$routine; + }; + next; + } + + for (&expand_tags($_)) { + tr/a-zA-Z0-9_//cd; # don't allow weird function names + $EXPORT{$_}++; + } + } + _compile_all(keys %EXPORT) if $compile; + @SAVED_SYMBOLS = @_; +} + +sub charset { + my ($self,$charset) = self_or_default(@_); + $self->{'.charset'} = $charset if defined $charset; + $self->{'.charset'}; +} + +sub element_id { + my ($self,$new_value) = self_or_default(@_); + $self->{'.elid'} = $new_value if defined $new_value; + sprintf('%010d',$self->{'.elid'}++); +} + +sub element_tab { + my ($self,$new_value) = self_or_default(@_); + $self->{'.etab'} ||= 1; + $self->{'.etab'} = $new_value if defined $new_value; + my $tab = $self->{'.etab'}++; + return '' unless $TABINDEX or defined $new_value; + return qq(tabindex="$tab" ); +} + +############################################################################### +################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND #################### +############################################################################### +$AUTOLOADED_ROUTINES = ''; # get rid of -w warning +$AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD'; + +%SUBS = ( + +'URL_ENCODED'=> <<'END_OF_FUNC', +sub URL_ENCODED { 'application/x-www-form-urlencoded'; } +END_OF_FUNC + +'MULTIPART' => <<'END_OF_FUNC', +sub MULTIPART { 'multipart/form-data'; } +END_OF_FUNC + +'SERVER_PUSH' => <<'END_OF_FUNC', +sub SERVER_PUSH { 'multipart/x-mixed-replace;boundary="' . shift() . '"'; } +END_OF_FUNC + +'new_MultipartBuffer' => <<'END_OF_FUNC', +# Create a new multipart buffer +sub new_MultipartBuffer { + my($self,$boundary,$length) = @_; + return MultipartBuffer->new($self,$boundary,$length); +} +END_OF_FUNC + +'read_from_client' => <<'END_OF_FUNC', +# Read data from a file handle +sub read_from_client { + my($self, $buff, $len, $offset) = @_; + local $^W=0; # prevent a warning + return $MOD_PERL + ? $self->r->read($$buff, $len, $offset) + : read(\*STDIN, $$buff, $len, $offset); +} +END_OF_FUNC + +'read_from_stdin' => <<'END_OF_FUNC', +# Read data from stdin until all is read +sub read_from_stdin { + my($self, $buff) = @_; + local $^W=0; # prevent a warning + + # + # TODO: loop over STDIN until all is read + # + + my($eoffound) = 0; + my($localbuf) = ''; + my($tempbuf) = ''; + my($bufsiz) = 1024; + my($res); + while ($eoffound == 0) { + if ( $MOD_PERL ) { + $res = $self->r->read($tempbuf, $bufsiz, 0) + } + else { + $res = read(\*STDIN, $tempbuf, $bufsiz); + } + + if ( !defined($res) ) { + # TODO: how to do error reporting ? + $eoffound = 1; + last; + } + if ( $res == 0 ) { + $eoffound = 1; + last; + } + $localbuf .= $tempbuf; + } + + $$buff = $localbuf; + + return $res; +} +END_OF_FUNC + +'delete' => <<'END_OF_FUNC', +#### Method: delete +# Deletes the named parameter entirely. +#### +sub delete { + my($self,@p) = self_or_default(@_); + my(@names) = rearrange([NAME],@p); + my @to_delete = ref($names[0]) eq 'ARRAY' ? @$names[0] : @names; + my %to_delete; + for my $name (@to_delete) + { + CORE::delete $self->{param}{$name}; + CORE::delete $self->{'.fieldnames'}->{$name}; + $to_delete{$name}++; + } + @{$self->{'.parameters'}}=grep { !exists($to_delete{$_}) } $self->param(); + return; +} +END_OF_FUNC + +#### Method: import_names +# Import all parameters into the given namespace. +# Assumes namespace 'Q' if not specified +#### +'import_names' => <<'END_OF_FUNC', +sub import_names { + my($self,$namespace,$delete) = self_or_default(@_); + $namespace = 'Q' unless defined($namespace); + die "Can't import names into \"main\"\n" if \%{"${namespace}::"} == \%::; + if ($delete || $MOD_PERL || exists $ENV{'FCGI_ROLE'}) { + # can anyone find an easier way to do this? + for (keys %{"${namespace}::"}) { + local *symbol = "${namespace}::${_}"; + undef $symbol; + undef @symbol; + undef %symbol; + } + } + my($param,@value,$var); + for $param ($self->param) { + # protect against silly names + ($var = $param)=~tr/a-zA-Z0-9_/_/c; + $var =~ s/^(?=\d)/_/; + local *symbol = "${namespace}::$var"; + @value = $self->param($param); + @symbol = @value; + $symbol = $value[0]; + } +} +END_OF_FUNC + +#### Method: keywords +# Keywords acts a bit differently. Calling it in a list context +# returns the list of keywords. +# Calling it in a scalar context gives you the size of the list. +#### +'keywords' => <<'END_OF_FUNC', +sub keywords { + my($self,@values) = self_or_default(@_); + # If values is provided, then we set it. + $self->{param}{'keywords'}=[@values] if @values; + my(@result) = defined($self->{param}{'keywords'}) ? @{$self->{param}{'keywords'}} : (); + @result; +} +END_OF_FUNC + +# These are some tie() interfaces for compatibility +# with Steve Brenner's cgi-lib.pl routines +'Vars' => <<'END_OF_FUNC', +sub Vars { + my $q = shift; + my %in; + tie(%in,CGI,$q); + return %in if wantarray; + return \%in; +} +END_OF_FUNC + +# These are some tie() interfaces for compatibility +# with Steve Brenner's cgi-lib.pl routines +'ReadParse' => <<'END_OF_FUNC', +sub ReadParse { + local(*in); + if (@_) { + *in = $_[0]; + } else { + my $pkg = caller(); + *in=*{"${pkg}::in"}; + } + tie(%in,CGI); + return scalar(keys %in); +} +END_OF_FUNC + +'PrintHeader' => <<'END_OF_FUNC', +sub PrintHeader { + my($self) = self_or_default(@_); + return $self->header(); +} +END_OF_FUNC + +'HtmlTop' => <<'END_OF_FUNC', +sub HtmlTop { + my($self,@p) = self_or_default(@_); + return $self->start_html(@p); +} +END_OF_FUNC + +'HtmlBot' => <<'END_OF_FUNC', +sub HtmlBot { + my($self,@p) = self_or_default(@_); + return $self->end_html(@p); +} +END_OF_FUNC + +'SplitParam' => <<'END_OF_FUNC', +sub SplitParam { + my ($param) = @_; + my (@params) = split ("\0", $param); + return (wantarray ? @params : $params[0]); +} +END_OF_FUNC + +'MethGet' => <<'END_OF_FUNC', +sub MethGet { + return request_method() eq 'GET'; +} +END_OF_FUNC + +'MethPost' => <<'END_OF_FUNC', +sub MethPost { + return request_method() eq 'POST'; +} +END_OF_FUNC + +'MethPut' => <<'END_OF_FUNC', +sub MethPut { + return request_method() eq 'PUT'; +} +END_OF_FUNC + +'TIEHASH' => <<'END_OF_FUNC', +sub TIEHASH { + my $class = shift; + my $arg = $_[0]; + if (ref($arg) && UNIVERSAL::isa($arg,'CGI')) { + return $arg; + } + return $Q ||= $class->new(@_); +} +END_OF_FUNC + +'STORE' => <<'END_OF_FUNC', +sub STORE { + my $self = shift; + my $tag = shift; + my $vals = shift; + my @vals = index($vals,"\0")!=-1 ? split("\0",$vals) : $vals; + $self->param(-name=>$tag,-value=>\@vals); +} +END_OF_FUNC + +'FETCH' => <<'END_OF_FUNC', +sub FETCH { + return $_[0] if $_[1] eq 'CGI'; + return undef unless defined $_[0]->param($_[1]); + return join("\0",$_[0]->param($_[1])); +} +END_OF_FUNC + +'FIRSTKEY' => <<'END_OF_FUNC', +sub FIRSTKEY { + $_[0]->{'.iterator'}=0; + $_[0]->{'.parameters'}->[$_[0]->{'.iterator'}++]; +} +END_OF_FUNC + +'NEXTKEY' => <<'END_OF_FUNC', +sub NEXTKEY { + $_[0]->{'.parameters'}->[$_[0]->{'.iterator'}++]; +} +END_OF_FUNC + +'EXISTS' => <<'END_OF_FUNC', +sub EXISTS { + exists $_[0]->{param}{$_[1]}; +} +END_OF_FUNC + +'DELETE' => <<'END_OF_FUNC', +sub DELETE { + $_[0]->delete($_[1]); +} +END_OF_FUNC + +'CLEAR' => <<'END_OF_FUNC', +sub CLEAR { + %{$_[0]}=(); +} +#### +END_OF_FUNC + +#### +# Append a new value to an existing query +#### +'append' => <<'EOF', +sub append { + my($self,@p) = self_or_default(@_); + my($name,$value) = rearrange([NAME,[VALUE,VALUES]],@p); + my(@values) = defined($value) ? (ref($value) ? @{$value} : $value) : (); + if (@values) { + $self->add_parameter($name); + push(@{$self->{param}{$name}},@values); + } + return $self->param($name); +} +EOF + +#### Method: delete_all +# Delete all parameters +#### +'delete_all' => <<'EOF', +sub delete_all { + my($self) = self_or_default(@_); + my @param = $self->param(); + $self->delete(@param); +} +EOF + +'Delete' => <<'EOF', +sub Delete { + my($self,@p) = self_or_default(@_); + $self->delete(@p); +} +EOF + +'Delete_all' => <<'EOF', +sub Delete_all { + my($self,@p) = self_or_default(@_); + $self->delete_all(@p); +} +EOF + +#### Method: autoescape +# If you want to turn off the autoescaping features, +# call this method with undef as the argument +'autoEscape' => <<'END_OF_FUNC', +sub autoEscape { + my($self,$escape) = self_or_default(@_); + my $d = $self->{'escape'}; + $self->{'escape'} = $escape; + $d; +} +END_OF_FUNC + + +#### Method: version +# Return the current version +#### +'version' => <<'END_OF_FUNC', +sub version { + return $VERSION; +} +END_OF_FUNC + +#### Method: url_param +# Return a parameter in the QUERY_STRING, regardless of +# whether this was a POST or a GET +#### +'url_param' => <<'END_OF_FUNC', +sub url_param { + my ($self,@p) = self_or_default(@_); + my $name = shift(@p); + return undef unless exists($ENV{QUERY_STRING}); + unless (exists($self->{'.url_param'})) { + $self->{'.url_param'}={}; # empty hash + if ($ENV{QUERY_STRING} =~ /=/) { + my(@pairs) = split(/[&;]/,$ENV{QUERY_STRING}); + my($param,$value); + for (@pairs) { + ($param,$value) = split('=',$_,2); + $param = unescape($param); + $value = unescape($value); + push(@{$self->{'.url_param'}->{$param}},$value); + } + } else { + my @keywords = $self->parse_keywordlist($ENV{QUERY_STRING}); + $self->{'.url_param'}{'keywords'} = \@keywords if @keywords; + } + } + return keys %{$self->{'.url_param'}} unless defined($name); + return () unless $self->{'.url_param'}->{$name}; + return wantarray ? @{$self->{'.url_param'}->{$name}} + : $self->{'.url_param'}->{$name}->[0]; +} +END_OF_FUNC + +#### Method: Dump +# Returns a string in which all the known parameter/value +# pairs are represented as nested lists, mainly for the purposes +# of debugging. +#### +'Dump' => <<'END_OF_FUNC', +sub Dump { + my($self) = self_or_default(@_); + my($param,$value,@result); + return '
    ' unless $self->param; + push(@result,"
      "); + for $param ($self->param) { + my($name)=$self->_maybe_escapeHTML($param); + push(@result,"
    • $name
      • "); + push(@result,"
        "); + for $value ($self->param($param)) { + $value = $self->_maybe_escapeHTML($value); + $value =~ s/\n/
        \n/g; + push(@result,"
      • $value
        • "); + } + push(@result,"
      "); + } + push(@result,"
    "); + return join("\n",@result); +} +END_OF_FUNC + +#### Method as_string +# +# synonym for "dump" +#### +'as_string' => <<'END_OF_FUNC', +sub as_string { + &Dump(@_); +} +END_OF_FUNC + +#### Method: save +# Write values out to a filehandle in such a way that they can +# be reinitialized by the filehandle form of the new() method +#### +'save' => <<'END_OF_FUNC', +sub save { + my($self,$filehandle) = self_or_default(@_); + $filehandle = to_filehandle($filehandle); + my($param); + local($,) = ''; # set print field separator back to a sane value + local($\) = ''; # set output line separator to a sane value + for $param ($self->param) { + my($escaped_param) = escape($param); + my($value); + for $value ($self->param($param)) { + print $filehandle "$escaped_param=",escape("$value"),"\n" + if length($escaped_param) or length($value); + } + } + for (keys %{$self->{'.fieldnames'}}) { + print $filehandle ".cgifields=",escape("$_"),"\n"; + } + print $filehandle "=\n"; # end of record +} +END_OF_FUNC + + +#### Method: save_parameters +# An alias for save() that is a better name for exportation. +# Only intended to be used with the function (non-OO) interface. +#### +'save_parameters' => <<'END_OF_FUNC', +sub save_parameters { + my $fh = shift; + return save(to_filehandle($fh)); +} +END_OF_FUNC + +#### Method: restore_parameters +# A way to restore CGI parameters from an initializer. +# Only intended to be used with the function (non-OO) interface. +#### +'restore_parameters' => <<'END_OF_FUNC', +sub restore_parameters { + $Q = $CGI::DefaultClass->new(@_); +} +END_OF_FUNC + +#### Method: multipart_init +# Return a Content-Type: style header for server-push +# This has to be NPH on most web servers, and it is advisable to set $| = 1 +# +# Many thanks to Ed Jordan for this +# contribution, updated by Andrew Benham (adsb@bigfoot.com) +#### +'multipart_init' => <<'END_OF_FUNC', +sub multipart_init { + my($self,@p) = self_or_default(@_); + my($boundary,@other) = rearrange_header([BOUNDARY],@p); + if (!$boundary) { + $boundary = '------- =_'; + my @chrs = ('0'..'9', 'A'..'Z', 'a'..'z'); + for (1..17) { + $boundary .= $chrs[rand(scalar @chrs)]; + } + } + + $self->{'separator'} = "$CRLF--$boundary$CRLF"; + $self->{'final_separator'} = "$CRLF--$boundary--$CRLF"; + $type = SERVER_PUSH($boundary); + return $self->header( + -nph => 0, + -type => $type, + (map { split "=", $_, 2 } @other), + ) . "WARNING: YOUR BROWSER DOESN'T SUPPORT THIS SERVER-PUSH TECHNOLOGY." . $self->multipart_end; +} +END_OF_FUNC + + +#### Method: multipart_start +# Return a Content-Type: style header for server-push, start of section +# +# Many thanks to Ed Jordan for this +# contribution, updated by Andrew Benham (adsb@bigfoot.com) +#### +'multipart_start' => <<'END_OF_FUNC', +sub multipart_start { + my(@header); + my($self,@p) = self_or_default(@_); + my($type,@other) = rearrange([TYPE],@p); + $type = $type || 'text/html'; + push(@header,"Content-Type: $type"); + + # rearrange() was designed for the HTML portion, so we + # need to fix it up a little. + for (@other) { + # Don't use \s because of perl bug 21951 + next unless my($header,$value) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/; + ($_ = $header) =~ s/^(\w)(.*)/$1 . lc ($2) . ': '.$self->unescapeHTML($value)/e; + } + push(@header,@other); + my $header = join($CRLF,@header)."${CRLF}${CRLF}"; + return $header; +} +END_OF_FUNC + + +#### Method: multipart_end +# Return a MIME boundary separator for server-push, end of section +# +# Many thanks to Ed Jordan for this +# contribution +#### +'multipart_end' => <<'END_OF_FUNC', +sub multipart_end { + my($self,@p) = self_or_default(@_); + return $self->{'separator'}; +} +END_OF_FUNC + + +#### Method: multipart_final +# Return a MIME boundary separator for server-push, end of all sections +# +# Contributed by Andrew Benham (adsb@bigfoot.com) +#### +'multipart_final' => <<'END_OF_FUNC', +sub multipart_final { + my($self,@p) = self_or_default(@_); + return $self->{'final_separator'} . "WARNING: YOUR BROWSER DOESN'T SUPPORT THIS SERVER-PUSH TECHNOLOGY." . $CRLF; +} +END_OF_FUNC + + +#### Method: header +# Return a Content-Type: style header +# +#### +'header' => <<'END_OF_FUNC', +sub header { + my($self,@p) = self_or_default(@_); + my(@header); + + return "" if $self->{'.header_printed'}++ and $HEADERS_ONCE; + + my($type,$status,$cookie,$target,$expires,$nph,$charset,$attachment,$p3p,@other) = + rearrange([['TYPE','CONTENT_TYPE','CONTENT-TYPE'], + 'STATUS',['COOKIE','COOKIES'],'TARGET', + 'EXPIRES','NPH','CHARSET', + 'ATTACHMENT','P3P'],@p); + + # CR escaping for values, per RFC 822 + for my $header ($type,$status,$cookie,$target,$expires,$nph,$charset,$attachment,$p3p,@other) { + if (defined $header) { + # From RFC 822: + # Unfolding is accomplished by regarding CRLF immediately + # followed by a LWSP-char as equivalent to the LWSP-char. + $header =~ s/$CRLF(\s)/$1/g; + + # All other uses of newlines are invalid input. + if ($header =~ m/$CRLF|\015|\012/) { + # shorten very long values in the diagnostic + $header = substr($header,0,72).'...' if (length $header > 72); + die "Invalid header value contains a newline not followed by whitespace: $header"; + } + } + } + + $nph ||= $NPH; + + $type ||= 'text/html' unless defined($type); + + if (defined $charset) { + $self->charset($charset); + } else { + $charset = $self->charset if $type =~ /^text\//; + } + $charset ||= ''; + + # rearrange() was designed for the HTML portion, so we + # need to fix it up a little. + for (@other) { + # Don't use \s because of perl bug 21951 + next unless my($header,$value) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/s; + ($_ = $header) =~ s/^(\w)(.*)/"\u$1\L$2" . ': '.$self->unescapeHTML($value)/e; + } + + $type .= "; charset=$charset" + if $type ne '' + and $type !~ /\bcharset\b/ + and defined $charset + and $charset ne ''; + + # Maybe future compatibility. Maybe not. + my $protocol = $ENV{SERVER_PROTOCOL} || 'HTTP/1.0'; + push(@header,$protocol . ' ' . ($status || '200 OK')) if $nph; + push(@header,"Server: " . &server_software()) if $nph; + + push(@header,"Status: $status") if $status; + push(@header,"Window-Target: $target") if $target; + if ($p3p) { + $p3p = join ' ',@$p3p if ref($p3p) eq 'ARRAY'; + push(@header,qq(P3P: policyref="/w3c/p3p.xml", CP="$p3p")); + } + # push all the cookies -- there may be several + if ($cookie) { + my(@cookie) = ref($cookie) && ref($cookie) eq 'ARRAY' ? @{$cookie} : $cookie; + for (@cookie) { + my $cs = UNIVERSAL::isa($_,'CGI::Cookie') ? $_->as_string : $_; + push(@header,"Set-Cookie: $cs") if $cs ne ''; + } + } + # if the user indicates an expiration time, then we need + # both an Expires and a Date header (so that the browser is + # uses OUR clock) + push(@header,"Expires: " . expires($expires,'http')) + if $expires; + push(@header,"Date: " . expires(0,'http')) if $expires || $cookie || $nph; + push(@header,"Pragma: no-cache") if $self->cache(); + push(@header,"Content-Disposition: attachment; filename=\"$attachment\"") if $attachment; + push(@header,map {ucfirst $_} @other); + push(@header,"Content-Type: $type") if $type ne ''; + my $header = join($CRLF,@header)."${CRLF}${CRLF}"; + if (($MOD_PERL >= 1) && !$nph) { + $self->r->send_cgi_header($header); + return ''; + } + return $header; +} +END_OF_FUNC + + +#### Method: cache +# Control whether header() will produce the no-cache +# Pragma directive. +#### +'cache' => <<'END_OF_FUNC', +sub cache { + my($self,$new_value) = self_or_default(@_); + $new_value = '' unless $new_value; + if ($new_value ne '') { + $self->{'cache'} = $new_value; + } + return $self->{'cache'}; +} +END_OF_FUNC + + +#### Method: redirect +# Return a Location: style header +# +#### +'redirect' => <<'END_OF_FUNC', +sub redirect { + my($self,@p) = self_or_default(@_); + my($url,$target,$status,$cookie,$nph,@other) = + rearrange([[LOCATION,URI,URL],TARGET,STATUS,['COOKIE','COOKIES'],NPH],@p); + $status = '302 Found' unless defined $status; + $url ||= $self->self_url; + my(@o); + for (@other) { tr/\"//d; push(@o,split("=",$_,2)); } + unshift(@o, + '-Status' => $status, + '-Location'=> $url, + '-nph' => $nph); + unshift(@o,'-Target'=>$target) if $target; + unshift(@o,'-Type'=>''); + my @unescaped; + unshift(@unescaped,'-Cookie'=>$cookie) if $cookie; + return $self->header((map {$self->unescapeHTML($_)} @o),@unescaped); +} +END_OF_FUNC + + +#### Method: start_html +# Canned HTML header +# +# Parameters: +# $title -> (optional) The title for this HTML document (-title) +# $author -> (optional) e-mail address of the author (-author) +# $base -> (optional) if set to true, will enter the BASE address of this document +# for resolving relative references (-base) +# $xbase -> (optional) alternative base at some remote location (-xbase) +# $target -> (optional) target window to load all links into (-target) +# $script -> (option) Javascript code (-script) +# $no_script -> (option) Javascript +END + ; + my($other) = @other ? " @other" : ''; + push(@result,"\n\n"); + return join("\n",@result); +} +END_OF_FUNC + +### Method: _style +# internal method for generating a CSS style section +#### +'_style' => <<'END_OF_FUNC', +sub _style { + my ($self,$style) = @_; + my (@result); + + my $type = 'text/css'; + my $rel = 'stylesheet'; + + + my $cdata_start = $XHTML ? "\n\n" : " -->\n"; + + my @s = ref($style) eq 'ARRAY' ? @$style : $style; + my $other = ''; + + for my $s (@s) { + if (ref($s)) { + my($src,$code,$verbatim,$stype,$alternate,$foo,@other) = + rearrange([qw(SRC CODE VERBATIM TYPE ALTERNATE FOO)], + ('-foo'=>'bar', + ref($s) eq 'ARRAY' ? @$s : %$s)); + my $type = defined $stype ? $stype : 'text/css'; + my $rel = $alternate ? 'alternate stylesheet' : 'stylesheet'; + $other = "@other" if @other; + + if (ref($src) eq "ARRAY") # Check to see if the $src variable is an array reference + { # If it is, push a LINK tag for each one + for $src (@$src) + { + push(@result,$XHTML ? qq() + : qq()) if $src; + } + } + else + { # Otherwise, push the single -src, if it exists. + push(@result,$XHTML ? qq() + : qq() + ) if $src; + } + if ($verbatim) { + my @v = ref($verbatim) eq 'ARRAY' ? @$verbatim : $verbatim; + push(@result, "") for @v; + } + my @c = ref($code) eq 'ARRAY' ? @$code : $code if $code; + push(@result,style({'type'=>$type},"$cdata_start\n$_\n$cdata_end")) for @c; + + } else { + my $src = $s; + push(@result,$XHTML ? qq() + : qq()); + } + } + @result; +} +END_OF_FUNC + +'_script' => <<'END_OF_FUNC', +sub _script { + my ($self,$script) = @_; + my (@result); + + my (@scripts) = ref($script) eq 'ARRAY' ? @$script : ($script); + for $script (@scripts) { + my($src,$code,$language); + if (ref($script)) { # script is a hash + ($src,$code,$type) = + rearrange(['SRC','CODE',['LANGUAGE','TYPE']], + '-foo'=>'bar', # a trick to allow the '-' to be omitted + ref($script) eq 'ARRAY' ? @$script : %$script); + $type ||= 'text/javascript'; + unless ($type =~ m!\w+/\w+!) { + $type =~ s/[\d.]+$//; + $type = "text/$type"; + } + } else { + ($src,$code,$type) = ('',$script, 'text/javascript'); + } + + my $comment = '//'; # javascript by default + $comment = '#' if $type=~/perl|tcl/i; + $comment = "'" if $type=~/vbscript/i; + + my ($cdata_start,$cdata_end); + if ($XHTML) { + $cdata_start = "$comment"; + } else { + $cdata_start = "\n\n"; + } + my(@satts); + push(@satts,'src'=>$src) if $src; + push(@satts,'type'=>$type); + $code = $cdata_start . $code . $cdata_end if defined $code; + push(@result,$self->script({@satts},$code || '')); + } + @result; +} +END_OF_FUNC + +#### Method: end_html +# End an HTML document. +# Trivial method for completeness. Just returns "" +#### +'end_html' => <<'END_OF_FUNC', +sub end_html { + return "\n\n"; +} +END_OF_FUNC + + +################################ +# METHODS USED IN BUILDING FORMS +################################ + +#### Method: isindex +# Just prints out the isindex tag. +# Parameters: +# $action -> optional URL of script to run +# Returns: +# A string containing a tag +'isindex' => <<'END_OF_FUNC', +sub isindex { + my($self,@p) = self_or_default(@_); + my($action,@other) = rearrange([ACTION],@p); + $action = qq/ action="$action"/ if $action; + my($other) = @other ? " @other" : ''; + return $XHTML ? "" : ""; +} +END_OF_FUNC + + +#### Method: startform +# This method is DEPRECATED +# Start a form +# Parameters: +# $method -> optional submission method to use (GET or POST) +# $action -> optional URL of script to run +# $enctype ->encoding to use (URL_ENCODED or MULTIPART) +'startform' => <<'END_OF_FUNC', +sub startform { + my($self,@p) = self_or_default(@_); + + my($method,$action,$enctype,@other) = + rearrange([METHOD,ACTION,ENCTYPE],@p); + + $method = $self->_maybe_escapeHTML(lc($method || 'post')); + $enctype = $self->_maybe_escapeHTML($enctype || &URL_ENCODED); + if (defined $action) { + $action = $self->_maybe_escapeHTML($action); + } + else { + $action = $self->_maybe_escapeHTML($self->request_uri || $self->self_url); + } + $action = qq(action="$action"); + my($other) = @other ? " @other" : ''; + $self->{'.parametersToAdd'}={}; + return qq/
    \n/; +} +END_OF_FUNC + +#### Method: start_form +# Start a form +# Parameters: +# $method -> optional submission method to use (GET or POST) +# $action -> optional URL of script to run +# $enctype ->encoding to use (URL_ENCODED or MULTIPART) +'start_form' => <<'END_OF_FUNC', +sub start_form { + my($self,@p) = self_or_default(@_); + + my($method,$action,$enctype,@other) = + rearrange([METHOD,ACTION,ENCTYPE],@p); + + $method = $self->_maybe_escapeHTML(lc($method || 'post')); + + if( $XHTML ){ + $enctype = $self->_maybe_escapeHTML($enctype || &MULTIPART); + }else{ + $enctype = $self->_maybe_escapeHTML($enctype || &URL_ENCODED); + } + + if (defined $action) { + $action = $self->_maybe_escapeHTML($action); + } + else { + $action = $self->_maybe_escapeHTML($self->request_uri || $self->self_url); + } + $action = qq(action="$action"); + my($other) = @other ? " @other" : ''; + $self->{'.parametersToAdd'}={}; + return qq/\n/; +} +END_OF_FUNC + +#### Method: start_multipart_form +'start_multipart_form' => <<'END_OF_FUNC', +sub start_multipart_form { + my($self,@p) = self_or_default(@_); + if (defined($p[0]) && substr($p[0],0,1) eq '-') { + return $self->start_form(-enctype=>&MULTIPART,@p); + } else { + my($method,$action,@other) = + rearrange([METHOD,ACTION],@p); + return $self->start_form($method,$action,&MULTIPART,@other); + } +} +END_OF_FUNC + + + +#### Method: end_form +# End a form +'end_form' => <<'END_OF_FUNC', +sub end_form { + my($self,@p) = self_or_default(@_); + if ( $NOSTICKY ) { + return wantarray ? ("
    ") : "\n"; + } else { + if (my @fields = $self->get_fields) { + return wantarray ? ("
    ",@fields,"
    ","") + : "
    ".(join '',@fields)."
    \n"; + } else { + return ""; + } + } +} +END_OF_FUNC + +#### Method: end_multipart_form +# end a multipart form +'end_multipart_form' => <<'END_OF_FUNC', +sub end_multipart_form { + &end_form; +} +END_OF_FUNC + + +'_textfield' => <<'END_OF_FUNC', +sub _textfield { + my($self,$tag,@p) = self_or_default(@_); + my($name,$default,$size,$maxlength,$override,$tabindex,@other) = + rearrange([NAME,[DEFAULT,VALUE,VALUES],SIZE,MAXLENGTH,[OVERRIDE,FORCE],TABINDEX],@p); + + my $current = $override ? $default : + (defined($self->param($name)) ? $self->param($name) : $default); + + $current = defined($current) ? $self->_maybe_escapeHTML($current,1) : ''; + $name = defined($name) ? $self->_maybe_escapeHTML($name) : ''; + my($s) = defined($size) ? qq/ size="$size"/ : ''; + my($m) = defined($maxlength) ? qq/ maxlength="$maxlength"/ : ''; + my($other) = @other ? " @other" : ''; + # this entered at cristy's request to fix problems with file upload fields + # and WebTV -- not sure it won't break stuff + my($value) = $current ne '' ? qq(value="$current") : ''; + $tabindex = $self->element_tab($tabindex); + return $XHTML ? qq() + : qq(); +} +END_OF_FUNC + +#### Method: textfield +# Parameters: +# $name -> Name of the text field +# $default -> Optional default value of the field if not +# already defined. +# $size -> Optional width of field in characaters. +# $maxlength -> Optional maximum number of characters. +# Returns: +# A string containing a field +# +'textfield' => <<'END_OF_FUNC', +sub textfield { + my($self,@p) = self_or_default(@_); + $self->_textfield('text',@p); +} +END_OF_FUNC + + +#### Method: filefield +# Parameters: +# $name -> Name of the file upload field +# $size -> Optional width of field in characaters. +# $maxlength -> Optional maximum number of characters. +# Returns: +# A string containing a field +# +'filefield' => <<'END_OF_FUNC', +sub filefield { + my($self,@p) = self_or_default(@_); + $self->_textfield('file',@p); +} +END_OF_FUNC + + +#### Method: password +# Create a "secret password" entry field +# Parameters: +# $name -> Name of the field +# $default -> Optional default value of the field if not +# already defined. +# $size -> Optional width of field in characters. +# $maxlength -> Optional maximum characters that can be entered. +# Returns: +# A string containing a field +# +'password_field' => <<'END_OF_FUNC', +sub password_field { + my ($self,@p) = self_or_default(@_); + $self->_textfield('password',@p); +} +END_OF_FUNC + +#### Method: textarea +# Parameters: +# $name -> Name of the text field +# $default -> Optional default value of the field if not +# already defined. +# $rows -> Optional number of rows in text area +# $columns -> Optional number of columns in text area +# Returns: +# A string containing a tag +# +'textarea' => <<'END_OF_FUNC', +sub textarea { + my($self,@p) = self_or_default(@_); + my($name,$default,$rows,$cols,$override,$tabindex,@other) = + rearrange([NAME,[DEFAULT,VALUE],ROWS,[COLS,COLUMNS],[OVERRIDE,FORCE],TABINDEX],@p); + + my($current)= $override ? $default : + (defined($self->param($name)) ? $self->param($name) : $default); + + $name = defined($name) ? $self->_maybe_escapeHTML($name) : ''; + $current = defined($current) ? $self->_maybe_escapeHTML($current) : ''; + my($r) = $rows ? qq/ rows="$rows"/ : ''; + my($c) = $cols ? qq/ cols="$cols"/ : ''; + my($other) = @other ? " @other" : ''; + $tabindex = $self->element_tab($tabindex); + return qq{}; +} +END_OF_FUNC + + +#### Method: button +# Create a javascript button. +# Parameters: +# $name -> (optional) Name for the button. (-name) +# $value -> (optional) Value of the button when selected (and visible name) (-value) +# $onclick -> (optional) Text of the JavaScript to run when the button is +# clicked. +# Returns: +# A string containing a tag +#### +'button' => <<'END_OF_FUNC', +sub button { + my($self,@p) = self_or_default(@_); + + my($label,$value,$script,$tabindex,@other) = rearrange([NAME,[VALUE,LABEL], + [ONCLICK,SCRIPT],TABINDEX],@p); + + $label=$self->_maybe_escapeHTML($label); + $value=$self->_maybe_escapeHTML($value,1); + $script=$self->_maybe_escapeHTML($script); + + $script ||= ''; + + my($name) = ''; + $name = qq/ name="$label"/ if $label; + $value = $value || $label; + my($val) = ''; + $val = qq/ value="$value"/ if $value; + $script = qq/ onclick="$script"/ if $script; + my($other) = @other ? " @other" : ''; + $tabindex = $self->element_tab($tabindex); + return $XHTML ? qq() + : qq(); +} +END_OF_FUNC + + +#### Method: submit +# Create a "submit query" button. +# Parameters: +# $name -> (optional) Name for the button. +# $value -> (optional) Value of the button when selected (also doubles as label). +# $label -> (optional) Label printed on the button(also doubles as the value). +# Returns: +# A string containing a tag +#### +'submit' => <<'END_OF_FUNC', +sub submit { + my($self,@p) = self_or_default(@_); + + my($label,$value,$tabindex,@other) = rearrange([NAME,[VALUE,LABEL],TABINDEX],@p); + + $label=$self->_maybe_escapeHTML($label); + $value=$self->_maybe_escapeHTML($value,1); + + my $name = $NOSTICKY ? '' : 'name=".submit" '; + $name = qq/name="$label" / if defined($label); + $value = defined($value) ? $value : $label; + my $val = ''; + $val = qq/value="$value" / if defined($value); + $tabindex = $self->element_tab($tabindex); + my($other) = @other ? "@other " : ''; + return $XHTML ? qq() + : qq(); +} +END_OF_FUNC + + +#### Method: reset +# Create a "reset" button. +# Parameters: +# $name -> (optional) Name for the button. +# Returns: +# A string containing a tag +#### +'reset' => <<'END_OF_FUNC', +sub reset { + my($self,@p) = self_or_default(@_); + my($label,$value,$tabindex,@other) = rearrange(['NAME',['VALUE','LABEL'],TABINDEX],@p); + $label=$self->_maybe_escapeHTML($label); + $value=$self->_maybe_escapeHTML($value,1); + my ($name) = ' name=".reset"'; + $name = qq/ name="$label"/ if defined($label); + $value = defined($value) ? $value : $label; + my($val) = ''; + $val = qq/ value="$value"/ if defined($value); + my($other) = @other ? " @other" : ''; + $tabindex = $self->element_tab($tabindex); + return $XHTML ? qq() + : qq(); +} +END_OF_FUNC + + +#### Method: defaults +# Create a "defaults" button. +# Parameters: +# $name -> (optional) Name for the button. +# Returns: +# A string containing a tag +# +# Note: this button has a special meaning to the initialization script, +# and tells it to ERASE the current query string so that your defaults +# are used again! +#### +'defaults' => <<'END_OF_FUNC', +sub defaults { + my($self,@p) = self_or_default(@_); + + my($label,$tabindex,@other) = rearrange([[NAME,VALUE],TABINDEX],@p); + + $label=$self->_maybe_escapeHTML($label,1); + $label = $label || "Defaults"; + my($value) = qq/ value="$label"/; + my($other) = @other ? " @other" : ''; + $tabindex = $self->element_tab($tabindex); + return $XHTML ? qq() + : qq//; +} +END_OF_FUNC + + +#### Method: comment +# Create an HTML +# Parameters: a string +'comment' => <<'END_OF_FUNC', +sub comment { + my($self,@p) = self_or_CGI(@_); + return ""; +} +END_OF_FUNC + +#### Method: checkbox +# Create a checkbox that is not logically linked to any others. +# The field value is "on" when the button is checked. +# Parameters: +# $name -> Name of the checkbox +# $checked -> (optional) turned on by default if true +# $value -> (optional) value of the checkbox, 'on' by default +# $label -> (optional) a user-readable label printed next to the box. +# Otherwise the checkbox name is used. +# Returns: +# A string containing a field +#### +'checkbox' => <<'END_OF_FUNC', +sub checkbox { + my($self,@p) = self_or_default(@_); + + my($name,$checked,$value,$label,$labelattributes,$override,$tabindex,@other) = + rearrange([NAME,[CHECKED,SELECTED,ON],VALUE,LABEL,LABELATTRIBUTES, + [OVERRIDE,FORCE],TABINDEX],@p); + + $value = defined $value ? $value : 'on'; + + if (!$override && ($self->{'.fieldnames'}->{$name} || + defined $self->param($name))) { + $checked = grep($_ eq $value,$self->param($name)) ? $self->_checked(1) : ''; + } else { + $checked = $self->_checked($checked); + } + my($the_label) = defined $label ? $label : $name; + $name = $self->_maybe_escapeHTML($name); + $value = $self->_maybe_escapeHTML($value,1); + $the_label = $self->_maybe_escapeHTML($the_label); + my($other) = @other ? "@other " : ''; + $tabindex = $self->element_tab($tabindex); + $self->register_parameter($name); + return $XHTML ? CGI::label($labelattributes, + qq{$the_label}) + : qq{$the_label}; +} +END_OF_FUNC + + + +# Escape HTML +'escapeHTML' => <<'END_OF_FUNC', +sub escapeHTML { + # hack to work around earlier hacks + push @_,$_[0] if @_==1 && $_[0] eq 'CGI'; + my ($self,$toencode,$newlinestoo) = CGI::self_or_default(@_); + return undef unless defined($toencode); + $toencode =~ s{&}{&}gso; + $toencode =~ s{<}{<}gso; + $toencode =~ s{>}{>}gso; + if ($DTD_PUBLIC_IDENTIFIER =~ /[^X]HTML 3\.2/i) { + # $quot; was accidentally omitted from the HTML 3.2 DTD -- see + # / + # . + $toencode =~ s{"}{"}gso; + } + else { + $toencode =~ s{"}{"}gso; + } + + # Handle bug in some browsers with Latin charsets + if ($self->{'.charset'} + && (uc($self->{'.charset'}) eq 'ISO-8859-1' + || uc($self->{'.charset'}) eq 'WINDOWS-1252')) { + $toencode =~ s{'}{'}gso; + $toencode =~ s{\x8b}{‹}gso; + $toencode =~ s{\x9b}{›}gso; + if (defined $newlinestoo && $newlinestoo) { + $toencode =~ s{\012}{ }gso; + $toencode =~ s{\015}{ }gso; + } + } + return $toencode; +} +END_OF_FUNC + +# unescape HTML -- used internally +'unescapeHTML' => <<'END_OF_FUNC', +sub unescapeHTML { + # hack to work around earlier hacks + push @_,$_[0] if @_==1 && $_[0] eq 'CGI'; + my ($self,$string) = CGI::self_or_default(@_); + return undef unless defined($string); + my $latin = defined $self->{'.charset'} ? $self->{'.charset'} =~ /^(ISO-8859-1|WINDOWS-1252)$/i + : 1; + # thanks to Randal Schwartz for the correct solution to this one + $string=~ s[&(\S*?);]{ + local $_ = $1; + /^amp$/i ? "&" : + /^quot$/i ? '"' : + /^gt$/i ? ">" : + /^lt$/i ? "<" : + /^#(\d+)$/ && $latin ? chr($1) : + /^#x([0-9a-f]+)$/i && $latin ? chr(hex($1)) : + $_ + }gex; + return $string; +} +END_OF_FUNC + +# Internal procedure - don't use +'_tableize' => <<'END_OF_FUNC', +sub _tableize { + my($rows,$columns,$rowheaders,$colheaders,@elements) = @_; + my @rowheaders = $rowheaders ? @$rowheaders : (); + my @colheaders = $colheaders ? @$colheaders : (); + my($result); + + if (defined($columns)) { + $rows = int(0.99 + @elements/$columns) unless defined($rows); + } + if (defined($rows)) { + $columns = int(0.99 + @elements/$rows) unless defined($columns); + } + + # rearrange into a pretty table + $result = ""; + my($row,$column); + unshift(@colheaders,'') if @colheaders && @rowheaders; + $result .= "" if @colheaders; + for (@colheaders) { + $result .= ""; + } + for ($row=0;$row<$rows;$row++) { + $result .= ""; + $result .= "" if @rowheaders; + for ($column=0;$column<$columns;$column++) { + $result .= "" + if defined($elements[$column*$rows + $row]); + } + $result .= ""; + } + $result .= "
    $_
    $rowheaders[$row]" . $elements[$column*$rows + $row] . "
    "; + return $result; +} +END_OF_FUNC + + +#### Method: radio_group +# Create a list of logically-linked radio buttons. +# Parameters: +# $name -> Common name for all the buttons. +# $values -> A pointer to a regular array containing the +# values for each button in the group. +# $default -> (optional) Value of the button to turn on by default. Pass '-' +# to turn _nothing_ on. +# $linebreak -> (optional) Set to true to place linebreaks +# between the buttons. +# $labels -> (optional) +# A pointer to a hash of labels to print next to each checkbox +# in the form $label{'value'}="Long explanatory label". +# Otherwise the provided values are used as the labels. +# Returns: +# An ARRAY containing a series of fields +#### +'radio_group' => <<'END_OF_FUNC', +sub radio_group { + my($self,@p) = self_or_default(@_); + $self->_box_group('radio',@p); +} +END_OF_FUNC + +#### Method: checkbox_group +# Create a list of logically-linked checkboxes. +# Parameters: +# $name -> Common name for all the check boxes +# $values -> A pointer to a regular array containing the +# values for each checkbox in the group. +# $defaults -> (optional) +# 1. If a pointer to a regular array of checkbox values, +# then this will be used to decide which +# checkboxes to turn on by default. +# 2. If a scalar, will be assumed to hold the +# value of a single checkbox in the group to turn on. +# $linebreak -> (optional) Set to true to place linebreaks +# between the buttons. +# $labels -> (optional) +# A pointer to a hash of labels to print next to each checkbox +# in the form $label{'value'}="Long explanatory label". +# Otherwise the provided values are used as the labels. +# Returns: +# An ARRAY containing a series of fields +#### + +'checkbox_group' => <<'END_OF_FUNC', +sub checkbox_group { + my($self,@p) = self_or_default(@_); + $self->_box_group('checkbox',@p); +} +END_OF_FUNC + +'_box_group' => <<'END_OF_FUNC', +sub _box_group { + my $self = shift; + my $box_type = shift; + + my($name,$values,$defaults,$linebreak,$labels,$labelattributes, + $attributes,$rows,$columns,$rowheaders,$colheaders, + $override,$nolabels,$tabindex,$disabled,@other) = + rearrange([NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LINEBREAK,LABELS,LABELATTRIBUTES, + ATTRIBUTES,ROWS,[COLUMNS,COLS],[ROWHEADERS,ROWHEADER],[COLHEADERS,COLHEADER], + [OVERRIDE,FORCE],NOLABELS,TABINDEX,DISABLED + ],@_); + + + my($result,$checked,@elements,@values); + + @values = $self->_set_values_and_labels($values,\$labels,$name); + my %checked = $self->previous_or_default($name,$defaults,$override); + + # If no check array is specified, check the first by default + $checked{$values[0]}++ if $box_type eq 'radio' && !%checked; + + $name=$self->_maybe_escapeHTML($name); + + my %tabs = (); + if ($TABINDEX && $tabindex) { + if (!ref $tabindex) { + $self->element_tab($tabindex); + } elsif (ref $tabindex eq 'ARRAY') { + %tabs = map {$_=>$self->element_tab} @$tabindex; + } elsif (ref $tabindex eq 'HASH') { + %tabs = %$tabindex; + } + } + %tabs = map {$_=>$self->element_tab} @values unless %tabs; + my $other = @other ? "@other " : ''; + my $radio_checked; + + # for disabling groups of radio/checkbox buttons + my %disabled; + for (@{$disabled}) { + $disabled{$_}=1; + } + + for (@values) { + my $disable=""; + if ($disabled{$_}) { + $disable="disabled='1'"; + } + + my $checkit = $self->_checked($box_type eq 'radio' ? ($checked{$_} && !$radio_checked++) + : $checked{$_}); + my($break); + if ($linebreak) { + $break = $XHTML ? "
    " : "
    "; + } + else { + $break = ''; + } + my($label)=''; + unless (defined($nolabels) && $nolabels) { + $label = $_; + $label = $labels->{$_} if defined($labels) && defined($labels->{$_}); + $label = $self->_maybe_escapeHTML($label,1); + $label = "$label" if $disabled{$_}; + } + my $attribs = $self->_set_attributes($_, $attributes); + my $tab = $tabs{$_}; + $_=$self->_maybe_escapeHTML($_); + + if ($XHTML) { + push @elements, + CGI::label($labelattributes, + qq($label)).${break}; + } else { + push(@elements,qq/${label}${break}/); + } + } + $self->register_parameter($name); + return wantarray ? @elements : "@elements" + unless defined($columns) || defined($rows); + return _tableize($rows,$columns,$rowheaders,$colheaders,@elements); +} +END_OF_FUNC + + +#### Method: popup_menu +# Create a popup menu. +# Parameters: +# $name -> Name for all the menu +# $values -> A pointer to a regular array containing the +# text of each menu item. +# $default -> (optional) Default item to display +# $labels -> (optional) +# A pointer to a hash of labels to print next to each checkbox +# in the form $label{'value'}="Long explanatory label". +# Otherwise the provided values are used as the labels. +# Returns: +# A string containing the definition of a popup menu. +#### +'popup_menu' => <<'END_OF_FUNC', +sub popup_menu { + my($self,@p) = self_or_default(@_); + + my($name,$values,$default,$labels,$attributes,$override,$tabindex,@other) = + rearrange([NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LABELS, + ATTRIBUTES,[OVERRIDE,FORCE],TABINDEX],@p); + my($result,%selected); + + if (!$override && defined($self->param($name))) { + $selected{$self->param($name)}++; + } elsif (defined $default) { + %selected = map {$_=>1} ref($default) eq 'ARRAY' + ? @$default + : $default; + } + $name=$self->_maybe_escapeHTML($name); + my($other) = @other ? " @other" : ''; + + my(@values); + @values = $self->_set_values_and_labels($values,\$labels,$name); + $tabindex = $self->element_tab($tabindex); + $name = q{} if ! defined $name; + $result = qq/"; + return $result; +} +END_OF_FUNC + + +#### Method: optgroup +# Create a optgroup. +# Parameters: +# $name -> Label for the group +# $values -> A pointer to a regular array containing the +# values for each option line in the group. +# $labels -> (optional) +# A pointer to a hash of labels to print next to each item +# in the form $label{'value'}="Long explanatory label". +# Otherwise the provided values are used as the labels. +# $labeled -> (optional) +# A true value indicates the value should be used as the label attribute +# in the option elements. +# The label attribute specifies the option label presented to the user. +# This defaults to the content of the \n/; + for (@values) { + if (/_set_attributes($_, $attributes); + my($label) = $_; + $label = $labels->{$_} if defined($labels) && defined($labels->{$_}); + $label=$self->_maybe_escapeHTML($label); + my($value)=$self->_maybe_escapeHTML($_,1); + $result .= $labeled ? $novals ? "$label\n" + : "$label\n" + : $novals ? "$label\n" + : "$label\n"; + } + } + $result .= ""; + return $result; +} +END_OF_FUNC + + +#### Method: scrolling_list +# Create a scrolling list. +# Parameters: +# $name -> name for the list +# $values -> A pointer to a regular array containing the +# values for each option line in the list. +# $defaults -> (optional) +# 1. If a pointer to a regular array of options, +# then this will be used to decide which +# lines to turn on by default. +# 2. Otherwise holds the value of the single line to turn on. +# $size -> (optional) Size of the list. +# $multiple -> (optional) If set, allow multiple selections. +# $labels -> (optional) +# A pointer to a hash of labels to print next to each checkbox +# in the form $label{'value'}="Long explanatory label". +# Otherwise the provided values are used as the labels. +# Returns: +# A string containing the definition of a scrolling list. +#### +'scrolling_list' => <<'END_OF_FUNC', +sub scrolling_list { + my($self,@p) = self_or_default(@_); + my($name,$values,$defaults,$size,$multiple,$labels,$attributes,$override,$tabindex,@other) + = rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT], + SIZE,MULTIPLE,LABELS,ATTRIBUTES,[OVERRIDE,FORCE],TABINDEX],@p); + + my($result,@values); + @values = $self->_set_values_and_labels($values,\$labels,$name); + + $size = $size || scalar(@values); + + my(%selected) = $self->previous_or_default($name,$defaults,$override); + + my($is_multiple) = $multiple ? qq/ multiple="multiple"/ : ''; + my($has_size) = $size ? qq/ size="$size"/: ''; + my($other) = @other ? " @other" : ''; + + $name=$self->_maybe_escapeHTML($name); + $tabindex = $self->element_tab($tabindex); + $result = qq/"; + $self->register_parameter($name); + return $result; +} +END_OF_FUNC + + +#### Method: hidden +# Parameters: +# $name -> Name of the hidden field +# @default -> (optional) Initial values of field (may be an array) +# or +# $default->[initial values of field] +# Returns: +# A string containing a +#### +'hidden' => <<'END_OF_FUNC', +sub hidden { + my($self,@p) = self_or_default(@_); + + # this is the one place where we departed from our standard + # calling scheme, so we have to special-case (darn) + my(@result,@value); + my($name,$default,$override,@other) = + rearrange([NAME,[DEFAULT,VALUE,VALUES],[OVERRIDE,FORCE]],@p); + + my $do_override = 0; + if ( ref($p[0]) || substr($p[0],0,1) eq '-') { + @value = ref($default) ? @{$default} : $default; + $do_override = $override; + } else { + for ($default,$override,@other) { + push(@value,$_) if defined($_); + } + undef @other; + } + + # use previous values if override is not set + my @prev = $self->param($name); + @value = @prev if !$do_override && @prev; + + $name=$self->_maybe_escapeHTML($name); + for (@value) { + $_ = defined($_) ? $self->_maybe_escapeHTML($_,1) : ''; + push @result,$XHTML ? qq() + : qq(); + } + return wantarray ? @result : join('',@result); +} +END_OF_FUNC + + +#### Method: image_button +# Parameters: +# $name -> Name of the button +# $src -> URL of the image source +# $align -> Alignment style (TOP, BOTTOM or MIDDLE) +# Returns: +# A string containing a +#### +'image_button' => <<'END_OF_FUNC', +sub image_button { + my($self,@p) = self_or_default(@_); + + my($name,$src,$alignment,@other) = + rearrange([NAME,SRC,ALIGN],@p); + + my($align) = $alignment ? " align=\L\"$alignment\"" : ''; + my($other) = @other ? " @other" : ''; + $name=$self->_maybe_escapeHTML($name); + return $XHTML ? qq() + : qq//; +} +END_OF_FUNC + + +#### Method: self_url +# Returns a URL containing the current script and all its +# param/value pairs arranged as a query. You can use this +# to create a link that, when selected, will reinvoke the +# script with all its state information preserved. +#### +'self_url' => <<'END_OF_FUNC', +sub self_url { + my($self,@p) = self_or_default(@_); + return $self->url('-path_info'=>1,'-query'=>1,'-full'=>1,@p); +} +END_OF_FUNC + + +# This is provided as a synonym to self_url() for people unfortunate +# enough to have incorporated it into their programs already! +'state' => <<'END_OF_FUNC', +sub state { + &self_url; +} +END_OF_FUNC + + +#### Method: url +# Like self_url, but doesn't return the query string part of +# the URL. +#### +'url' => <<'END_OF_FUNC', +sub url { + my($self,@p) = self_or_default(@_); + my ($relative,$absolute,$full,$path_info,$query,$base,$rewrite) = + rearrange(['RELATIVE','ABSOLUTE','FULL',['PATH','PATH_INFO'],['QUERY','QUERY_STRING'],'BASE','REWRITE'],@p); + my $url = ''; + $full++ if $base || !($relative || $absolute); + $rewrite++ unless defined $rewrite; + + my $path = $self->path_info; + my $script_name = $self->script_name; + my $request_uri = unescape($self->request_uri) || ''; + my $query_str = $self->query_string; + + my $rewrite_in_use = $request_uri && $request_uri !~ /^\Q$script_name/; + undef $path if $rewrite_in_use && $rewrite; # path not valid when rewriting active + + my $uri = $rewrite && $request_uri ? $request_uri : $script_name; + $uri =~ s/\?.*$//s; # remove query string + $uri =~ s/\Q$ENV{PATH_INFO}\E$// if defined $ENV{PATH_INFO}; +# $uri =~ s/\Q$path\E$// if defined $path; # remove path + + if ($full) { + my $protocol = $self->protocol(); + $url = "$protocol://"; + my $vh = http('x_forwarded_host') || http('host') || ''; + $vh =~ s/\:\d+$//; # some clients add the port number (incorrectly). Get rid of it. + + $url .= $vh || server_name(); + + my $port = $self->virtual_port; + + # add the port to the url unless it's the protocol's default port + $url .= ':' . $port unless (lc($protocol) eq 'http' && $port == 80) + or (lc($protocol) eq 'https' && $port == 443); + + return $url if $base; + + $url .= $uri; + } elsif ($relative) { + ($url) = $uri =~ m!([^/]+)$!; + } elsif ($absolute) { + $url = $uri; + } + + $url .= $path if $path_info and defined $path; + $url .= "?$query_str" if $query and $query_str ne ''; + $url ||= ''; + $url =~ s/([^a-zA-Z0-9_.%;&?\/\\:+=~-])/sprintf("%%%02X",ord($1))/eg; + return $url; +} + +END_OF_FUNC + +#### Method: cookie +# Set or read a cookie from the specified name. +# Cookie can then be passed to header(). +# Usual rules apply to the stickiness of -value. +# Parameters: +# -name -> name for this cookie (optional) +# -value -> value of this cookie (scalar, array or hash) +# -path -> paths for which this cookie is valid (optional) +# -domain -> internet domain in which this cookie is valid (optional) +# -secure -> if true, cookie only passed through secure channel (optional) +# -expires -> expiry date in format Wdy, DD-Mon-YYYY HH:MM:SS GMT (optional) +#### +'cookie' => <<'END_OF_FUNC', +sub cookie { + my($self,@p) = self_or_default(@_); + my($name,$value,$path,$domain,$secure,$expires,$httponly) = + rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES,HTTPONLY],@p); + + require CGI::Cookie; + + # if no value is supplied, then we retrieve the + # value of the cookie, if any. For efficiency, we cache the parsed + # cookies in our state variables. + unless ( defined($value) ) { + $self->{'.cookies'} = CGI::Cookie->fetch; + + # If no name is supplied, then retrieve the names of all our cookies. + return () unless $self->{'.cookies'}; + return keys %{$self->{'.cookies'}} unless $name; + return () unless $self->{'.cookies'}->{$name}; + return $self->{'.cookies'}->{$name}->value if defined($name) && $name ne ''; + } + + # If we get here, we're creating a new cookie + return undef unless defined($name) && $name ne ''; # this is an error + + my @param; + push(@param,'-name'=>$name); + push(@param,'-value'=>$value); + push(@param,'-domain'=>$domain) if $domain; + push(@param,'-path'=>$path) if $path; + push(@param,'-expires'=>$expires) if $expires; + push(@param,'-secure'=>$secure) if $secure; + push(@param,'-httponly'=>$httponly) if $httponly; + + return CGI::Cookie->new(@param); +} +END_OF_FUNC + +'parse_keywordlist' => <<'END_OF_FUNC', +sub parse_keywordlist { + my($self,$tosplit) = @_; + $tosplit = unescape($tosplit); # unescape the keywords + $tosplit=~tr/+/ /; # pluses to spaces + my(@keywords) = split(/\s+/,$tosplit); + return @keywords; +} +END_OF_FUNC + +'param_fetch' => <<'END_OF_FUNC', +sub param_fetch { + my($self,@p) = self_or_default(@_); + my($name) = rearrange([NAME],@p); + unless (exists($self->{param}{$name})) { + $self->add_parameter($name); + $self->{param}{$name} = []; + } + + return $self->{param}{$name}; +} +END_OF_FUNC + +############################################### +# OTHER INFORMATION PROVIDED BY THE ENVIRONMENT +############################################### + +#### Method: path_info +# Return the extra virtual path information provided +# after the URL (if any) +#### +'path_info' => <<'END_OF_FUNC', +sub path_info { + my ($self,$info) = self_or_default(@_); + if (defined($info)) { + $info = "/$info" if $info ne '' && substr($info,0,1) ne '/'; + $self->{'.path_info'} = $info; + } elsif (! defined($self->{'.path_info'}) ) { + my (undef,$path_info) = $self->_name_and_path_from_env; + $self->{'.path_info'} = $path_info || ''; + } + return $self->{'.path_info'}; +} +END_OF_FUNC + +# This function returns a potentially modified version of SCRIPT_NAME +# and PATH_INFO. Some HTTP servers do sanitise the paths in those +# variables. It is the case of at least Apache 2. If for instance the +# user requests: /path/./to/script.cgi/x//y/z/../x?y, Apache will set: +# REQUEST_URI=/path/./to/script.cgi/x//y/z/../x?y +# SCRIPT_NAME=/path/to/env.cgi +# PATH_INFO=/x/y/x +# +# This is all fine except that some bogus CGI scripts expect +# PATH_INFO=/http://foo when the user requests +# http://xxx/script.cgi/http://foo +# +# Old versions of this module used to accomodate with those scripts, so +# this is why we do this here to keep those scripts backward compatible. +# Basically, we accomodate with those scripts but within limits, that is +# we only try to preserve the number of / that were provided by the user +# if $REQUEST_URI and "$SCRIPT_NAME$PATH_INFO" only differ by the number +# of consecutive /. +# +# So for instance, in: http://foo/x//y/script.cgi/a//b, we'll return a +# script_name of /x//y/script.cgi and a path_info of /a//b, but in: +# http://foo/./x//z/script.cgi/a/../b//c, we'll return the versions +# possibly sanitised by the HTTP server, so in the case of Apache 2: +# script_name == /foo/x/z/script.cgi and path_info == /b/c. +# +# Future versions of this module may no longer do that, so one should +# avoid relying on the browser, proxy, server, and CGI.pm preserving the +# number of consecutive slashes as no guarantee can be made there. +'_name_and_path_from_env' => <<'END_OF_FUNC', +sub _name_and_path_from_env { + my $self = shift; + my $script_name = $ENV{SCRIPT_NAME} || ''; + my $path_info = $ENV{PATH_INFO} || ''; + my $uri = $self->request_uri || ''; + + $uri =~ s/\?.*//s; + $uri = unescape($uri); + + if ($uri ne "$script_name$path_info") { + my $script_name_pattern = quotemeta($script_name); + my $path_info_pattern = quotemeta($path_info); + $script_name_pattern =~ s{(?:\\/)+}{/+}g; + $path_info_pattern =~ s{(?:\\/)+}{/+}g; + + if ($uri =~ /^($script_name_pattern)($path_info_pattern)$/s) { + # REQUEST_URI and SCRIPT_NAME . PATH_INFO only differ by the + # numer of consecutive slashes, so we can extract the info from + # REQUEST_URI: + ($script_name, $path_info) = ($1, $2); + } + } + return ($script_name,$path_info); +} +END_OF_FUNC + + +#### Method: request_method +# Returns 'POST', 'GET', 'PUT' or 'HEAD' +#### +'request_method' => <<'END_OF_FUNC', +sub request_method { + return (defined $ENV{'REQUEST_METHOD'}) ? $ENV{'REQUEST_METHOD'} : undef; +} +END_OF_FUNC + +#### Method: content_type +# Returns the content_type string +#### +'content_type' => <<'END_OF_FUNC', +sub content_type { + return (defined $ENV{'CONTENT_TYPE'}) ? $ENV{'CONTENT_TYPE'} : undef; +} +END_OF_FUNC + +#### Method: path_translated +# Return the physical path information provided +# by the URL (if any) +#### +'path_translated' => <<'END_OF_FUNC', +sub path_translated { + return (defined $ENV{'PATH_TRANSLATED'}) ? $ENV{'PATH_TRANSLATED'} : undef; +} +END_OF_FUNC + + +#### Method: request_uri +# Return the literal request URI +#### +'request_uri' => <<'END_OF_FUNC', +sub request_uri { + return (defined $ENV{'REQUEST_URI'}) ? $ENV{'REQUEST_URI'} : undef; +} +END_OF_FUNC + + +#### Method: query_string +# Synthesize a query string from our current +# parameters +#### +'query_string' => <<'END_OF_FUNC', +sub query_string { + my($self) = self_or_default(@_); + my($param,$value,@pairs); + for $param ($self->param) { + my($eparam) = escape($param); + for $value ($self->param($param)) { + $value = escape($value); + next unless defined $value; + push(@pairs,"$eparam=$value"); + } + } + for (keys %{$self->{'.fieldnames'}}) { + push(@pairs,".cgifields=".escape("$_")); + } + return join($USE_PARAM_SEMICOLONS ? ';' : '&',@pairs); +} +END_OF_FUNC + + +#### Method: accept +# Without parameters, returns an array of the +# MIME types the browser accepts. +# With a single parameter equal to a MIME +# type, will return undef if the browser won't +# accept it, 1 if the browser accepts it but +# doesn't give a preference, or a floating point +# value between 0.0 and 1.0 if the browser +# declares a quantitative score for it. +# This handles MIME type globs correctly. +#### +'Accept' => <<'END_OF_FUNC', +sub Accept { + my($self,$search) = self_or_CGI(@_); + my(%prefs,$type,$pref,$pat); + + my(@accept) = defined $self->http('accept') + ? split(',',$self->http('accept')) + : (); + + for (@accept) { + ($pref) = /q=(\d\.\d+|\d+)/; + ($type) = m#(\S+/[^;]+)#; + next unless $type; + $prefs{$type}=$pref || 1; + } + + return keys %prefs unless $search; + + # if a search type is provided, we may need to + # perform a pattern matching operation. + # The MIME types use a glob mechanism, which + # is easily translated into a perl pattern match + + # First return the preference for directly supported + # types: + return $prefs{$search} if $prefs{$search}; + + # Didn't get it, so try pattern matching. + for (keys %prefs) { + next unless /\*/; # not a pattern match + ($pat = $_) =~ s/([^\w*])/\\$1/g; # escape meta characters + $pat =~ s/\*/.*/g; # turn it into a pattern + return $prefs{$_} if $search=~/$pat/; + } +} +END_OF_FUNC + + +#### Method: user_agent +# If called with no parameters, returns the user agent. +# If called with one parameter, does a pattern match (case +# insensitive) on the user agent. +#### +'user_agent' => <<'END_OF_FUNC', +sub user_agent { + my($self,$match)=self_or_CGI(@_); + my $user_agent = $self->http('user_agent'); + return $user_agent unless $match && $user_agent; + return $user_agent =~ /$match/i; +} +END_OF_FUNC + + +#### Method: raw_cookie +# Returns the magic cookies for the session. +# The cookies are not parsed or altered in any way, i.e. +# cookies are returned exactly as given in the HTTP +# headers. If a cookie name is given, only that cookie's +# value is returned, otherwise the entire raw cookie +# is returned. +#### +'raw_cookie' => <<'END_OF_FUNC', +sub raw_cookie { + my($self,$key) = self_or_CGI(@_); + + require CGI::Cookie; + + if (defined($key)) { + $self->{'.raw_cookies'} = CGI::Cookie->raw_fetch + unless $self->{'.raw_cookies'}; + + return () unless $self->{'.raw_cookies'}; + return () unless $self->{'.raw_cookies'}->{$key}; + return $self->{'.raw_cookies'}->{$key}; + } + return $self->http('cookie') || $ENV{'COOKIE'} || ''; +} +END_OF_FUNC + +#### Method: virtual_host +# Return the name of the virtual_host, which +# is not always the same as the server +###### +'virtual_host' => <<'END_OF_FUNC', +sub virtual_host { + my $vh = http('x_forwarded_host') || http('host') || server_name(); + $vh =~ s/:\d+$//; # get rid of port number + return $vh; +} +END_OF_FUNC + +#### Method: remote_host +# Return the name of the remote host, or its IP +# address if unavailable. If this variable isn't +# defined, it returns "localhost" for debugging +# purposes. +#### +'remote_host' => <<'END_OF_FUNC', +sub remote_host { + return $ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'} + || 'localhost'; +} +END_OF_FUNC + + +#### Method: remote_addr +# Return the IP addr of the remote host. +#### +'remote_addr' => <<'END_OF_FUNC', +sub remote_addr { + return $ENV{'REMOTE_ADDR'} || '127.0.0.1'; +} +END_OF_FUNC + + +#### Method: script_name +# Return the partial URL to this script for +# self-referencing scripts. Also see +# self_url(), which returns a URL with all state information +# preserved. +#### +'script_name' => <<'END_OF_FUNC', +sub script_name { + my ($self,@p) = self_or_default(@_); + if (@p) { + $self->{'.script_name'} = shift @p; + } elsif (!exists $self->{'.script_name'}) { + my ($script_name,$path_info) = $self->_name_and_path_from_env(); + $self->{'.script_name'} = $script_name; + } + return $self->{'.script_name'}; +} +END_OF_FUNC + + +#### Method: referer +# Return the HTTP_REFERER: useful for generating +# a GO BACK button. +#### +'referer' => <<'END_OF_FUNC', +sub referer { + my($self) = self_or_CGI(@_); + return $self->http('referer'); +} +END_OF_FUNC + + +#### Method: server_name +# Return the name of the server +#### +'server_name' => <<'END_OF_FUNC', +sub server_name { + return $ENV{'SERVER_NAME'} || 'localhost'; +} +END_OF_FUNC + +#### Method: server_software +# Return the name of the server software +#### +'server_software' => <<'END_OF_FUNC', +sub server_software { + return $ENV{'SERVER_SOFTWARE'} || 'cmdline'; +} +END_OF_FUNC + +#### Method: virtual_port +# Return the server port, taking virtual hosts into account +#### +'virtual_port' => <<'END_OF_FUNC', +sub virtual_port { + my($self) = self_or_default(@_); + my $vh = $self->http('x_forwarded_host') || $self->http('host'); + my $protocol = $self->protocol; + if ($vh) { + return ($vh =~ /:(\d+)$/)[0] || ($protocol eq 'https' ? 443 : 80); + } else { + return $self->server_port(); + } +} +END_OF_FUNC + +#### Method: server_port +# Return the tcp/ip port the server is running on +#### +'server_port' => <<'END_OF_FUNC', +sub server_port { + return $ENV{'SERVER_PORT'} || 80; # for debugging +} +END_OF_FUNC + +#### Method: server_protocol +# Return the protocol (usually HTTP/1.0) +#### +'server_protocol' => <<'END_OF_FUNC', +sub server_protocol { + return $ENV{'SERVER_PROTOCOL'} || 'HTTP/1.0'; # for debugging +} +END_OF_FUNC + +#### Method: http +# Return the value of an HTTP variable, or +# the list of variables if none provided +#### +'http' => <<'END_OF_FUNC', +sub http { + my ($self,$parameter) = self_or_CGI(@_); + if ( defined($parameter) ) { + $parameter =~ tr/-a-z/_A-Z/; + if ( $parameter =~ /^HTTP(?:_|$)/ ) { + return $ENV{$parameter}; + } + return $ENV{"HTTP_$parameter"}; + } + return grep { /^HTTP(?:_|$)/ } keys %ENV; +} +END_OF_FUNC + +#### Method: https +# Return the value of HTTPS, or +# the value of an HTTPS variable, or +# the list of variables +#### +'https' => <<'END_OF_FUNC', +sub https { + my ($self,$parameter) = self_or_CGI(@_); + if ( defined($parameter) ) { + $parameter =~ tr/-a-z/_A-Z/; + if ( $parameter =~ /^HTTPS(?:_|$)/ ) { + return $ENV{$parameter}; + } + return $ENV{"HTTPS_$parameter"}; + } + return wantarray + ? grep { /^HTTPS(?:_|$)/ } keys %ENV + : $ENV{'HTTPS'}; +} +END_OF_FUNC + +#### Method: protocol +# Return the protocol (http or https currently) +#### +'protocol' => <<'END_OF_FUNC', +sub protocol { + local($^W)=0; + my $self = shift; + return 'https' if uc($self->https()) eq 'ON'; + return 'https' if $self->server_port == 443; + my $prot = $self->server_protocol; + my($protocol,$version) = split('/',$prot); + return "\L$protocol\E"; +} +END_OF_FUNC + +#### Method: remote_ident +# Return the identity of the remote user +# (but only if his host is running identd) +#### +'remote_ident' => <<'END_OF_FUNC', +sub remote_ident { + return (defined $ENV{'REMOTE_IDENT'}) ? $ENV{'REMOTE_IDENT'} : undef; +} +END_OF_FUNC + + +#### Method: auth_type +# Return the type of use verification/authorization in use, if any. +#### +'auth_type' => <<'END_OF_FUNC', +sub auth_type { + return (defined $ENV{'AUTH_TYPE'}) ? $ENV{'AUTH_TYPE'} : undef; +} +END_OF_FUNC + + +#### Method: remote_user +# Return the authorization name used for user +# verification. +#### +'remote_user' => <<'END_OF_FUNC', +sub remote_user { + return (defined $ENV{'REMOTE_USER'}) ? $ENV{'REMOTE_USER'} : undef; +} +END_OF_FUNC + + +#### Method: user_name +# Try to return the remote user's name by hook or by +# crook +#### +'user_name' => <<'END_OF_FUNC', +sub user_name { + my ($self) = self_or_CGI(@_); + return $self->http('from') || $ENV{'REMOTE_IDENT'} || $ENV{'REMOTE_USER'}; +} +END_OF_FUNC + +#### Method: nosticky +# Set or return the NOSTICKY global flag +#### +'nosticky' => <<'END_OF_FUNC', +sub nosticky { + my ($self,$param) = self_or_CGI(@_); + $CGI::NOSTICKY = $param if defined($param); + return $CGI::NOSTICKY; +} +END_OF_FUNC + +#### Method: nph +# Set or return the NPH global flag +#### +'nph' => <<'END_OF_FUNC', +sub nph { + my ($self,$param) = self_or_CGI(@_); + $CGI::NPH = $param if defined($param); + return $CGI::NPH; +} +END_OF_FUNC + +#### Method: private_tempfiles +# Set or return the private_tempfiles global flag +#### +'private_tempfiles' => <<'END_OF_FUNC', +sub private_tempfiles { + my ($self,$param) = self_or_CGI(@_); + $CGI::PRIVATE_TEMPFILES = $param if defined($param); + return $CGI::PRIVATE_TEMPFILES; +} +END_OF_FUNC +#### Method: close_upload_files +# Set or return the close_upload_files global flag +#### +'close_upload_files' => <<'END_OF_FUNC', +sub close_upload_files { + my ($self,$param) = self_or_CGI(@_); + $CGI::CLOSE_UPLOAD_FILES = $param if defined($param); + return $CGI::CLOSE_UPLOAD_FILES; +} +END_OF_FUNC + + +#### Method: default_dtd +# Set or return the default_dtd global +#### +'default_dtd' => <<'END_OF_FUNC', +sub default_dtd { + my ($self,$param,$param2) = self_or_CGI(@_); + if (defined $param2 && defined $param) { + $CGI::DEFAULT_DTD = [ $param, $param2 ]; + } elsif (defined $param) { + $CGI::DEFAULT_DTD = $param; + } + return $CGI::DEFAULT_DTD; +} +END_OF_FUNC + +# -------------- really private subroutines ----------------- +'_maybe_escapeHTML' => <<'END_OF_FUNC', +sub _maybe_escapeHTML { + # hack to work around earlier hacks + push @_,$_[0] if @_==1 && $_[0] eq 'CGI'; + my ($self,$toencode,$newlinestoo) = CGI::self_or_default(@_); + return undef unless defined($toencode); + return $toencode if ref($self) && !$self->{'escape'}; + return $self->escapeHTML($toencode, $newlinestoo); +} +END_OF_FUNC + +'previous_or_default' => <<'END_OF_FUNC', +sub previous_or_default { + my($self,$name,$defaults,$override) = @_; + my(%selected); + + if (!$override && ($self->{'.fieldnames'}->{$name} || + defined($self->param($name)) ) ) { + $selected{$_}++ for $self->param($name); + } elsif (defined($defaults) && ref($defaults) && + (ref($defaults) eq 'ARRAY')) { + $selected{$_}++ for @{$defaults}; + } else { + $selected{$defaults}++ if defined($defaults); + } + + return %selected; +} +END_OF_FUNC + +'register_parameter' => <<'END_OF_FUNC', +sub register_parameter { + my($self,$param) = @_; + $self->{'.parametersToAdd'}->{$param}++; +} +END_OF_FUNC + +'get_fields' => <<'END_OF_FUNC', +sub get_fields { + my($self) = @_; + return $self->CGI::hidden('-name'=>'.cgifields', + '-values'=>[keys %{$self->{'.parametersToAdd'}}], + '-override'=>1); +} +END_OF_FUNC + +'read_from_cmdline' => <<'END_OF_FUNC', +sub read_from_cmdline { + my($input,@words); + my($query_string); + my($subpath); + if ($DEBUG && @ARGV) { + @words = @ARGV; + } elsif ($DEBUG > 1) { + require "shellwords.pl"; + print STDERR "(offline mode: enter name=value pairs on standard input; press ^D or ^Z when done)\n"; + chomp(@lines = ); # remove newlines + $input = join(" ",@lines); + @words = &shellwords($input); + } + for (@words) { + s/\\=/%3D/g; + s/\\&/%26/g; + } + + if ("@words"=~/=/) { + $query_string = join('&',@words); + } else { + $query_string = join('+',@words); + } + if ($query_string =~ /^(.*?)\?(.*)$/) + { + $query_string = $2; + $subpath = $1; + } + return { 'query_string' => $query_string, 'subpath' => $subpath }; +} +END_OF_FUNC + +##### +# subroutine: read_multipart +# +# Read multipart data and store it into our parameters. +# An interesting feature is that if any of the parts is a file, we +# create a temporary file and open up a filehandle on it so that the +# caller can read from it if necessary. +##### +'read_multipart' => <<'END_OF_FUNC', +sub read_multipart { + my($self,$boundary,$length) = @_; + my($buffer) = $self->new_MultipartBuffer($boundary,$length); + return unless $buffer; + my(%header,$body); + my $filenumber = 0; + while (!$buffer->eof) { + %header = $buffer->readHeader; + + unless (%header) { + $self->cgi_error("400 Bad request (malformed multipart POST)"); + return; + } + + $header{'Content-Disposition'} ||= ''; # quench uninit variable warning + + my($param)= $header{'Content-Disposition'}=~/[\s;]name="([^"]*)"/; + $param .= $TAINTED; + + # See RFC 1867, 2183, 2045 + # NB: File content will be loaded into memory should + # content-disposition parsing fail. + my ($filename) = $header{'Content-Disposition'} + =~/ filename=(("[^"]*")|([a-z\d!\#'\*\+,\.^_\`\{\}\|\~]*))/i; + + $filename ||= ''; # quench uninit variable warning + + $filename =~ s/^"([^"]*)"$/$1/; + # Test for Opera's multiple upload feature + my($multipart) = ( defined( $header{'Content-Type'} ) && + $header{'Content-Type'} =~ /multipart\/mixed/ ) ? + 1 : 0; + + # add this parameter to our list + $self->add_parameter($param); + + # If no filename specified, then just read the data and assign it + # to our parameter list. + if ( ( !defined($filename) || $filename eq '' ) && !$multipart ) { + my($value) = $buffer->readBody; + $value .= $TAINTED; + push(@{$self->{param}{$param}},$value); + next; + } + + my ($tmpfile,$tmp,$filehandle); + UPLOADS: { + # If we get here, then we are dealing with a potentially large + # uploaded form. Save the data to a temporary file, then open + # the file for reading. + + # skip the file if uploads disabled + if ($DISABLE_UPLOADS) { + while (defined($data = $buffer->read)) { } + last UPLOADS; + } + + # set the filename to some recognizable value + if ( ( !defined($filename) || $filename eq '' ) && $multipart ) { + $filename = "multipart/mixed"; + } + + # choose a relatively unpredictable tmpfile sequence number + my $seqno = unpack("%16C*",join('',localtime,grep {defined $_} values %ENV)); + for (my $cnt=10;$cnt>0;$cnt--) { + next unless $tmpfile = CGITempFile->new($seqno); + $tmp = $tmpfile->as_string; + last if defined($filehandle = Fh->new($filename,$tmp,$PRIVATE_TEMPFILES)); + $seqno += int rand(100); + } + die "CGI open of tmpfile: $!\n" unless defined $filehandle; + $CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode + && defined fileno($filehandle); + + # if this is an multipart/mixed attachment, save the header + # together with the body for later parsing with an external + # MIME parser module + if ( $multipart ) { + for ( keys %header ) { + print $filehandle "$_: $header{$_}${CRLF}"; + } + print $filehandle "${CRLF}"; + } + + my ($data); + local($\) = ''; + my $totalbytes = 0; + while (defined($data = $buffer->read)) { + if (defined $self->{'.upload_hook'}) + { + $totalbytes += length($data); + &{$self->{'.upload_hook'}}($filename ,$data, $totalbytes, $self->{'.upload_data'}); + } + print $filehandle $data if ($self->{'use_tempfile'}); + } + + # back up to beginning of file + seek($filehandle,0,0); + + ## Close the filehandle if requested this allows a multipart MIME + ## upload to contain many files, and we won't die due to too many + ## open file handles. The user can access the files using the hash + ## below. + close $filehandle if $CLOSE_UPLOAD_FILES; + $CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode; + + # Save some information about the uploaded file where we can get + # at it later. + # Use the typeglob as the key, as this is guaranteed to be + # unique for each filehandle. Don't use the file descriptor as + # this will be re-used for each filehandle if the + # close_upload_files feature is used. + $self->{'.tmpfiles'}->{$$filehandle}= { + hndl => $filehandle, + name => $tmpfile, + info => {%header}, + }; + push(@{$self->{param}{$param}},$filehandle); + } + } +} +END_OF_FUNC + +##### +# subroutine: read_multipart_related +# +# Read multipart/related data and store it into our parameters. The +# first parameter sets the start of the data. The part identified by +# this Content-ID will not be stored as a file upload, but will be +# returned by this method. All other parts will be available as file +# uploads accessible by their Content-ID +##### +'read_multipart_related' => <<'END_OF_FUNC', +sub read_multipart_related { + my($self,$start,$boundary,$length) = @_; + my($buffer) = $self->new_MultipartBuffer($boundary,$length); + return unless $buffer; + my(%header,$body); + my $filenumber = 0; + my $returnvalue; + while (!$buffer->eof) { + %header = $buffer->readHeader; + + unless (%header) { + $self->cgi_error("400 Bad request (malformed multipart POST)"); + return; + } + + my($param) = $header{'Content-ID'}=~/\<([^\>]*)\>/; + $param .= $TAINTED; + + # If this is the start part, then just read the data and assign it + # to our return variable. + if ( $param eq $start ) { + $returnvalue = $buffer->readBody; + $returnvalue .= $TAINTED; + next; + } + + # add this parameter to our list + $self->add_parameter($param); + + my ($tmpfile,$tmp,$filehandle); + UPLOADS: { + # If we get here, then we are dealing with a potentially large + # uploaded form. Save the data to a temporary file, then open + # the file for reading. + + # skip the file if uploads disabled + if ($DISABLE_UPLOADS) { + while (defined($data = $buffer->read)) { } + last UPLOADS; + } + + # choose a relatively unpredictable tmpfile sequence number + my $seqno = unpack("%16C*",join('',localtime,grep {defined $_} values %ENV)); + for (my $cnt=10;$cnt>0;$cnt--) { + next unless $tmpfile = CGITempFile->new($seqno); + $tmp = $tmpfile->as_string; + last if defined($filehandle = Fh->new($param,$tmp,$PRIVATE_TEMPFILES)); + $seqno += int rand(100); + } + die "CGI open of tmpfile: $!\n" unless defined $filehandle; + $CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode + && defined fileno($filehandle); + + my ($data); + local($\) = ''; + my $totalbytes; + while (defined($data = $buffer->read)) { + if (defined $self->{'.upload_hook'}) + { + $totalbytes += length($data); + &{$self->{'.upload_hook'}}($param ,$data, $totalbytes, $self->{'.upload_data'}); + } + print $filehandle $data if ($self->{'use_tempfile'}); + } + + # back up to beginning of file + seek($filehandle,0,0); + + ## Close the filehandle if requested this allows a multipart MIME + ## upload to contain many files, and we won't die due to too many + ## open file handles. The user can access the files using the hash + ## below. + close $filehandle if $CLOSE_UPLOAD_FILES; + $CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode; + + # Save some information about the uploaded file where we can get + # at it later. + # Use the typeglob as the key, as this is guaranteed to be + # unique for each filehandle. Don't use the file descriptor as + # this will be re-used for each filehandle if the + # close_upload_files feature is used. + $self->{'.tmpfiles'}->{$$filehandle}= { + hndl => $filehandle, + name => $tmpfile, + info => {%header}, + }; + push(@{$self->{param}{$param}},$filehandle); + } + } + return $returnvalue; +} +END_OF_FUNC + + +'upload' =><<'END_OF_FUNC', +sub upload { + my($self,$param_name) = self_or_default(@_); + my @param = grep {ref($_) && defined(fileno($_))} $self->param($param_name); + return unless @param; + return wantarray ? @param : $param[0]; +} +END_OF_FUNC + +'tmpFileName' => <<'END_OF_FUNC', +sub tmpFileName { + my($self,$filename) = self_or_default(@_); + return $self->{'.tmpfiles'}->{$$filename}->{name} ? + $self->{'.tmpfiles'}->{$$filename}->{name}->as_string + : ''; +} +END_OF_FUNC + +'uploadInfo' => <<'END_OF_FUNC', +sub uploadInfo { + my($self,$filename) = self_or_default(@_); + return $self->{'.tmpfiles'}->{$$filename}->{info}; +} +END_OF_FUNC + +# internal routine, don't use +'_set_values_and_labels' => <<'END_OF_FUNC', +sub _set_values_and_labels { + my $self = shift; + my ($v,$l,$n) = @_; + $$l = $v if ref($v) eq 'HASH' && !ref($$l); + return $self->param($n) if !defined($v); + return $v if !ref($v); + return ref($v) eq 'HASH' ? keys %$v : @$v; +} +END_OF_FUNC + +# internal routine, don't use +'_set_attributes' => <<'END_OF_FUNC', +sub _set_attributes { + my $self = shift; + my($element, $attributes) = @_; + return '' unless defined($attributes->{$element}); + $attribs = ' '; + for my $attrib (keys %{$attributes->{$element}}) { + (my $clean_attrib = $attrib) =~ s/^-//; + $attribs .= "@{[lc($clean_attrib)]}=\"$attributes->{$element}{$attrib}\" "; + } + $attribs =~ s/ $//; + return $attribs; +} +END_OF_FUNC + +'_compile_all' => <<'END_OF_FUNC', +sub _compile_all { + for (@_) { + next if defined(&$_); + $AUTOLOAD = "CGI::$_"; + _compile(); + } +} +END_OF_FUNC + +); +END_OF_AUTOLOAD +; + +######################################################### +# Globals and stubs for other packages that we use. +######################################################### + +################### Fh -- lightweight filehandle ############### +package Fh; + +use overload + '""' => \&asString, + 'cmp' => \&compare, + 'fallback'=>1; + +$FH='fh00000'; + +*Fh::AUTOLOAD = \&CGI::AUTOLOAD; + +sub DESTROY { + my $self = shift; + close $self; +} + +$AUTOLOADED_ROUTINES = ''; # prevent -w error +$AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD'; +%SUBS = ( +'asString' => <<'END_OF_FUNC', +sub asString { + my $self = shift; + # get rid of package name + (my $i = $$self) =~ s/^\*(\w+::fh\d{5})+//; + $i =~ s/%(..)/ chr(hex($1)) /eg; + return $i.$CGI::TAINTED; +# BEGIN DEAD CODE +# This was an extremely clever patch that allowed "use strict refs". +# Unfortunately it relied on another bug that caused leaky file descriptors. +# The underlying bug has been fixed, so this no longer works. However +# "strict refs" still works for some reason. +# my $self = shift; +# return ${*{$self}{SCALAR}}; +# END DEAD CODE +} +END_OF_FUNC + +'compare' => <<'END_OF_FUNC', +sub compare { + my $self = shift; + my $value = shift; + return "$self" cmp $value; +} +END_OF_FUNC + +'new' => <<'END_OF_FUNC', +sub new { + my($pack,$name,$file,$delete) = @_; + _setup_symbols(@SAVED_SYMBOLS) if @SAVED_SYMBOLS; + require Fcntl unless defined &Fcntl::O_RDWR; + (my $safename = $name) =~ s/([':%])/ sprintf '%%%02X', ord $1 /eg; + my $fv = ++$FH . $safename; + my $ref = \*{"Fh::$fv"}; + + # Note this same regex is also used elsewhere in the same file for CGITempFile::new + $file =~ m!^([a-zA-Z0-9_ \'\":/.\$\\\+-]+)$! || return; + my $safe = $1; + sysopen($ref,$safe,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL(),0600) || return; + unlink($safe) if $delete; + CORE::delete $Fh::{$fv}; + return bless $ref,$pack; +} +END_OF_FUNC + +'handle' => <<'END_OF_FUNC', +sub handle { + my $self = shift; + eval "require IO::Handle" unless IO::Handle->can('new_from_fd'); + return IO::Handle->new_from_fd(fileno $self,"<"); +} +END_OF_FUNC + +); +END_OF_AUTOLOAD + +######################## MultipartBuffer #################### +package MultipartBuffer; + +use constant DEBUG => 0; + +# how many bytes to read at a time. We use +# a 4K buffer by default. +$INITIAL_FILLUNIT = 1024 * 4; +$TIMEOUT = 240*60; # 4 hour timeout for big files +$SPIN_LOOP_MAX = 2000; # bug fix for some Netscape servers +$CRLF=$CGI::CRLF; + +#reuse the autoload function +*MultipartBuffer::AUTOLOAD = \&CGI::AUTOLOAD; + +# avoid autoloader warnings +sub DESTROY {} + +############################################################################### +################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND #################### +############################################################################### +$AUTOLOADED_ROUTINES = ''; # prevent -w error +$AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD'; +%SUBS = ( + +'new' => <<'END_OF_FUNC', +sub new { + my($package,$interface,$boundary,$length) = @_; + $FILLUNIT = $INITIAL_FILLUNIT; + $CGI::DefaultClass->binmode($IN); # if $CGI::needs_binmode; # just do it always + + # If the user types garbage into the file upload field, + # then Netscape passes NOTHING to the server (not good). + # We may hang on this read in that case. So we implement + # a read timeout. If nothing is ready to read + # by then, we return. + + # Netscape seems to be a little bit unreliable + # about providing boundary strings. + my $boundary_read = 0; + if ($boundary) { + + # Under the MIME spec, the boundary consists of the + # characters "--" PLUS the Boundary string + + # BUG: IE 3.01 on the Macintosh uses just the boundary -- not + # the two extra hyphens. We do a special case here on the user-agent!!!! + $boundary = "--$boundary" unless CGI::user_agent('MSIE\s+3\.0[12];\s*Mac|DreamPassport'); + + } else { # otherwise we find it ourselves + my($old); + ($old,$/) = ($/,$CRLF); # read a CRLF-delimited line + $boundary = ; # BUG: This won't work correctly under mod_perl + $length -= length($boundary); + chomp($boundary); # remove the CRLF + $/ = $old; # restore old line separator + $boundary_read++; + } + + my $self = {LENGTH=>$length, + CHUNKED=>!$length, + BOUNDARY=>$boundary, + INTERFACE=>$interface, + BUFFER=>'', + }; + + $FILLUNIT = length($boundary) + if length($boundary) > $FILLUNIT; + + my $retval = bless $self,ref $package || $package; + + # Read the preamble and the topmost (boundary) line plus the CRLF. + unless ($boundary_read) { + while ($self->read(0)) { } + } + die "Malformed multipart POST: data truncated\n" if $self->eof; + + return $retval; +} +END_OF_FUNC + +'readHeader' => <<'END_OF_FUNC', +sub readHeader { + my($self) = @_; + my($end); + my($ok) = 0; + my($bad) = 0; + + local($CRLF) = "\015\012" if $CGI::OS eq 'VMS' || $CGI::EBCDIC; + + do { + $self->fillBuffer($FILLUNIT); + $ok++ if ($end = index($self->{BUFFER},"${CRLF}${CRLF}")) >= 0; + $ok++ if $self->{BUFFER} eq ''; + $bad++ if !$ok && $self->{LENGTH} <= 0; + # this was a bad idea + # $FILLUNIT *= 2 if length($self->{BUFFER}) >= $FILLUNIT; + } until $ok || $bad; + return () if $bad; + + #EBCDIC NOTE: translate header into EBCDIC, but watch out for continuation lines! + + my($header) = substr($self->{BUFFER},0,$end+2); + substr($self->{BUFFER},0,$end+4) = ''; + my %return; + + if ($CGI::EBCDIC) { + warn "untranslated header=$header\n" if DEBUG; + $header = CGI::Util::ascii2ebcdic($header); + warn "translated header=$header\n" if DEBUG; + } + + # See RFC 2045 Appendix A and RFC 822 sections 3.4.8 + # (Folding Long Header Fields), 3.4.3 (Comments) + # and 3.4.5 (Quoted-Strings). + + my $token = '[-\w!\#$%&\'*+.^_\`|{}~]'; + $header=~s/$CRLF\s+/ /og; # merge continuation lines + + while ($header=~/($token+):\s+([^$CRLF]*)/mgox) { + my ($field_name,$field_value) = ($1,$2); + $field_name =~ s/\b(\w)/uc($1)/eg; #canonicalize + $return{$field_name}=$field_value; + } + return %return; +} +END_OF_FUNC + +# This reads and returns the body as a single scalar value. +'readBody' => <<'END_OF_FUNC', +sub readBody { + my($self) = @_; + my($data); + my($returnval)=''; + + #EBCDIC NOTE: want to translate returnval into EBCDIC HERE + + while (defined($data = $self->read)) { + $returnval .= $data; + } + + if ($CGI::EBCDIC) { + warn "untranslated body=$returnval\n" if DEBUG; + $returnval = CGI::Util::ascii2ebcdic($returnval); + warn "translated body=$returnval\n" if DEBUG; + } + return $returnval; +} +END_OF_FUNC + +# This will read $bytes or until the boundary is hit, whichever happens +# first. After the boundary is hit, we return undef. The next read will +# skip over the boundary and begin reading again; +'read' => <<'END_OF_FUNC', +sub read { + my($self,$bytes) = @_; + + # default number of bytes to read + $bytes = $bytes || $FILLUNIT; + + # Fill up our internal buffer in such a way that the boundary + # is never split between reads. + $self->fillBuffer($bytes); + + my $boundary_start = $CGI::EBCDIC ? CGI::Util::ebcdic2ascii($self->{BOUNDARY}) : $self->{BOUNDARY}; + my $boundary_end = $CGI::EBCDIC ? CGI::Util::ebcdic2ascii($self->{BOUNDARY}.'--') : $self->{BOUNDARY}.'--'; + + # Find the boundary in the buffer (it may not be there). + my $start = index($self->{BUFFER},$boundary_start); + + warn "boundary=$self->{BOUNDARY} length=$self->{LENGTH} start=$start\n" if DEBUG; + + # protect against malformed multipart POST operations + die "Malformed multipart POST\n" unless $self->{CHUNKED} || ($start >= 0 || $self->{LENGTH} > 0); + + #EBCDIC NOTE: want to translate boundary search into ASCII here. + + # If the boundary begins the data, then skip past it + # and return undef. + if ($start == 0) { + + # clear us out completely if we've hit the last boundary. + if (index($self->{BUFFER},$boundary_end)==0) { + $self->{BUFFER}=''; + $self->{LENGTH}=0; + return undef; + } + + # just remove the boundary. + substr($self->{BUFFER},0,length($boundary_start))=''; + $self->{BUFFER} =~ s/^\012\015?//; + return undef; + } + + my $bytesToReturn; + if ($start > 0) { # read up to the boundary + $bytesToReturn = $start-2 > $bytes ? $bytes : $start; + } else { # read the requested number of bytes + # leave enough bytes in the buffer to allow us to read + # the boundary. Thanks to Kevin Hendrick for finding + # this one. + $bytesToReturn = $bytes - (length($boundary_start)+1); + } + + my $returnval=substr($self->{BUFFER},0,$bytesToReturn); + substr($self->{BUFFER},0,$bytesToReturn)=''; + + # If we hit the boundary, remove the CRLF from the end. + return ($bytesToReturn==$start) + ? substr($returnval,0,-2) : $returnval; +} +END_OF_FUNC + + +# This fills up our internal buffer in such a way that the +# boundary is never split between reads +'fillBuffer' => <<'END_OF_FUNC', +sub fillBuffer { + my($self,$bytes) = @_; + return unless $self->{CHUNKED} || $self->{LENGTH}; + + my($boundaryLength) = length($self->{BOUNDARY}); + my($bufferLength) = length($self->{BUFFER}); + my($bytesToRead) = $bytes - $bufferLength + $boundaryLength + 2; + $bytesToRead = $self->{LENGTH} if !$self->{CHUNKED} && $self->{LENGTH} < $bytesToRead; + + # Try to read some data. We may hang here if the browser is screwed up. + my $bytesRead = $self->{INTERFACE}->read_from_client(\$self->{BUFFER}, + $bytesToRead, + $bufferLength); + warn "bytesToRead=$bytesToRead, bufferLength=$bufferLength, buffer=$self->{BUFFER}\n" if DEBUG; + $self->{BUFFER} = '' unless defined $self->{BUFFER}; + + # An apparent bug in the Apache server causes the read() + # to return zero bytes repeatedly without blocking if the + # remote user aborts during a file transfer. I don't know how + # they manage this, but the workaround is to abort if we get + # more than SPIN_LOOP_MAX consecutive zero reads. + if ($bytesRead <= 0) { + die "CGI.pm: Server closed socket during multipart read (client aborted?).\n" + if ($self->{ZERO_LOOP_COUNTER}++ >= $SPIN_LOOP_MAX); + } else { + $self->{ZERO_LOOP_COUNTER}=0; + } + + $self->{LENGTH} -= $bytesRead if !$self->{CHUNKED} && $bytesRead; +} +END_OF_FUNC + + +# Return true when we've finished reading +'eof' => <<'END_OF_FUNC' +sub eof { + my($self) = @_; + return 1 if (length($self->{BUFFER}) == 0) + && ($self->{LENGTH} <= 0); + undef; +} +END_OF_FUNC + +); +END_OF_AUTOLOAD + +#################################################################################### +################################## TEMPORARY FILES ################################# +#################################################################################### +package CGITempFile; + +sub find_tempdir { + $SL = $CGI::SL; + $MAC = $CGI::OS eq 'MACINTOSH'; + my ($vol) = $MAC ? MacPerl::Volumes() =~ /:(.*)/ : ""; + unless (defined $TMPDIRECTORY) { + @TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp", + "C:${SL}temp","${SL}tmp","${SL}temp", + "${vol}${SL}Temporary Items", + "${SL}WWW_ROOT", "${SL}SYS\$SCRATCH", + "C:${SL}system${SL}temp"); + + if( $CGI::OS eq 'WINDOWS' ){ + # PeterH: These evars may not exist if this is invoked within a service and untainting + # is in effect - with 'use warnings' the undefined array entries causes Perl to die + unshift(@TEMP,$ENV{TEMP}) if defined $ENV{TEMP}; + unshift(@TEMP,$ENV{TMP}) if defined $ENV{TMP}; + unshift(@TEMP,$ENV{WINDIR} . $SL . 'TEMP') if defined $ENV{WINDIR}; + } + + unshift(@TEMP,$ENV{'TMPDIR'}) if defined $ENV{'TMPDIR'}; + + # this feature was supposed to provide per-user tmpfiles, but + # it is problematic. + # unshift(@TEMP,(getpwuid($<))[7].'/tmp') if $CGI::OS eq 'UNIX'; + # Rob: getpwuid() is unfortunately UNIX specific. On brain dead OS'es this + # : can generate a 'getpwuid() not implemented' exception, even though + # : it's never called. Found under DOS/Win with the DJGPP perl port. + # : Refer to getpwuid() only at run-time if we're fortunate and have UNIX. + # unshift(@TEMP,(eval {(getpwuid($>))[7]}).'/tmp') if $CGI::OS eq 'UNIX' and $> != 0; + + for (@TEMP) { + do {$TMPDIRECTORY = $_; last} if -d $_ && -w _; + } + } + $TMPDIRECTORY = $MAC ? "" : "." unless $TMPDIRECTORY; +} + +find_tempdir(); + +$MAXTRIES = 5000; + +# cute feature, but overload implementation broke it +# %OVERLOAD = ('""'=>'as_string'); +*CGITempFile::AUTOLOAD = \&CGI::AUTOLOAD; + +sub DESTROY { + my($self) = @_; + $$self =~ m!^([a-zA-Z0-9_ \'\":/.\$\\~-]+)$! || return; + my $safe = $1; # untaint operation + unlink $safe; # get rid of the file +} + +############################################################################### +################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND #################### +############################################################################### +$AUTOLOADED_ROUTINES = ''; # prevent -w error +$AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD'; +%SUBS = ( + +'new' => <<'END_OF_FUNC', +sub new { + my($package,$sequence) = @_; + my $filename; + find_tempdir() unless -w $TMPDIRECTORY; + for (my $i = 0; $i < $MAXTRIES; $i++) { + last if ! -f ($filename = sprintf("\%s${SL}CGItemp%d", $TMPDIRECTORY, $sequence++)); + } + # check that it is a more-or-less valid filename + # Note this same regex is also used elsewhere in the same file for Fh::new + return unless $filename =~ m!^([a-zA-Z0-9_ \'\":/.\$\\\+-]+)$!; + # this used to untaint, now it doesn't + # $filename = $1; + return bless \$filename; +} +END_OF_FUNC + +'as_string' => <<'END_OF_FUNC' +sub as_string { + my($self) = @_; + return $$self; +} +END_OF_FUNC + +); +END_OF_AUTOLOAD + +package CGI; + +# We get a whole bunch of warnings about "possibly uninitialized variables" +# when running with the -w switch. Touch them all once to get rid of the +# warnings. This is ugly and I hate it. +if ($^W) { + $CGI::CGI = ''; + $CGI::CGI=<new; + + # Process an HTTP request + @values = $q->param('form_field'); + + $fh = $q->upload('file_field'); + + $riddle = $query->cookie('riddle_name'); + %answers = $query->cookie('answers'); + + # Prepare various HTTP responses + print $q->header(); + print $q->header('application/json'); + + $cookie1 = $q->cookie(-name=>'riddle_name', -value=>"The Sphynx's Question"); + $cookie2 = $q->cookie(-name=>'answers', -value=>\%answers); + print $q->header( + -type => 'image/gif', + -expires => '+3d', + -cookie => [$cookie1,$cookie2] + ); + + print $q->redirect('http://somewhere.else/in/movie/land'); + +=head1 DESCRIPTION + +CGI.pm is a stable, complete and mature solution for processing and preparing +HTTP requests and responses. Major features including processing form +submissions, file uploads, reading and writing cookies, query string generation +and manipulation, and processing and preparing HTTP headers. Some HTML +generation utilities are included as well. + +CGI.pm performs very well in in a vanilla CGI.pm environment and also comes +with built-in support for mod_perl and mod_perl2 as well as FastCGI. + +It has the benefit of having developed and refined over 10 years with input +from dozens of contributors and being deployed on thousands of websites. +CGI.pm has been included in the Perl distribution since Perl 5.4, and has +become a de-facto standard. + +=head2 PROGRAMMING STYLE + +There are two styles of programming with CGI.pm, an object-oriented +style and a function-oriented style. In the object-oriented style you +create one or more CGI objects and then use object methods to create +the various elements of the page. Each CGI object starts out with the +list of named parameters that were passed to your CGI script by the +server. You can modify the objects, save them to a file or database +and recreate them. Because each object corresponds to the "state" of +the CGI script, and because each object's parameter list is +independent of the others, this allows you to save the state of the +script and restore it later. + +For example, using the object oriented style, here is how you create +a simple "Hello World" HTML page: + + #!/usr/local/bin/perl -w + use CGI; # load CGI routines + $q = CGI->new; # create new CGI object + print $q->header, # create the HTTP header + $q->start_html('hello world'), # start the HTML + $q->h1('hello world'), # level 1 header + $q->end_html; # end the HTML + +In the function-oriented style, there is one default CGI object that +you rarely deal with directly. Instead you just call functions to +retrieve CGI parameters, create HTML tags, manage cookies, and so +on. This provides you with a cleaner programming interface, but +limits you to using one CGI object at a time. The following example +prints the same page, but uses the function-oriented interface. +The main differences are that we now need to import a set of functions +into our name space (usually the "standard" functions), and we don't +need to create the CGI object. + + #!/usr/local/bin/perl + use CGI qw/:standard/; # load standard CGI routines + print header, # create the HTTP header + start_html('hello world'), # start the HTML + h1('hello world'), # level 1 header + end_html; # end the HTML + +The examples in this document mainly use the object-oriented style. +See HOW TO IMPORT FUNCTIONS for important information on +function-oriented programming in CGI.pm + +=head2 CALLING CGI.PM ROUTINES + +Most CGI.pm routines accept several arguments, sometimes as many as 20 +optional ones! To simplify this interface, all routines use a named +argument calling style that looks like this: + + print $q->header(-type=>'image/gif',-expires=>'+3d'); + +Each argument name is preceded by a dash. Neither case nor order +matters in the argument list. -type, -Type, and -TYPE are all +acceptable. In fact, only the first argument needs to begin with a +dash. If a dash is present in the first argument, CGI.pm assumes +dashes for the subsequent ones. + +Several routines are commonly called with just one argument. In the +case of these routines you can provide the single argument without an +argument name. header() happens to be one of these routines. In this +case, the single argument is the document type. + + print $q->header('text/html'); + +Other such routines are documented below. + +Sometimes named arguments expect a scalar, sometimes a reference to an +array, and sometimes a reference to a hash. Often, you can pass any +type of argument and the routine will do whatever is most appropriate. +For example, the param() routine is used to set a CGI parameter to a +single or a multi-valued value. The two cases are shown below: + + $q->param(-name=>'veggie',-value=>'tomato'); + $q->param(-name=>'veggie',-value=>['tomato','tomahto','potato','potahto']); + +A large number of routines in CGI.pm actually aren't specifically +defined in the module, but are generated automatically as needed. +These are the "HTML shortcuts," routines that generate HTML tags for +use in dynamically-generated pages. HTML tags have both attributes +(the attribute="value" pairs within the tag itself) and contents (the +part between the opening and closing pairs.) To distinguish between +attributes and contents, CGI.pm uses the convention of passing HTML +attributes as a hash reference as the first argument, and the +contents, if any, as any subsequent arguments. It works out like +this: + + Code Generated HTML + ---- -------------- + h1()

    + h1('some','contents');

    some contents

    + h1({-align=>left});

    + h1({-align=>left},'contents');

    contents

    + +HTML tags are described in more detail later. + +Many newcomers to CGI.pm are puzzled by the difference between the +calling conventions for the HTML shortcuts, which require curly braces +around the HTML tag attributes, and the calling conventions for other +routines, which manage to generate attributes without the curly +brackets. Don't be confused. As a convenience the curly braces are +optional in all but the HTML shortcuts. If you like, you can use +curly braces when calling any routine that takes named arguments. For +example: + + print $q->header( {-type=>'image/gif',-expires=>'+3d'} ); + +If you use the B<-w> switch, you will be warned that some CGI.pm argument +names conflict with built-in Perl functions. The most frequent of +these is the -values argument, used to create multi-valued menus, +radio button clusters and the like. To get around this warning, you +have several choices: + +=over 4 + +=item 1. + +Use another name for the argument, if one is available. +For example, -value is an alias for -values. + +=item 2. + +Change the capitalization, e.g. -Values + +=item 3. + +Put quotes around the argument name, e.g. '-values' + +=back + +Many routines will do something useful with a named argument that it +doesn't recognize. For example, you can produce non-standard HTTP +header fields by providing them as named arguments: + + print $q->header(-type => 'text/html', + -cost => 'Three smackers', + -annoyance_level => 'high', + -complaints_to => 'bit bucket'); + +This will produce the following nonstandard HTTP header: + + HTTP/1.0 200 OK + Cost: Three smackers + Annoyance-level: high + Complaints-to: bit bucket + Content-type: text/html + +Notice the way that underscores are translated automatically into +hyphens. HTML-generating routines perform a different type of +translation. + +This feature allows you to keep up with the rapidly changing HTTP and +HTML "standards". + +=head2 CREATING A NEW QUERY OBJECT (OBJECT-ORIENTED STYLE): + + $query = CGI->new; + +This will parse the input (from both POST and GET methods) and store +it into a perl5 object called $query. + +Any filehandles from file uploads will have their position reset to +the beginning of the file. + +=head2 CREATING A NEW QUERY OBJECT FROM AN INPUT FILE + + $query = CGI->new(INPUTFILE); + +If you provide a file handle to the new() method, it will read +parameters from the file (or STDIN, or whatever). The file can be in +any of the forms describing below under debugging (i.e. a series of +newline delimited TAG=VALUE pairs will work). Conveniently, this type +of file is created by the save() method (see below). Multiple records +can be saved and restored. + +Perl purists will be pleased to know that this syntax accepts +references to file handles, or even references to filehandle globs, +which is the "official" way to pass a filehandle: + + $query = CGI->new(\*STDIN); + +You can also initialize the CGI object with a FileHandle or IO::File +object. + +If you are using the function-oriented interface and want to +initialize CGI state from a file handle, the way to do this is with +B. This will (re)initialize the +default CGI object from the indicated file handle. + + open (IN,"test.in") || die; + restore_parameters(IN); + close IN; + +You can also initialize the query object from a hash +reference: + + $query = CGI->new( {'dinosaur'=>'barney', + 'song'=>'I love you', + 'friends'=>[qw/Jessica George Nancy/]} + ); + +or from a properly formatted, URL-escaped query string: + + $query = CGI->new('dinosaur=barney&color=purple'); + +or from a previously existing CGI object (currently this clones the +parameter list, but none of the other object-specific fields, such as +autoescaping): + + $old_query = CGI->new; + $new_query = CGI->new($old_query); + +To create an empty query, initialize it from an empty string or hash: + + $empty_query = CGI->new(""); + + -or- + + $empty_query = CGI->new({}); + +=head2 FETCHING A LIST OF KEYWORDS FROM THE QUERY: + + @keywords = $query->keywords + +If the script was invoked as the result of an search, the +parsed keywords can be obtained as an array using the keywords() method. + +=head2 FETCHING THE NAMES OF ALL THE PARAMETERS PASSED TO YOUR SCRIPT: + + @names = $query->param + +If the script was invoked with a parameter list +(e.g. "name1=value1&name2=value2&name3=value3"), the param() method +will return the parameter names as a list. If the script was invoked +as an script and contains a string without ampersands +(e.g. "value1+value2+value3") , there will be a single parameter named +"keywords" containing the "+"-delimited keywords. + +NOTE: As of version 1.5, the array of parameter names returned will +be in the same order as they were submitted by the browser. +Usually this order is the same as the order in which the +parameters are defined in the form (however, this isn't part +of the spec, and so isn't guaranteed). + +=head2 FETCHING THE VALUE OR VALUES OF A SINGLE NAMED PARAMETER: + + @values = $query->param('foo'); + + -or- + + $value = $query->param('foo'); + +Pass the param() method a single argument to fetch the value of the +named parameter. If the parameter is multivalued (e.g. from multiple +selections in a scrolling list), you can ask to receive an array. Otherwise +the method will return a single value. + +If a value is not given in the query string, as in the queries +"name1=&name2=", it will be returned as an empty string. + + +If the parameter does not exist at all, then param() will return undef +in a scalar context, and the empty list in a list context. + + +=head2 SETTING THE VALUE(S) OF A NAMED PARAMETER: + + $query->param('foo','an','array','of','values'); + +This sets the value for the named parameter 'foo' to an array of +values. This is one way to change the value of a field AFTER +the script has been invoked once before. (Another way is with +the -override parameter accepted by all methods that generate +form elements.) + +param() also recognizes a named parameter style of calling described +in more detail later: + + $query->param(-name=>'foo',-values=>['an','array','of','values']); + + -or- + + $query->param(-name=>'foo',-value=>'the value'); + +=head2 APPENDING ADDITIONAL VALUES TO A NAMED PARAMETER: + + $query->append(-name=>'foo',-values=>['yet','more','values']); + +This adds a value or list of values to the named parameter. The +values are appended to the end of the parameter if it already exists. +Otherwise the parameter is created. Note that this method only +recognizes the named argument calling syntax. + +=head2 IMPORTING ALL PARAMETERS INTO A NAMESPACE: + + $query->import_names('R'); + +This creates a series of variables in the 'R' namespace. For example, +$R::foo, @R:foo. For keyword lists, a variable @R::keywords will appear. +If no namespace is given, this method will assume 'Q'. +WARNING: don't import anything into 'main'; this is a major security +risk!!!! + +NOTE 1: Variable names are transformed as necessary into legal Perl +variable names. All non-legal characters are transformed into +underscores. If you need to keep the original names, you should use +the param() method instead to access CGI variables by name. + +NOTE 2: In older versions, this method was called B. As of version 2.20, +this name has been removed completely to avoid conflict with the built-in +Perl module B operator. + +=head2 DELETING A PARAMETER COMPLETELY: + + $query->delete('foo','bar','baz'); + +This completely clears a list of parameters. It sometimes useful for +resetting parameters that you don't want passed down between script +invocations. + +If you are using the function call interface, use "Delete()" instead +to avoid conflicts with Perl's built-in delete operator. + +=head2 DELETING ALL PARAMETERS: + + $query->delete_all(); + +This clears the CGI object completely. It might be useful to ensure +that all the defaults are taken when you create a fill-out form. + +Use Delete_all() instead if you are using the function call interface. + +=head2 HANDLING NON-URLENCODED ARGUMENTS + + +If POSTed data is not of type application/x-www-form-urlencoded or +multipart/form-data, then the POSTed data will not be processed, but +instead be returned as-is in a parameter named POSTDATA. To retrieve +it, use code like this: + + my $data = $query->param('POSTDATA'); + +Likewise if PUTed data can be retrieved with code like this: + + my $data = $query->param('PUTDATA'); + +(If you don't know what the preceding means, don't worry about it. It +only affects people trying to use CGI for XML processing and other +specialized tasks.) + + +=head2 DIRECT ACCESS TO THE PARAMETER LIST: + + $q->param_fetch('address')->[1] = '1313 Mockingbird Lane'; + unshift @{$q->param_fetch(-name=>'address')},'George Munster'; + +If you need access to the parameter list in a way that isn't covered +by the methods above, you can obtain a direct reference to it by +calling the B method with the name of the . This +will return an array reference to the named parameters, which you then +can manipulate in any way you like. + +You can also use a named argument style using the B<-name> argument. + +=head2 FETCHING THE PARAMETER LIST AS A HASH: + + $params = $q->Vars; + print $params->{'address'}; + @foo = split("\0",$params->{'foo'}); + %params = $q->Vars; + + use CGI ':cgi-lib'; + $params = Vars; + +Many people want to fetch the entire parameter list as a hash in which +the keys are the names of the CGI parameters, and the values are the +parameters' values. The Vars() method does this. Called in a scalar +context, it returns the parameter list as a tied hash reference. +Changing a key changes the value of the parameter in the underlying +CGI parameter list. Called in a list context, it returns the +parameter list as an ordinary hash. This allows you to read the +contents of the parameter list, but not to change it. + +When using this, the thing you must watch out for are multivalued CGI +parameters. Because a hash cannot distinguish between scalar and +list context, multivalued parameters will be returned as a packed +string, separated by the "\0" (null) character. You must split this +packed string in order to get at the individual values. This is the +convention introduced long ago by Steve Brenner in his cgi-lib.pl +module for Perl version 4. + +If you wish to use Vars() as a function, import the I<:cgi-lib> set of +function calls (also see the section on CGI-LIB compatibility). + +=head2 SAVING THE STATE OF THE SCRIPT TO A FILE: + + $query->save(\*FILEHANDLE) + +This will write the current state of the form to the provided +filehandle. You can read it back in by providing a filehandle +to the new() method. Note that the filehandle can be a file, a pipe, +or whatever! + +The format of the saved file is: + + NAME1=VALUE1 + NAME1=VALUE1' + NAME2=VALUE2 + NAME3=VALUE3 + = + +Both name and value are URL escaped. Multi-valued CGI parameters are +represented as repeated names. A session record is delimited by a +single = symbol. You can write out multiple records and read them +back in with several calls to B. You can do this across several +sessions by opening the file in append mode, allowing you to create +primitive guest books, or to keep a history of users' queries. Here's +a short example of creating multiple session records: + + use CGI; + + open (OUT,'>>','test.out') || die; + $records = 5; + for (0..$records) { + my $q = CGI->new; + $q->param(-name=>'counter',-value=>$_); + $q->save(\*OUT); + } + close OUT; + + # reopen for reading + open (IN,'<','test.out') || die; + while (!eof(IN)) { + my $q = CGI->new(\*IN); + print $q->param('counter'),"\n"; + } + +The file format used for save/restore is identical to that used by the +Whitehead Genome Center's data exchange format "Boulderio", and can be +manipulated and even databased using Boulderio utilities. See + + http://stein.cshl.org/boulder/ + +for further details. + +If you wish to use this method from the function-oriented (non-OO) +interface, the exported name for this method is B. + +=head2 RETRIEVING CGI ERRORS + +Errors can occur while processing user input, particularly when +processing uploaded files. When these errors occur, CGI will stop +processing and return an empty parameter list. You can test for +the existence and nature of errors using the I function. +The error messages are formatted as HTTP status codes. You can either +incorporate the error text into an HTML page, or use it as the value +of the HTTP status: + + my $error = $q->cgi_error; + if ($error) { + print $q->header(-status=>$error), + $q->start_html('Problems'), + $q->h2('Request not processed'), + $q->strong($error); + exit 0; + } + +When using the function-oriented interface (see the next section), +errors may only occur the first time you call I. Be ready +for this! + +=head2 USING THE FUNCTION-ORIENTED INTERFACE + +To use the function-oriented interface, you must specify which CGI.pm +routines or sets of routines to import into your script's namespace. +There is a small overhead associated with this importation, but it +isn't much. + + use CGI ; + +The listed methods will be imported into the current package; you can +call them directly without creating a CGI object first. This example +shows how to import the B and B +methods, and then use them directly: + + use CGI 'param','header'; + print header('text/plain'); + $zipcode = param('zipcode'); + +More frequently, you'll import common sets of functions by referring +to the groups by name. All function sets are preceded with a ":" +character as in ":html3" (for tags defined in the HTML 3 standard). + +Here is a list of the function sets you can import: + +=over 4 + +=item B<:cgi> + +Import all CGI-handling methods, such as B, B +and the like. + +=item B<:form> + +Import all fill-out form generating methods, such as B. + +=item B<:html2> + +Import all methods that generate HTML 2.0 standard elements. + +=item B<:html3> + +Import all methods that generate HTML 3.0 elements (such as +, and ). + +=item B<:html4> + +Import all methods that generate HTML 4 elements (such as +, and ). + +=item B<:netscape> + +Import the , and
    tags. + +=item B<:html> + +Import all HTML-generating shortcuts (i.e. 'html2', 'html3', 'html4' and 'netscape') + +=item B<:standard> + +Import "standard" features, 'html2', 'html3', 'html4', 'form' and 'cgi'. + +=item B<:all> + +Import all the available methods. For the full list, see the CGI.pm +code, where the variable %EXPORT_TAGS is defined. + +=back + +If you import a function name that is not part of CGI.pm, the module +will treat it as a new HTML tag and generate the appropriate +subroutine. You can then use it like any other HTML tag. This is to +provide for the rapidly-evolving HTML "standard." For example, say +Microsoft comes out with a new tag called (which causes the +user's desktop to be flooded with a rotating gradient fill until his +machine reboots). You don't need to wait for a new version of CGI.pm +to start using it immediately: + + use CGI qw/:standard :html3 gradient/; + print gradient({-start=>'red',-end=>'blue'}); + +Note that in the interests of execution speed CGI.pm does B use +the standard L syntax for specifying load symbols. This may +change in the future. + +If you import any of the state-maintaining CGI or form-generating +methods, a default CGI object will be created and initialized +automatically the first time you use any of the methods that require +one to be present. This includes B, B, +B and the like. (If you need direct access to the CGI +object, you can find it in the global variable B<$CGI::Q>). By +importing CGI.pm methods, you can create visually elegant scripts: + + use CGI qw/:standard/; + print + header, + start_html('Simple Script'), + h1('Simple Script'), + start_form, + "What's your name? ",textfield('name'),p, + "What's the combination?", + checkbox_group(-name=>'words', + -values=>['eenie','meenie','minie','moe'], + -defaults=>['eenie','moe']),p, + "What's your favorite color?", + popup_menu(-name=>'color', + -values=>['red','green','blue','chartreuse']),p, + submit, + end_form, + hr,"\n"; + + if (param) { + print + "Your name is ",em(param('name')),p, + "The keywords are: ",em(join(", ",param('words'))),p, + "Your favorite color is ",em(param('color')),".\n"; + } + print end_html; + +=head2 PRAGMAS + +In addition to the function sets, there are a number of pragmas that +you can import. Pragmas, which are always preceded by a hyphen, +change the way that CGI.pm functions in various ways. Pragmas, +function sets, and individual functions can all be imported in the +same use() line. For example, the following use statement imports the +standard set of functions and enables debugging mode (pragma +-debug): + + use CGI qw/:standard -debug/; + +The current list of pragmas is as follows: + +=over 4 + +=item -any + +When you I, then any method that the query object +doesn't recognize will be interpreted as a new HTML tag. This allows +you to support the next I HTML +extension. This lets you go wild with new and unsupported tags: + + use CGI qw(-any); + $q=CGI->new; + print $q->gradient({speed=>'fast',start=>'red',end=>'blue'}); + +Since using any causes any mistyped method name +to be interpreted as an HTML tag, use it with care or not at +all. + +=item -compile + +This causes the indicated autoloaded methods to be compiled up front, +rather than deferred to later. This is useful for scripts that run +for an extended period of time under FastCGI or mod_perl, and for +those destined to be crunched by Malcolm Beattie's Perl compiler. Use +it in conjunction with the methods or method families you plan to use. + + use CGI qw(-compile :standard :html3); + +or even + + use CGI qw(-compile :all); + +Note that using the -compile pragma in this way will always have +the effect of importing the compiled functions into the current +namespace. If you want to compile without importing use the +compile() method instead: + + use CGI(); + CGI->compile(); + +This is particularly useful in a mod_perl environment, in which you +might want to precompile all CGI routines in a startup script, and +then import the functions individually in each mod_perl script. + +=item -nosticky + +By default the CGI module implements a state-preserving behavior +called "sticky" fields. The way this works is that if you are +regenerating a form, the methods that generate the form field values +will interrogate param() to see if similarly-named parameters are +present in the query string. If they find a like-named parameter, they +will use it to set their default values. + +Sometimes this isn't what you want. The B<-nosticky> pragma prevents +this behavior. You can also selectively change the sticky behavior in +each element that you generate. + +=item -tabindex + +Automatically add tab index attributes to each form field. With this +option turned off, you can still add tab indexes manually by passing a +-tabindex option to each field-generating method. + +=item -no_undef_params + +This keeps CGI.pm from including undef params in the parameter list. + +=item -no_xhtml + +By default, CGI.pm versions 2.69 and higher emit XHTML +(http://www.w3.org/TR/xhtml1/). The -no_xhtml pragma disables this +feature. Thanks to Michalis Kabrianis for this +feature. + +If start_html()'s -dtd parameter specifies an HTML 2.0, +3.2, 4.0 or 4.01 DTD, +XHTML will automatically be disabled without needing to use this +pragma. + +=item -utf8 + +This makes CGI.pm treat all parameters as UTF-8 strings. Use this with +care, as it will interfere with the processing of binary uploads. It +is better to manually select which fields are expected to return utf-8 +strings and convert them using code like this: + + use Encode; + my $arg = decode utf8=>param('foo'); + +=item -nph + +This makes CGI.pm produce a header appropriate for an NPH (no +parsed header) script. You may need to do other things as well +to tell the server that the script is NPH. See the discussion +of NPH scripts below. + +=item -newstyle_urls + +Separate the name=value pairs in CGI parameter query strings with +semicolons rather than ampersands. For example: + + ?name=fred;age=24;favorite_color=3 + +Semicolon-delimited query strings are always accepted, and will be emitted by +self_url() and query_string(). newstyle_urls became the default in version +2.64. + +=item -oldstyle_urls + +Separate the name=value pairs in CGI parameter query strings with +ampersands rather than semicolons. This is no longer the default. + +=item -autoload + +This overrides the autoloader so that any function in your program +that is not recognized is referred to CGI.pm for possible evaluation. +This allows you to use all the CGI.pm functions without adding them to +your symbol table, which is of concern for mod_perl users who are +worried about memory consumption. I when +I<-autoload> is in effect, you cannot use "poetry mode" +(functions without the parenthesis). Use I rather +than I
    , or add something like I +to the top of your script. + +=item -no_debug + +This turns off the command-line processing features. If you want to +run a CGI.pm script from the command line to produce HTML, and you +don't want it to read CGI parameters from the command line or STDIN, +then use this pragma: + + use CGI qw(-no_debug :standard); + +=item -debug + +This turns on full debugging. In addition to reading CGI arguments +from the command-line processing, CGI.pm will pause and try to read +arguments from STDIN, producing the message "(offline mode: enter +name=value pairs on standard input)" features. + +See the section on debugging for more details. + +=item -private_tempfiles + +CGI.pm can process uploaded file. Ordinarily it spools the uploaded +file to a temporary directory, then deletes the file when done. +However, this opens the risk of eavesdropping as described in the file +upload section. Another CGI script author could peek at this data +during the upload, even if it is confidential information. On Unix +systems, the -private_tempfiles pragma will cause the temporary file +to be unlinked as soon as it is opened and before any data is written +into it, reducing, but not eliminating the risk of eavesdropping +(there is still a potential race condition). To make life harder for +the attacker, the program chooses tempfile names by calculating a 32 +bit checksum of the incoming HTTP headers. + +To ensure that the temporary file cannot be read by other CGI scripts, +use suEXEC or a CGI wrapper program to run your script. The temporary +file is created with mode 0600 (neither world nor group readable). + +The temporary directory is selected using the following algorithm: + + 1. if the current user (e.g. "nobody") has a directory named + "tmp" in its home directory, use that (Unix systems only). + + 2. if the environment variable TMPDIR exists, use the location + indicated. + + 3. Otherwise try the locations /usr/tmp, /var/tmp, C:\temp, + /tmp, /temp, ::Temporary Items, and \WWW_ROOT. + +Each of these locations is checked that it is a directory and is +writable. If not, the algorithm tries the next choice. + +=back + +=head2 SPECIAL FORMS FOR IMPORTING HTML-TAG FUNCTIONS + +Many of the methods generate HTML tags. As described below, tag +functions automatically generate both the opening and closing tags. +For example: + + print h1('Level 1 Header'); + +produces + +

    Level 1 Header

    + +There will be some times when you want to produce the start and end +tags yourself. In this case, you can use the form start_I +and end_I, as in: + + print start_h1,'Level 1 Header',end_h1; + +With a few exceptions (described below), start_I and +end_I functions are not generated automatically when you +I. However, you can specify the tags you want to generate +I functions for by putting an asterisk in front of their +name, or, alternatively, requesting either "start_I" or +"end_I" in the import list. + +Example: + + use CGI qw/:standard *table start_ul/; + +In this example, the following functions are generated in addition to +the standard ones: + +=over 4 + +=item 1. start_table() (generates a
    tag) + +=item 2. end_table() (generates a
    tag) + +=item 3. start_ul() (generates a
      tag) + +=item 4. end_ul() (generates a
    tag) + +=back + +=head1 GENERATING DYNAMIC DOCUMENTS + +Most of CGI.pm's functions deal with creating documents on the fly. +Generally you will produce the HTTP header first, followed by the +document itself. CGI.pm provides functions for generating HTTP +headers of various types as well as for generating HTML. For creating +GIF images, see the GD.pm module. + +Each of these functions produces a fragment of HTML or HTTP which you +can print out directly so that it displays in the browser window, +append to a string, or save to a file for later use. + +=head2 CREATING A STANDARD HTTP HEADER: + +Normally the first thing you will do in any CGI script is print out an +HTTP header. This tells the browser what type of document to expect, +and gives other optional information, such as the language, expiration +date, and whether to cache the document. The header can also be +manipulated for special purposes, such as server push and pay per view +pages. + + print header; + + -or- + + print header('image/gif'); + + -or- + + print header('text/html','204 No response'); + + -or- + + print header(-type=>'image/gif', + -nph=>1, + -status=>'402 Payment required', + -expires=>'+3d', + -cookie=>$cookie, + -charset=>'utf-7', + -attachment=>'foo.gif', + -Cost=>'$2.00'); + +header() returns the Content-type: header. You can provide your own +MIME type if you choose, otherwise it defaults to text/html. An +optional second parameter specifies the status code and a human-readable +message. For example, you can specify 204, "No response" to create a +script that tells the browser to do nothing at all. + +The last example shows the named argument style for passing arguments +to the CGI methods using named parameters. Recognized parameters are +B<-type>, B<-status>, B<-expires>, and B<-cookie>. Any other named +parameters will be stripped of their initial hyphens and turned into +header fields, allowing you to specify any HTTP header you desire. +Internal underscores will be turned into hyphens: + + print header(-Content_length=>3002); + +Most browsers will not cache the output from CGI scripts. Every time +the browser reloads the page, the script is invoked anew. You can +change this behavior with the B<-expires> parameter. When you specify +an absolute or relative expiration interval with this parameter, some +browsers and proxy servers will cache the script's output until the +indicated expiration date. The following forms are all valid for the +-expires field: + + +30s 30 seconds from now + +10m ten minutes from now + +1h one hour from now + -1d yesterday (i.e. "ASAP!") + now immediately + +3M in three months + +10y in ten years time + Thursday, 25-Apr-1999 00:40:33 GMT at the indicated time & date + +The B<-cookie> parameter generates a header that tells the browser to provide +a "magic cookie" during all subsequent transactions with your script. +Some cookies have a special format that includes interesting attributes +such as expiration time. Use the cookie() method to create and retrieve +session cookies. + +The B<-nph> parameter, if set to a true value, will issue the correct +headers to work with a NPH (no-parse-header) script. This is important +to use with certain servers that expect all their scripts to be NPH. + +The B<-charset> parameter can be used to control the character set +sent to the browser. If not provided, defaults to ISO-8859-1. As a +side effect, this sets the charset() method as well. + +The B<-attachment> parameter can be used to turn the page into an +attachment. Instead of displaying the page, some browsers will prompt +the user to save it to disk. The value of the argument is the +suggested name for the saved file. In order for this to work, you may +have to set the B<-type> to "application/octet-stream". + +The B<-p3p> parameter will add a P3P tag to the outgoing header. The +parameter can be an arrayref or a space-delimited string of P3P tags. +For example: + + print header(-p3p=>[qw(CAO DSP LAW CURa)]); + print header(-p3p=>'CAO DSP LAW CURa'); + +In either case, the outgoing header will be formatted as: + + P3P: policyref="/w3c/p3p.xml" cp="CAO DSP LAW CURa" + +Note that if a header value contains a carriage return, a leading space will be +added to each new line that doesn't already have one as specified by RFC2616 +section 4.2. For example: + + print header( -ingredients => "ham\neggs\nbacon" ); + +will generate + + Ingredients: ham + eggs + bacon + +=head2 GENERATING A REDIRECTION HEADER + + print $q->redirect('http://somewhere.else/in/movie/land'); + +Sometimes you don't want to produce a document yourself, but simply +redirect the browser elsewhere, perhaps choosing a URL based on the +time of day or the identity of the user. + +The redirect() method redirects the browser to a different URL. If +you use redirection like this, you should B print out a header as +well. + +You should always use full URLs (including the http: or ftp: part) in +redirection requests. Relative URLs will not work correctly. + +You can also use named arguments: + + print $q->redirect( + -uri=>'http://somewhere.else/in/movie/land', + -nph=>1, + -status=>301); + +All names arguments recognized by header() are also recognized by +redirect(). However, most HTTP headers, including those generated by +-cookie and -target, are ignored by the browser. + +The B<-nph> parameter, if set to a true value, will issue the correct +headers to work with a NPH (no-parse-header) script. This is important +to use with certain servers, such as Microsoft IIS, which +expect all their scripts to be NPH. + +The B<-status> parameter will set the status of the redirect. HTTP +defines three different possible redirection status codes: + + 301 Moved Permanently + 302 Found + 303 See Other + +The default if not specified is 302, which means "moved temporarily." +You may change the status to another status code if you wish. Be +advised that changing the status to anything other than 301, 302 or +303 will probably break redirection. + +=head2 CREATING THE HTML DOCUMENT HEADER + + print start_html(-title=>'Secrets of the Pyramids', + -author=>'fred@capricorn.org', + -base=>'true', + -target=>'_blank', + -meta=>{'keywords'=>'pharaoh secret mummy', + 'copyright'=>'copyright 1996 King Tut'}, + -style=>{'src'=>'/styles/style1.css'}, + -BGCOLOR=>'blue'); + +After creating the HTTP header, most CGI scripts will start writing +out an HTML document. The start_html() routine creates the top of the +page, along with a lot of optional information that controls the +page's appearance and behavior. + +This method returns a canned HTML header and the opening tag. +All parameters are optional. In the named parameter form, recognized +parameters are -title, -author, -base, -xbase, -dtd, -lang and -target +(see below for the explanation). Any additional parameters you +provide, such as the unofficial BGCOLOR attribute, are added +to the tag. Additional parameters must be proceeded by a +hyphen. + +The argument B<-xbase> allows you to provide an HREF for the tag +different from the current location, as in + + -xbase=>"http://home.mcom.com/" + +All relative links will be interpreted relative to this tag. + +The argument B<-target> allows you to provide a default target frame +for all the links and fill-out forms on the page. B + + -target=>"answer_window" + +All relative links will be interpreted relative to this tag. +You add arbitrary meta information to the header with the B<-meta> +argument. This argument expects a reference to a hash +containing name/value pairs of meta information. These will be turned +into a series of header tags that look something like this: + + + + +To create an HTTP-EQUIV type of tag, use B<-head>, described +below. + +The B<-style> argument is used to incorporate cascading stylesheets +into your code. See the section on CASCADING STYLESHEETS for more +information. + +The B<-lang> argument is used to incorporate a language attribute into +the tag. For example: + + print $q->start_html(-lang=>'fr-CA'); + +The default if not specified is "en-US" for US English, unless the +-dtd parameter specifies an HTML 2.0 or 3.2 DTD, in which case the +lang attribute is left off. You can force the lang attribute to left +off in other cases by passing an empty string (-lang=>''). + +The B<-encoding> argument can be used to specify the character set for +XHTML. It defaults to iso-8859-1 if not specified. + +The B<-declare_xml> argument, when used in conjunction with XHTML, +will put a declaration at the top of the HTML header. The sole +purpose of this declaration is to declare the character set +encoding. In the absence of -declare_xml, the output HTML will contain +a tag that specifies the encoding, allowing the HTML to pass +most validators. The default for -declare_xml is false. + +You can place other arbitrary HTML elements to the section with the +B<-head> tag. For example, to place the rarely-used element in the +head section, use this: + + print start_html(-head=>Link({-rel=>'next', + -href=>'http://www.capricorn.com/s2.html'})); + +To incorporate multiple HTML elements into the section, just pass an +array reference: + + print start_html(-head=>[ + Link({-rel=>'next', + -href=>'http://www.capricorn.com/s2.html'}), + Link({-rel=>'previous', + -href=>'http://www.capricorn.com/s1.html'}) + ] + ); + +And here's how to create an HTTP-EQUIV tag: + + print start_html(-head=>meta({-http_equiv => 'Content-Type', + -content => 'text/html'})) + + +JAVASCRIPTING: The B<-script>, B<-noScript>, B<-onLoad>, +B<-onMouseOver>, B<-onMouseOut> and B<-onUnload> parameters are used +to add JavaScript calls to your pages. B<-script> should +point to a block of text containing JavaScript function definitions. +This block will be placed within a