_borders/0000755002157400001440000000000010103774561017264 5ustar minnesotaviolasociety.orgusers00000000000000_borders/_vti_cnf/0000755002157400001440000000000010103774561021053 5ustar minnesotaviolasociety.orgusers00000000000000_borders/_vti_cnf/disc1_head.htm0000644002157400001440000000242510067423564023557 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|27 Jun 2004 01:40:20 -0000 vti_title:SR|Included Header for Viola Forum vti_author:SR|admin vti_modifiedby:SR|admin vti_nexttolasttimemodified:TR|27 Jun 2004 01:39:26 -0000 vti_timecreated:TR|27 Jun 2004 01:40:20 -0000 vti_extenderversion:SR|5.0.2.2623 vti_syncwith_localhost\\c\:\\documents and settings\\owner\\my documents\\my webs\\mvs maroon and white/c\:/documents and settings/owner/my documents/my webs/mvs maroon and white:TR|27 Jun 2004 01:39:26 -0000 vti_backlinkinfo:VX| vti_cacheddtm:TX|27 Jun 2004 01:40:20 -0000 vti_filesize:IR|717 vti_cachedtitle:SR|Included Header for Viola Forum vti_cachedbodystyle:SR| vti_cachedlinkinfo:VX|H|../index.html H|../disc1_frm.htm H|../disc1_srch.htm H|../disc1_post.htm vti_cachedsvcrellinks:VX|FHUS|index.html NHUS|disc1_frm.htm NHUS|disc1_srch.htm NHUS|disc1_post.htm vti_cachedneedsrewrite:BR|false vti_cachedhasbots:BR|false vti_cachedhastheme:BR|false vti_cachedhasborder:BR|false vti_metatags:VR|HTTP-EQUIV=Content-Type text/html;\\ charset=windows-1252 HTTP-EQUIV=Content-Language en-us GENERATOR Microsoft\\ FrontPage\\ 4.0 ProgId FrontPage.Editor.Document vti_charset:SR|windows-1252 vti_language:SR|en-us vti_progid:SR|FrontPage.Editor.Document vti_generator:SR|Microsoft FrontPage 4.0 _borders/_vti_cnf/disc4_head.htm0000644002157400001440000000242510103740306023545 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|03 Aug 2004 16:36:46 -0000 vti_title:SR|Included Header for Viola Forum vti_author:SR|admin vti_modifiedby:SR|admin vti_nexttolasttimemodified:TR|03 Aug 2004 16:35:22 -0000 vti_timecreated:TR|03 Aug 2004 16:36:45 -0000 vti_extenderversion:SR|5.0.2.2623 vti_syncwith_localhost\\c\:\\documents and settings\\owner\\my documents\\my webs\\mvs maroon and white/c\:/documents and settings/owner/my documents/my webs/mvs maroon and white:TR|03 Aug 2004 16:35:22 -0000 vti_backlinkinfo:VX| vti_cacheddtm:TX|03 Aug 2004 16:36:46 -0000 vti_filesize:IR|717 vti_cachedtitle:SR|Included Header for Viola Forum vti_cachedbodystyle:SR| vti_cachedlinkinfo:VX|H|../index.html H|../disc4_frm.htm H|../disc4_srch.htm H|../disc4_post.htm vti_cachedsvcrellinks:VX|FHUS|index.html NHUS|disc4_frm.htm NHUS|disc4_srch.htm NHUS|disc4_post.htm vti_cachedneedsrewrite:BR|false vti_cachedhasbots:BR|false vti_cachedhastheme:BR|false vti_cachedhasborder:BR|false vti_metatags:VR|HTTP-EQUIV=Content-Type text/html;\\ charset=windows-1252 HTTP-EQUIV=Content-Language en-us GENERATOR Microsoft\\ FrontPage\\ 4.0 ProgId FrontPage.Editor.Document vti_charset:SR|windows-1252 vti_language:SR|en-us vti_progid:SR|FrontPage.Editor.Document vti_generator:SR|Microsoft FrontPage 4.0 _borders/_vti_cnf/disc5_head.htm0000644002157400001440000000242510103774561023560 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|03 Aug 2004 16:43:49 -0000 vti_title:SR|Included Header for Viola Forum vti_author:SR|admin vti_modifiedby:SR|admin vti_nexttolasttimemodified:TR|03 Aug 2004 16:43:39 -0000 vti_timecreated:TR|03 Aug 2004 16:43:49 -0000 vti_extenderversion:SR|5.0.2.2623 vti_syncwith_localhost\\c\:\\documents and settings\\owner\\my documents\\my webs\\mvs maroon and white/c\:/documents and settings/owner/my documents/my webs/mvs maroon and white:TR|03 Aug 2004 16:43:39 -0000 vti_backlinkinfo:VX| vti_cacheddtm:TX|03 Aug 2004 16:43:49 -0000 vti_filesize:IR|717 vti_cachedtitle:SR|Included Header for Viola Forum vti_cachedbodystyle:SR| vti_cachedlinkinfo:VX|H|../index.html H|../disc5_frm.htm H|../disc5_srch.htm H|../disc5_post.htm vti_cachedsvcrellinks:VX|FHUS|index.html NHUS|disc5_frm.htm NHUS|disc5_srch.htm NHUS|disc5_post.htm vti_cachedneedsrewrite:BR|false vti_cachedhasbots:BR|false vti_cachedhastheme:BR|false vti_cachedhasborder:BR|false vti_metatags:VR|HTTP-EQUIV=Content-Type text/html;\\ charset=windows-1252 HTTP-EQUIV=Content-Language en-us GENERATOR Microsoft\\ FrontPage\\ 4.0 ProgId FrontPage.Editor.Document vti_charset:SR|windows-1252 vti_language:SR|en-us vti_progid:SR|FrontPage.Editor.Document vti_generator:SR|Microsoft FrontPage 4.0 _borders/_vti_cnf/disc6_head.htm0000644002157400001440000000242510103742070023547 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|03 Aug 2004 16:58:31 -0000 vti_title:SR|Included Header for Viola Forum vti_author:SR|admin vti_modifiedby:SR|admin vti_nexttolasttimemodified:TR|03 Aug 2004 16:52:47 -0000 vti_timecreated:TR|03 Aug 2004 16:58:31 -0000 vti_extenderversion:SR|5.0.2.2623 vti_syncwith_localhost\\c\:\\documents and settings\\owner\\my documents\\my webs\\mvs maroon and white/c\:/documents and settings/owner/my documents/my webs/mvs maroon and white:TR|03 Aug 2004 16:52:47 -0000 vti_backlinkinfo:VX| vti_cacheddtm:TX|03 Aug 2004 16:58:31 -0000 vti_filesize:IR|717 vti_cachedtitle:SR|Included Header for Viola Forum vti_cachedbodystyle:SR| vti_cachedlinkinfo:VX|H|../index.html H|../disc6_frm.htm H|../disc6_srch.htm H|../disc6_post.htm vti_cachedsvcrellinks:VX|FHUS|index.html NHUS|disc6_frm.htm NHUS|disc6_srch.htm NHUS|disc6_post.htm vti_cachedneedsrewrite:BR|false vti_cachedhasbots:BR|false vti_cachedhastheme:BR|false vti_cachedhasborder:BR|false vti_metatags:VR|HTTP-EQUIV=Content-Type text/html;\\ charset=windows-1252 HTTP-EQUIV=Content-Language en-us GENERATOR Microsoft\\ FrontPage\\ 4.0 ProgId FrontPage.Editor.Document vti_charset:SR|windows-1252 vti_language:SR|en-us vti_progid:SR|FrontPage.Editor.Document vti_generator:SR|Microsoft FrontPage 4.0 _borders/disc1_head.htm0000644002157400001440000000131510067422604021757 0ustar minnesotaviolasociety.orgusers00000000000000 Included Header for Viola Forum

Viola Forum

[ Home | Contents | Search | Post ]


_borders/disc4_head.htm0000644002157400001440000000131510103737436021765 0ustar minnesotaviolasociety.orgusers00000000000000 Included Header for Viola Forum

Viola Forum

[ Home | Contents | Search | Post ]


_borders/disc5_head.htm0000644002157400001440000000131510103740305021753 0ustar minnesotaviolasociety.orgusers00000000000000 Included Header for Viola Forum

Viola Forum

[ Home | Contents | Search | Post ]


_borders/disc6_head.htm0000644002157400001440000000131510103742067021763 0ustar minnesotaviolasociety.orgusers00000000000000 Included Header for Viola Forum

Viola Forum

[ Home | Contents | Search | Post ]


cgi-bin/0000755002157400001440000000000010366240653016776 5ustar minnesotaviolasociety.orgusers00000000000000cgi-bin/_vti_cnf/0000755002157400001440000000000010366240653020565 5ustar minnesotaviolasociety.orgusers00000000000000cgi-bin/_vti_cnf/index.html0000644002157400001440000000113107626347105022563 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|24 Feb 2003 07:48:21 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|24 Feb 2003 07:48:21 -0000 vti_filesize:IR|1133 vti_cachedtitle:SR|MOVABLE TYPE vti_cachedbodystyle:SR| vti_cachedlinkinfo:VX|H|docs/mtinstall.html vti_cachedsvcrellinks:VX|NHUS|cgi-bin/docs/mtinstall.html vti_cachedneedsrewrite:BR|false vti_cachedhasbots:BR|false vti_cachedhastheme:BR|false vti_cachedhasborder:BR|false vti_metatags:VR|HTTP-EQUIV=Content-Type text/html;\\ charset=iso-8859-1 vti_charset:SR|windows-1252 vti_title:SR|MOVABLE TYPE vti_backlinkinfo:VX| cgi-bin/_vti_cnf/LICENSE0000644002157400001440000000030307770530356021575 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|19 Dec 2003 08:03:58 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|19 Dec 2003 08:03:58 -0000 vti_filesize:IR|9261 vti_backlinkinfo:VX| cgi-bin/_vti_cnf/favicon.ico0000644002157400001440000000052510366240653022710 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_author:SR|admin vti_modifiedby:SR|admin vti_timelastmodified:TR|26 Jan 2006 21:39:55 -0000 vti_timecreated:TR|14 Jan 2006 15:05:35 -0000 vti_extenderversion:SR|5.0.2.2634 vti_nexttolasttimemodified:TR|14 Jan 2006 15:05:35 -0000 vti_cacheddtm:TX|26 Jan 2006 21:39:55 -0000 vti_filesize:IR|766 vti_backlinkinfo:VX| cgi-bin/_vti_cnf/LICENSE-COMMERCIAL0000644002157400001440000000030407770530361023203 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|19 Dec 2003 08:04:01 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|19 Dec 2003 08:04:01 -0000 vti_filesize:IR|12426 vti_backlinkinfo:VX| cgi-bin/_vti_cnf/mt-add-notify.cgi0000644002157400001440000000030207622316733023724 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|12 Feb 2003 01:05:31 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|12 Feb 2003 01:05:31 -0000 vti_filesize:IR|911 vti_backlinkinfo:VX| cgi-bin/_vti_cnf/mt-check.cgi0000644002157400001440000000030307622316733022744 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|12 Feb 2003 01:05:31 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|12 Feb 2003 01:05:31 -0000 vti_filesize:IR|4789 vti_backlinkinfo:VX| cgi-bin/_vti_cnf/mt-comments.cgi0000644002157400001440000000055310232532415023507 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|12 Feb 2003 01:05:31 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|12 Feb 2003 01:05:31 -0000 vti_filesize:IR|774 vti_backlinkinfo:VX|weblog/archives/000001.html weblog/archives/2005_04.html weblog/archives/000043.html weblog/archives/2004_01.html weblog/archives/000004.html weblog/archives/000005.html cgi-bin/_vti_cnf/mt-db-pass.cgi0000644002157400001440000000030007776361257023230 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|05 Jan 2004 22:18:23 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|05 Jan 2004 22:18:23 -0000 vti_filesize:IR|9 vti_backlinkinfo:VX| cgi-bin/_vti_cnf/mt-search.cgi0000644002157400001440000000032307622316733023136 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|12 Feb 2003 01:05:31 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|12 Feb 2003 01:05:31 -0000 vti_filesize:IR|774 vti_backlinkinfo:VX|weblog/index.html cgi-bin/_vti_cnf/mt-send-entry.cgi0000644002157400001440000000030307770464551023765 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|19 Dec 2003 02:58:49 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|19 Dec 2003 02:58:49 -0000 vti_filesize:IR|1809 vti_backlinkinfo:VX| cgi-bin/_vti_cnf/mt-tb.cgi0000644002157400001440000000030207622316733022273 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|12 Feb 2003 01:05:31 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|12 Feb 2003 01:05:31 -0000 vti_filesize:IR|771 vti_backlinkinfo:VX| cgi-bin/_vti_cnf/mt-view.cgi0000644002157400001440000000030207622316733022640 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|12 Feb 2003 01:05:31 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|12 Feb 2003 01:05:31 -0000 vti_filesize:IR|756 vti_backlinkinfo:VX| cgi-bin/_vti_cnf/mt-xmlrpc.cgi0000644002157400001440000000030207622316733023173 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|12 Feb 2003 01:05:31 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|12 Feb 2003 01:05:31 -0000 vti_filesize:IR|811 vti_backlinkinfo:VX| cgi-bin/_vti_cnf/mt.cfg0000644002157400001440000000030407776374461021703 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|05 Jan 2004 23:54:25 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|05 Jan 2004 23:54:25 -0000 vti_filesize:IR|19136 vti_backlinkinfo:VX| cgi-bin/_vti_cnf/mt.cgi0000644002157400001440000000030207622316733021670 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|12 Feb 2003 01:05:31 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|12 Feb 2003 01:05:31 -0000 vti_filesize:IR|740 vti_backlinkinfo:VX| cgi-bin/extlib/0000755002157400001440000000000007776605402020275 5ustar minnesotaviolasociety.orgusers00000000000000cgi-bin/extlib/Apache/0000755002157400001440000000000007776605372021464 5ustar minnesotaviolasociety.orgusers00000000000000cgi-bin/extlib/Apache/XMLRPC/0000755002157400001440000000000007776605372022471 5ustar minnesotaviolasociety.orgusers00000000000000cgi-bin/extlib/Apache/XMLRPC/_vti_cnf/0000755002157400001440000000000007776605372024260 5ustar minnesotaviolasociety.orgusers00000000000000cgi-bin/extlib/Apache/XMLRPC/_vti_cnf/Lite.pm0000644002157400001440000000030307771550070025474 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|22 Dec 2003 11:06:32 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|22 Dec 2003 11:06:32 -0000 vti_filesize:IR|3703 vti_backlinkinfo:VX| cgi-bin/extlib/Apache/XMLRPC/Lite.pm0000644002157400001440000000716707771550070023724 0ustar minnesotaviolasociety.orgusers00000000000000# ====================================================================== # # Copyright (C) 2000-2001 Paul Kulchenko (paulclinger@yahoo.com) # SOAP::Lite is free software; you can redistribute it # and/or modify it under the same terms as Perl itself. # # $Id: Lite.pm,v 1.3 2001/08/11 19:09:57 paulk Exp $ # # ====================================================================== package Apache::XMLRPC::Lite; use strict; use vars qw(@ISA $VERSION); use XMLRPC::Transport::HTTP; @ISA = qw(XMLRPC::Transport::HTTP::Apache); $VERSION = eval sprintf("%d.%s", q$Name: release-0_52-public $ =~ /-(\d+)_([\d_]+)/); my $server = __PACKAGE__->new; sub handler { $server->configure(@_); $server->SUPER::handler(@_); } # ====================================================================== 1; __END__ =head1 NAME Apache::XMLRPC::Lite - mod_perl-based XML-RPC server with minimum configuration =head1 SYNOPSIS =over 4 =item httpd.conf (Location), directory-based access SetHandler perl-script PerlHandler Apache::XMLRPC::Lite PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name, Module::method" PerlSetVar options "compress_threshold => 10000" =item httpd.conf (Files), file-based access SetHandler perl-script PerlHandler Apache::XMLRPC::Lite PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name, Module::method" PerlSetVar options "compress_threshold => 10000" =item .htaccess, directory-based access SetHandler perl-script PerlHandler Apache::XMLRPC::Lite PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name, Module::method" PerlSetVar options "compress_threshold => 10000" =back =head1 DESCRIPTION This Apache Perl module provides the ability to add support for XML-RPC protocol with easy configuration (either in .conf or in .htaccess file). This functionality should give you lightweight option for hosting SOAP services and greatly simplify configuration aspects. This module inherites functionality from XMLRPC::Transport::HTTP::Apache component of XMLRPC::Lite module. =head1 CONFIGURATION The module can be placed in , , , directives in main server configuration areas or directly in .htaccess file. All parameters should be quoted and can be separated with commas or spaces for lists ("a, b, c") and with 'wide arrows' and commas for hash parameters ("key1 => value1, key2 => value2"). All options that you can find in XMLRPC::Transport::HTTP::Apache component are available for configuration. Here is the description of most important ones. =over 4 =item dispatch_to (LIST) Specifies path to directory that contains Perl modules you'd like to give access to, or just list of modules (for preloaded modules). PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name, Module::method" =item options (HASH) Specifies list of options for your module, for example threshold for compression. Future versions will support more options. See XMLRPC::Transport::HTTP documentation for other options. PerlSetVar options "compress_threshold => 10000" =back =head1 DEPENDENCIES XMLRPC::Lite mod_perl =head1 SEE ALSO XMLRPC::Transport::HTTP::Apache for implementation details, XMLRPC::Lite for general information, and F for .htaccess example =head1 COPYRIGHT Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Paul Kulchenko (paulclinger@yahoo.com) =cut cgi-bin/extlib/Apache/_vti_cnf/0000755002157400001440000000000007776605372023253 5ustar minnesotaviolasociety.orgusers00000000000000cgi-bin/extlib/Apache/_vti_cnf/SOAP.pm0000644002157400001440000000030307771550070024334 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|22 Dec 2003 11:06:32 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|22 Dec 2003 11:06:32 -0000 vti_filesize:IR|3665 vti_backlinkinfo:VX| cgi-bin/extlib/Apache/SOAP.pm0000644002157400001440000000712107771550070022552 0ustar minnesotaviolasociety.orgusers00000000000000# ====================================================================== # # Copyright (C) 2000-2001 Paul Kulchenko (paulclinger@yahoo.com) # SOAP::Lite is free software; you can redistribute it # and/or modify it under the same terms as Perl itself. # # $Id: SOAP.pm,v 1.3 2001/08/11 19:09:57 paulk Exp $ # # ====================================================================== package Apache::SOAP; use strict; use vars qw(@ISA $VERSION); use SOAP::Transport::HTTP; @ISA = qw(SOAP::Transport::HTTP::Apache); $VERSION = eval sprintf("%d.%s", q$Name: release-0_52-public $ =~ /-(\d+)_([\d_]+)/); my $server = __PACKAGE__->new; sub handler { $server->configure(@_); $server->SUPER::handler(@_); } # ====================================================================== 1; __END__ =head1 NAME Apache::SOAP - mod_perl-based SOAP server with minimum configuration =head1 SYNOPSIS =over 4 =item httpd.conf (Location), directory-based access SetHandler perl-script PerlHandler Apache::SOAP PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name, Module::method" PerlSetVar options "compress_threshold => 10000" =item httpd.conf (Files), file-based access SetHandler perl-script PerlHandler Apache::SOAP PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name, Module::method" PerlSetVar options "compress_threshold => 10000" =item .htaccess, directory-based access SetHandler perl-script PerlHandler Apache::SOAP PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name, Module::method" PerlSetVar options "compress_threshold => 10000" =back =head1 DESCRIPTION This Apache Perl module provides the ability to add support for SOAP (Simple Object Access Protocol) protocol with easy configuration (either in .conf or in .htaccess file). This functionality should give you lightweight option for hosting SOAP services and greatly simplify configuration aspects. This module inherites functionality from SOAP::Transport::HTTP::Apache component of SOAP::Lite module. =head1 CONFIGURATION The module can be placed in , , , directives in main server configuration areas or directly in .htaccess file. All parameters should be quoted and can be separated with commas or spaces for lists ("a, b, c") and with 'wide arrows' and commas for hash parameters ("key1 => value1, key2 => value2"). All options that you can find in SOAP::Transport::HTTP::Apache component are available for configuration. Here is the description of most important ones. =over 4 =item dispatch_to (LIST) Specifies path to directory that contains Perl modules you'd like to give access to, or just list of modules (for preloaded modules). PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name, Module::method" =item options (HASH) Specifies list of options for your module, for example threshold for compression. Future versions will support more options. See SOAP::Transport::HTTP documentation for other options. PerlSetVar options "compress_threshold => 10000" =back =head1 DEPENDENCIES SOAP::Lite mod_perl =head1 SEE ALSO SOAP::Transport::HTTP::Apache for implementation details, SOAP::Lite for general information, and F for .htaccess example =head1 COPYRIGHT Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Paul Kulchenko (paulclinger@yahoo.com) =cut cgi-bin/extlib/CGI/0000755002157400001440000000000007776605372020705 5ustar minnesotaviolasociety.orgusers00000000000000cgi-bin/extlib/CGI/_vti_cnf/0000755002157400001440000000000007776605372022474 5ustar minnesotaviolasociety.orgusers00000000000000cgi-bin/extlib/CGI/_vti_cnf/Apache.pm0000644002157400001440000000030207771550070024173 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|22 Dec 2003 11:06:32 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|22 Dec 2003 11:06:32 -0000 vti_filesize:IR|271 vti_backlinkinfo:VX| cgi-bin/extlib/CGI/_vti_cnf/Carp.pm0000644002157400001440000000030407771550070023701 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|22 Dec 2003 11:06:32 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|22 Dec 2003 11:06:32 -0000 vti_filesize:IR|12290 vti_backlinkinfo:VX| cgi-bin/extlib/CGI/_vti_cnf/Cookie.pm0000644002157400001440000000030407771550070024225 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|22 Dec 2003 11:06:32 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|22 Dec 2003 11:06:32 -0000 vti_filesize:IR|13217 vti_backlinkinfo:VX| cgi-bin/extlib/CGI/_vti_cnf/Fast.pm0000644002157400001440000000030307771550070023710 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|22 Dec 2003 11:06:32 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|22 Dec 2003 11:06:32 -0000 vti_filesize:IR|7191 vti_backlinkinfo:VX| cgi-bin/extlib/CGI/_vti_cnf/Pretty.pm0000644002157400001440000000030307771550070024302 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|22 Dec 2003 11:06:32 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|22 Dec 2003 11:06:32 -0000 vti_filesize:IR|7017 vti_backlinkinfo:VX| cgi-bin/extlib/CGI/_vti_cnf/Push.pm0000644002157400001440000000030407771550070023733 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|22 Dec 2003 11:06:32 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|22 Dec 2003 11:06:32 -0000 vti_filesize:IR|10942 vti_backlinkinfo:VX| cgi-bin/extlib/CGI/_vti_cnf/Switch.pm0000644002157400001440000000030207771550070024253 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|22 Dec 2003 11:06:32 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|22 Dec 2003 11:06:32 -0000 vti_filesize:IR|285 vti_backlinkinfo:VX| cgi-bin/extlib/CGI/_vti_cnf/Util.pm0000644002157400001440000000030407771550070023731 0ustar minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl vti_timelastmodified:TR|22 Dec 2003 11:06:32 -0000 vti_extenderversion:SR|5.0.2.2623 vti_cacheddtm:TX|22 Dec 2003 11:06:32 -0000 vti_filesize:IR|10736 vti_backlinkinfo:VX| cgi-bin/extlib/CGI/Apache.pm0000644002157400001440000000041707771550070022413 0ustar minnesotaviolasociety.orgusers00000000000000use CGI; $VERSION = '1.00'; 1; __END__ =head1 NAME CGI::Apache - Backward compatibility module for CGI.pm =head1 SYNOPSIS Do not use this module. It is deprecated. =head1 ABSTRACT =head1 DESCRIPTION =head1 AUTHOR INFORMATION =head1 BUGS =head1 SEE ALSO =cut cgi-bin/extlib/CGI/Carp.pm0000644002157400001440000003000207771550070022110 0ustar minnesotaviolasociety.orgusers00000000000000package CGI::Carp; =head1 NAME B - CGI routines for writing to the HTTPD (or other) error log =head1 SYNOPSIS use CGI::Carp; croak "We're outta here!"; confess "It was my fault: $!"; carp "It was your fault!"; warn "I'm confused"; die "I'm dying.\n"; use CGI::Carp qw(cluck); cluck "I wouldn't do that if I were you"; use CGI::Carp qw(fatalsToBrowser); die "Fatal error messages are now sent to browser"; =head1 DESCRIPTION CGI scripts have a nasty habit of leaving warning messages in the error logs that are neither time stamped nor fully identified. Tracking down the script that caused the error is a pain. This fixes that. Replace the usual use Carp; with use CGI::Carp And the standard warn(), die (), croak(), confess() and carp() calls will automagically be replaced with functions that write out nicely time-stamped messages to the HTTP server error log. For example: [Fri Nov 17 21:40:43 1995] test.pl: I'm confused at test.pl line 3. [Fri Nov 17 21:40:43 1995] test.pl: Got an error message: Permission denied. [Fri Nov 17 21:40:43 1995] test.pl: I'm dying. =head1 REDIRECTING ERROR MESSAGES By default, error messages are sent to STDERR. Most HTTPD servers direct STDERR to the server's error log. Some applications may wish to keep private error logs, distinct from the server's error log, or they may wish to direct error messages to STDOUT so that the browser will receive them. The C function is provided for this purpose. Since carpout() is not exported by default, you must import it explicitly by saying use CGI::Carp qw(carpout); The carpout() function requires one argument, which should be a reference to an open filehandle for writing errors. It should be called in a C block at the top of the CGI application so that compiler errors will be caught. Example: BEGIN { use CGI::Carp qw(carpout); open(LOG, ">>/usr/local/cgi-logs/mycgi-log") or die("Unable to open mycgi-log: $!\n"); carpout(LOG); } carpout() does not handle file locking on the log for you at this point. The real STDERR is not closed -- it is moved to CGI::Carp::SAVEERR. Some servers, when dealing with CGI scripts, close their connection to the browser when the script closes STDOUT and STDERR. CGI::Carp::SAVEERR is there to prevent this from happening prematurely. You can pass filehandles to carpout() in a variety of ways. The "correct" way according to Tom Christiansen is to pass a reference to a filehandle GLOB: carpout(\*LOG); This looks weird to mere mortals however, so the following syntaxes are accepted as well: carpout(LOG); carpout(main::LOG); carpout(main'LOG); carpout(\LOG); carpout(\'main::LOG'); ... and so on FileHandle and other objects work as well. Use of carpout() is not great for performance, so it is recommended for debugging purposes or for moderate-use applications. A future version of this module may delay redirecting STDERR until one of the CGI::Carp methods is called to prevent the performance hit. =head1 MAKING PERL ERRORS APPEAR IN THE BROWSER WINDOW If you want to send fatal (die, confess) errors to the browser, ask to import the special "fatalsToBrowser" subroutine: use CGI::Carp qw(fatalsToBrowser); die "Bad error here"; Fatal errors will now be echoed to the browser as well as to the log. CGI::Carp arranges to send a minimal HTTP header to the browser so that even errors that occur in the early compile phase will be seen. Nonfatal errors will still be directed to the log file only (unless redirected with carpout). =head2 Changing the default message By default, the software error message is followed by a note to contact the Webmaster by e-mail with the time and date of the error. If this message is not to your liking, you can change it using the set_message() routine. This is not imported by default; you should import it on the use() line: use CGI::Carp qw(fatalsToBrowser set_message); set_message("It's not a bug, it's a feature!"); You may also pass in a code reference in order to create a custom error message. At run time, your code will be called with the text of the error message that caused the script to die. Example: use CGI::Carp qw(fatalsToBrowser set_message); BEGIN { sub handle_errors { my $msg = shift; print "

Oh gosh

"; print "Got an error: $msg"; } set_message(\&handle_errors); } In order to correctly intercept compile-time errors, you should call set_message() from within a BEGIN{} block. =head1 MAKING WARNINGS APPEAR AS HTML COMMENTS It is now also possible to make non-fatal errors appear as HTML comments embedded in the output of your program. To enable this feature, export the new "warningsToBrowser" subroutine. Since sending warnings to the browser before the HTTP headers have been sent would cause an error, any warnings are stored in an internal buffer until you call the warningsToBrowser() subroutine with a true argument: use CGI::Carp qw(fatalsToBrowser warningsToBrowser); use CGI qw(:standard); print header(); warningsToBrowser(1); You may also give a false argument to warningsToBrowser() to prevent warnings from being sent to the browser while you are printing some content where HTML comments are not allowed: warningsToBrowser(0); # disable warnings print "\n"; warningsToBrowser(1); # re-enable warnings Note: In this respect warningsToBrowser() differs fundamentally from fatalsToBrowser(), which you should never call yourself! =head1 CHANGE LOG 1.05 carpout() added and minor corrections by Marc Hedlund on 11/26/95. 1.06 fatalsToBrowser() no longer aborts for fatal errors within eval() statements. 1.08 set_message() added and carpout() expanded to allow for FileHandle objects. 1.09 set_message() now allows users to pass a code REFERENCE for really custom error messages. croak and carp are now exported by default. Thanks to Gunther Birznieks for the patches. 1.10 Patch from Chris Dean (ctdean@cogit.com) to allow module to run correctly under mod_perl. 1.11 Changed order of > and < escapes. 1.12 Changed die() on line 217 to CORE::die to avoid B<-w> warning. 1.13 Added cluck() to make the module orthogonal with Carp. More mod_perl related fixes. 1.20 Patch from Ilmari Karonen (perl@itz.pp.sci.fi): Added warningsToBrowser(). Replaced tags with
 in
     fatalsToBrowser() output.

=head1 AUTHORS

Copyright 1995-1998, Lincoln D. Stein.  All rights reserved.  

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

Address bug reports and comments to: lstein@cshl.org

=head1 SEE ALSO

Carp, CGI::Base, CGI::BasePlus, CGI::Request, CGI::MiniSvr, CGI::Form,
CGI::Response

=cut

require 5.000;
use Exporter;
use Carp;
use File::Spec;

@ISA = qw(Exporter);
@EXPORT = qw(confess croak carp);
@EXPORT_OK = qw(carpout fatalsToBrowser warningsToBrowser wrap set_message cluck);

$main::SIG{__WARN__}=\&CGI::Carp::warn;
$main::SIG{__DIE__}=\&CGI::Carp::die;
$CGI::Carp::VERSION = '1.21';
$CGI::Carp::CUSTOM_MSG = undef;

# fancy import routine detects and handles 'errorWrap' specially.
sub import {
    my $pkg = shift;
    my(%routines);
    grep($routines{$_}++,@_,@EXPORT);
    $WRAP++ if $routines{'fatalsToBrowser'} || $routines{'wrap'};
    $WARN++ if $routines{'warningsToBrowser'};
    my($oldlevel) = $Exporter::ExportLevel;
    $Exporter::ExportLevel = 1;
    Exporter::import($pkg,keys %routines);
    $Exporter::ExportLevel = $oldlevel;
}

# These are the originals
sub realwarn { CORE::warn(@_); }
sub realdie { CORE::die(@_); }

sub id {
    my $level = shift;
    my($pack,$file,$line,$sub) = caller($level);
    my($dev,$dirs,$id) = File::Spec->splitpath($file);
    return ($file,$line,$id);
}

sub stamp {
    my $time = scalar(localtime);
    my $frame = 0;
    my ($id,$pack,$file,$dev,$dirs);
    do {
	$id = $file;
	($pack,$file) = caller($frame++);
    } until !$file;
    ($dev,$dirs,$id) = File::Spec->splitpath($id);
    return "[$time] $id: ";
}

sub warn {
    my $message = shift;
    my($file,$line,$id) = id(1);
    $message .= " at $file line $line.\n" unless $message=~/\n$/;
    _warn($message) if $WARN;
    my $stamp = stamp;
    $message=~s/^/$stamp/gm;
    realwarn $message;
}

sub _warn {
    my $msg = shift;
    if ($EMIT_WARNINGS) {
	# We need to mangle the message a bit to make it a valid HTML
	# comment.  This is done by substituting similar-looking ISO
	# 8859-1 characters for <, > and -.  This is a hack.
	$msg =~ tr/<>-/\253\273\255/;
	chomp $msg;
	print STDOUT "\n";
    } else {
	push @WARNINGS, $msg;
    }
}

sub ineval { $^S }

# The mod_perl package Apache::Registry loads CGI programs by calling
# eval.  These evals don't count when looking at the stack backtrace.
sub _longmess {
    my $message = Carp::longmess();
    my $mod_perl = exists $ENV{MOD_PERL};
    $message =~ s,eval[^\n]+Apache/Registry\.pm.*,,s if $mod_perl;
    return $message;    
}

sub die {
  realdie @_ if ineval;
  my ($message) = @_;
  my $time = scalar(localtime);
  my($file,$line,$id) = id(1);
  $message .= " at $file line $line." unless $message=~/\n$/;
  &fatalsToBrowser($message) if $WRAP;
  my $stamp = stamp;
  $message=~s/^/$stamp/gm;
  realdie $message;
}

sub set_message {
    $CGI::Carp::CUSTOM_MSG = shift;
    return $CGI::Carp::CUSTOM_MSG;
}

# Avoid generating "subroutine redefined" warnings with the following
# hack:
{
    local $^W=0;
    eval <&STDERR");
    open(STDERR, ">&$no") or 
	( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) );
}

sub warningsToBrowser {
    $EMIT_WARNINGS = @_ ? shift : 1;
    _warn(shift @WARNINGS) while $EMIT_WARNINGS and @WARNINGS;
}

# headers
sub fatalsToBrowser {
    my($msg) = @_;
    $msg=~s/&/&/g;
    $msg=~s/>/>/g;
    $msg=~s/$ENV{SERVER_ADMIN})] :
	"this site's webmaster";
    my ($outer_message) = <Software error:
$msg

$outer_message END ; if ($mod_perl && (my $r = Apache->request)) { # If bytes have already been sent, then # we print the message out directly. # Otherwise we make a custom error # handler to produce the doc for us. if ($r->bytes_sent) { $r->print($mess); $r->exit; } else { $r->status(500); $r->custom_response(500,$mess); } } else { print STDOUT $mess; } } # Cut and paste from CGI.pm so that we don't have the overhead of # always loading the entire CGI module. 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; } 1; cgi-bin/extlib/CGI/Cookie.pm0000644002157400001440000003164107771550070022446 0ustar minnesotaviolasociety.orgusers00000000000000package CGI::Cookie; # 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-1999, 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. $CGI::Cookie::VERSION='1.20'; use CGI::Util qw(rearrange unescape escape); use overload '""' => \&as_string, 'cmp' => \&compare, 'fallback'=>1; # fetch a list of cookies from the environment and # return as a hash. the cookies are parsed as normal # escaped URL data. sub fetch { my $class = shift; my $raw_cookie = $ENV{HTTP_COOKIE} || $ENV{COOKIE}; return () unless $raw_cookie; return $class->parse($raw_cookie); } # fetch a list of cookies from the environment and # return as a hash. the cookie values are not unescaped # or altered in any way. sub raw_fetch { my $class = shift; my $raw_cookie = $ENV{HTTP_COOKIE} || $ENV{COOKIE}; return () unless $raw_cookie; my %results; my($key,$value); my(@pairs) = split("; ?",$raw_cookie); foreach (@pairs) { s/\s*(.*?)\s*/$1/; if (/^([^=]+)=(.*)/) { $key = $1; $value = $2; } else { $key = $_; $value = ''; } $results{$key} = $value; } return \%results unless wantarray; return %results; } sub parse { my ($self,$raw_cookie) = @_; my %results; my(@pairs) = split("; ?",$raw_cookie); foreach (@pairs) { s/\s*(.*?)\s*/$1/; my($key,$value) = split("=",$_,2); # Some foreign cookies are not in name=value format, so ignore # them. next if !defined($value); my @values = (); if ($value ne '') { @values = map unescape($_),split(/[&;]/,$value.'&dmy'); pop @values; } $key = unescape($key); # A bug in Netscape can cause several cookies with same name to # appear. The FIRST one in HTTP_COOKIE is the most recent version. $results{$key} ||= $self->new(-name=>$key,-value=>\@values); } return \%results unless wantarray; return %results; } sub new { my $class = shift; $class = ref($class) if ref($class); my($name,$value,$path,$domain,$secure,$expires) = rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@_); # Pull out our parameters. my @values; if (ref($value)) { if (ref($value) eq 'ARRAY') { @values = @$value; } elsif (ref($value) eq 'HASH') { @values = %$value; } } else { @values = ($value); } bless my $self = { 'name'=>$name, 'value'=>[@values], },$class; # IE requires the path and domain to be present for some reason. $path ||= "/"; # however, this breaks networks which use host tables without fully qualified # names, so we comment it out. # $domain = CGI::virtual_host() unless defined $domain; $self->path($path) if defined $path; $self->domain($domain) if defined $domain; $self->secure($secure) if defined $secure; $self->expires($expires) if defined $expires; return $self; } sub as_string { my $self = shift; return "" unless $self->name; my(@constant_values,$domain,$path,$expires,$secure); push(@constant_values,"domain=$domain") if $domain = $self->domain; push(@constant_values,"path=$path") if $path = $self->path; push(@constant_values,"expires=$expires") if $expires = $self->expires; push(@constant_values,"secure") if $secure = $self->secure; my($key) = escape($self->name); my($cookie) = join("=",$key,join("&",map escape($_),$self->value)); return join("; ",$cookie,@constant_values); } sub compare { my $self = shift; my $value = shift; return "$self" cmp $value; } # accessors sub name { my $self = shift; my $name = shift; $self->{'name'} = $name if defined $name; return $self->{'name'}; } sub value { my $self = shift; my $value = shift; if (defined $value) { my @values; if (ref($value)) { if (ref($value) eq 'ARRAY') { @values = @$value; } elsif (ref($value) eq 'HASH') { @values = %$value; } } else { @values = ($value); } $self->{'value'} = [@values]; } return wantarray ? @{$self->{'value'}} : $self->{'value'}->[0] } sub domain { my $self = shift; my $domain = shift; $self->{'domain'} = $domain if defined $domain; return $self->{'domain'}; } sub secure { my $self = shift; my $secure = shift; $self->{'secure'} = $secure if defined $secure; return $self->{'secure'}; } sub expires { my $self = shift; my $expires = shift; $self->{'expires'} = CGI::Util::expires($expires,'cookie') if defined $expires; return $self->{'expires'}; } sub path { my $self = shift; my $path = shift; $self->{'path'} = $path if defined $path; return $self->{'path'}; } 1; =head1 NAME CGI::Cookie - Interface to Netscape Cookies =head1 SYNOPSIS use CGI qw/:standard/; use CGI::Cookie; # Create new cookies and send them $cookie1 = new CGI::Cookie(-name=>'ID',-value=>123456); $cookie2 = new CGI::Cookie(-name=>'preferences', -value=>{ font => Helvetica, size => 12 } ); print header(-cookie=>[$cookie1,$cookie2]); # fetch existing cookies %cookies = fetch CGI::Cookie; $id = $cookies{'ID'}->value; # create cookies returned from an external source %cookies = parse CGI::Cookie($ENV{COOKIE}); =head1 DESCRIPTION CGI::Cookie is an interface to Netscape (HTTP/1.1) cookies, an innovation that allows Web servers to store persistent information on the browser's side of the connection. Although CGI::Cookie is intended to be used in conjunction with CGI.pm (and is in fact used by it internally), you can use this module independently. For full information on cookies see http://www.ics.uci.edu/pub/ietf/http/rfc2109.txt =head1 USING CGI::Cookie CGI::Cookie is object oriented. Each cookie object has a name and a value. The name is any scalar value. The value is any scalar or array value (associative arrays are also allowed). Cookies also have several optional attributes, including: =over 4 =item B<1. expiration date> The expiration date tells the browser how long to hang on to the cookie. If the cookie specifies an expiration date in the future, the browser will store the cookie information in a disk file and return it to the server every time the user reconnects (until the expiration date is reached). If the cookie species an expiration date in the past, the browser will remove the cookie from the disk file. If the expiration date is not specified, the cookie will persist only until the user quits the browser. =item B<2. domain> This is a partial or complete domain name for which the cookie is valid. The browser will return the cookie to any host that matches the partial domain name. For example, if you specify a domain name of ".capricorn.com", then Netscape will return the cookie to Web servers running on any of the machines "www.capricorn.com", "ftp.capricorn.com", "feckless.capricorn.com", etc. Domain names must contain at least two periods to prevent attempts to match on top level domains like ".edu". If no domain is specified, then the browser will only return the cookie to servers on the host the cookie originated from. =item B<3. path> If you provide a cookie path attribute, the browser will check it against your script's URL before returning the cookie. For example, if you specify the path "/cgi-bin", then the cookie will be returned to each of the scripts "/cgi-bin/tally.pl", "/cgi-bin/order.pl", and "/cgi-bin/customer_service/complain.pl", but not to the script "/cgi-private/site_admin.pl". By default, the path is set to "/", so that all scripts at your site will receive the cookie. =item B<4. secure flag> If the "secure" attribute is set, the cookie will only be sent to your script if the CGI request is occurring on a secure channel, such as SSL. =back =head2 Creating New Cookies $c = new CGI::Cookie(-name => 'foo', -value => 'bar', -expires => '+3M', -domain => '.capricorn.com', -path => '/cgi-bin/database', -secure => 1 ); Create cookies from scratch with the B method. The B<-name> and B<-value> parameters are required. The name must be a scalar value. The value can be a scalar, an array reference, or a hash reference. (At some point in the future cookies will support one of the Perl object serialization protocols for full generality). B<-expires> accepts any of the relative or absolute date formats recognized by CGI.pm, for example "+3M" for three months in the future. See CGI.pm's documentation for details. B<-domain> points to a domain name or to a fully qualified host name. If not specified, the cookie will be returned only to the Web server that created it. B<-path> points to a partial URL on the current server. The cookie will be returned to all URLs beginning with the specified path. If not specified, it defaults to '/', which returns the cookie to all pages at your site. B<-secure> if set to a true value instructs the browser to return the cookie only when a cryptographic protocol is in use. =head2 Sending the Cookie to the Browser Within a CGI script you can send a cookie to the browser by creating one or more Set-Cookie: fields in the HTTP header. Here is a typical sequence: my $c = new CGI::Cookie(-name => 'foo', -value => ['bar','baz'], -expires => '+3M'); print "Set-Cookie: $c\n"; print "Content-Type: text/html\n\n"; To send more than one cookie, create several Set-Cookie: fields. Alternatively, you may concatenate the cookies together with "; " and send them in one field. If you are using CGI.pm, you send cookies by providing a -cookie argument to the header() method: print header(-cookie=>$c); Mod_perl users can set cookies using the request object's header_out() method: $r->header_out('Set-Cookie',$c); Internally, Cookie overloads the "" operator to call its as_string() method when incorporated into the HTTP header. as_string() turns the Cookie's internal representation into an RFC-compliant text representation. You may call as_string() yourself if you prefer: print "Set-Cookie: ",$c->as_string,"\n"; =head2 Recovering Previous Cookies %cookies = fetch CGI::Cookie; B returns an associative array consisting of all cookies returned by the browser. The keys of the array are the cookie names. You can iterate through the cookies this way: %cookies = fetch CGI::Cookie; foreach (keys %cookies) { do_something($cookies{$_}); } In a scalar context, fetch() returns a hash reference, which may be more efficient if you are manipulating multiple cookies. CGI.pm uses the URL escaping methods to save and restore reserved characters in its cookies. If you are trying to retrieve a cookie set by a foreign server, this escaping method may trip you up. Use raw_fetch() instead, which has the same semantics as fetch(), but performs no unescaping. You may also retrieve cookies that were stored in some external form using the parse() class method: $COOKIES = `cat /usr/tmp/Cookie_stash`; %cookies = parse CGI::Cookie($COOKIES); =head2 Manipulating Cookies Cookie objects have a series of accessor methods to get and set cookie attributes. Each accessor has a similar syntax. Called without arguments, the accessor returns the current value of the attribute. Called with an argument, the accessor changes the attribute and returns its new value. =over 4 =item B Get or set the cookie's name. Example: $name = $c->name; $new_name = $c->name('fred'); =item B Get or set the cookie's value. Example: $value = $c->value; @new_value = $c->value(['a','b','c','d']); B is context sensitive. In a list context it will return the current value of the cookie as an array. In a scalar context it will return the B value of a multivalued cookie. =item B Get or set the cookie's domain. =item B Get or set the cookie's path. =item B Get or set the cookie's expiration time. =back =head1 AUTHOR INFORMATION Copyright 1997-1998, Lincoln D. Stein. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Address bug reports and comments to: lstein@cshl.org =head1 BUGS This section intentionally left blank. =head1 SEE ALSO L, L =cut cgi-bin/extlib/CGI/Fast.pm0000644002157400001440000001602707771550070022133 0ustar minnesotaviolasociety.orgusers00000000000000package CGI::Fast; # 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,1996, 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://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html # ftp://ftp-genome.wi.mit.edu/pub/software/WWW/ $CGI::Fast::VERSION='1.04'; use CGI; use FCGI; @ISA = ('CGI'); # workaround for known bug in libfcgi while (($ignore) = each %ENV) { } # override the initialization behavior so that # state is NOT maintained between invocations sub save_request { # no-op } # If ENV{FCGI_SOCKET_PATH} is specified, we maintain a FCGI Request handle # in this package variable. use vars qw($Ext_Request); BEGIN { # If ENV{FCGI_SOCKET_PATH} is given, explicitly open the socket, # and keep the request handle around from which to call Accept(). if ($ENV{FCGI_SOCKET_PATH}) { my $path = $ENV{FCGI_SOCKET_PATH}; my $backlog = $ENV{FCGI_LISTEN_QUEUE} || 100; my $socket = FCGI::OpenSocket( $path, $backlog ); $Ext_Request = FCGI::Request( \*STDIN, \*STDOUT, \*STDERR, \%ENV, $socket, 1 ); } } # New is slightly different in that it calls FCGI's # accept() method. sub new { my ($self, $initializer, @param) = @_; unless (defined $initializer) { if ($Ext_Request) { return undef unless $Ext_Request->Accept() >= 0; } else { return undef unless FCGI::accept() >= 0; } } return $CGI::Q = $self->SUPER::new($initializer, @param); } 1; =head1 NAME CGI::Fast - CGI Interface for Fast CGI =head1 SYNOPSIS use CGI::Fast qw(:standard); $COUNTER = 0; while (new CGI::Fast) { print header; print start_html("Fast CGI Rocks"); print h1("Fast CGI Rocks"), "Invocation number ",b($COUNTER++), " PID ",b($$),".", hr; print end_html; } =head1 DESCRIPTION CGI::Fast is a subclass of the CGI object created by CGI.pm. It is specialized to work well with the Open Market FastCGI standard, which greatly speeds up CGI scripts by turning them into persistently running server processes. Scripts that perform time-consuming initialization processes, such as loading large modules or opening persistent database connections, will see large performance improvements. =head1 OTHER PIECES OF THE PUZZLE In order to use CGI::Fast you'll need a FastCGI-enabled Web server. Open Market's server is FastCGI-savvy. There are also freely redistributable FastCGI modules for NCSA httpd 1.5 and Apache. FastCGI-enabling modules for Microsoft Internet Information Server and Netscape Communications Server have been announced. In addition, you'll need a version of the Perl interpreter that has been linked with the FastCGI I/O library. Precompiled binaries are available for several platforms, including DEC Alpha, HP-UX and SPARC/Solaris, or you can rebuild Perl from source with patches provided in the FastCGI developer's kit. The FastCGI Perl interpreter can be used in place of your normal Perl without ill consequences. You can find FastCGI modules for Apache and NCSA httpd, precompiled Perl interpreters, and the FastCGI developer's kit all at URL: http://www.fastcgi.com/ =head1 WRITING FASTCGI PERL SCRIPTS FastCGI scripts are persistent: one or more copies of the script are started up when the server initializes, and stay around until the server exits or they die a natural death. After performing whatever one-time initialization it needs, the script enters a loop waiting for incoming connections, processing the request, and waiting some more. A typical FastCGI script will look like this: #!/usr/local/bin/perl # must be a FastCGI version of perl! use CGI::Fast; &do_some_initialization(); while ($q = new CGI::Fast) { &process_request($q); } Each time there's a new request, CGI::Fast returns a CGI object to your loop. The rest of the time your script waits in the call to new(). When the server requests that your script be terminated, new() will return undef. You can of course exit earlier if you choose. A new version of the script will be respawned to take its place (this may be necessary in order to avoid Perl memory leaks in long-running scripts). CGI.pm's default CGI object mode also works. Just modify the loop this way: while (new CGI::Fast) { &process_request; } Calls to header(), start_form(), etc. will all operate on the current request. =head1 INSTALLING FASTCGI SCRIPTS See the FastCGI developer's kit documentation for full details. On the Apache server, the following line must be added to srm.conf: AddType application/x-httpd-fcgi .fcgi FastCGI scripts must end in the extension .fcgi. For each script you install, you must add something like the following to srm.conf: FastCgiServer /usr/etc/httpd/fcgi-bin/file_upload.fcgi -processes 2 This instructs Apache to launch two copies of file_upload.fcgi at startup time. =head1 USING FASTCGI SCRIPTS AS CGI SCRIPTS Any script that works correctly as a FastCGI script will also work correctly when installed as a vanilla CGI script. However it will not see any performance benefit. =head1 EXTERNAL FASTCGI SERVER INVOCATION FastCGI supports a TCP/IP transport mechanism which allows FastCGI scripts to run external to the webserver, perhaps on a remote machine. To configure the webserver to connect to an external FastCGI server, you would add the following to your srm.conf: FastCgiExternalServer /usr/etc/httpd/fcgi-bin/file_upload.fcgi -host sputnik:8888 Two environment variables affect how the C object is created, allowing C to be used as an external FastCGI server. (See C documentation for C for more information.) =over =item FCGI_SOCKET_PATH The address (TCP/IP) or path (UNIX Domain) of the socket the external FastCGI script to which bind an listen for incoming connections from the web server. =item FCGI_LISTEN_QUEUE Maximum length of the queue of pending connections. =back For example: #!/usr/local/bin/perl # must be a FastCGI version of perl! use CGI::Fast; &do_some_initialization(); $ENV{FCGI_SOCKET_PATH} = "sputnik:8888"; $ENV{FCGI_LISTEN_QUEUE} = 100; while ($q = new CGI::Fast) { &process_request($q); } =head1 CAVEATS I haven't tested this very much. =head1 AUTHOR INFORMATION Copyright 1996-1998, Lincoln D. Stein. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Address bug reports and comments to: lstein@cshl.org =head1 BUGS This section intentionally left blank. =head1 SEE ALSO L, L =cut cgi-bin/extlib/CGI/Pretty.pm0000644002157400001440000001555107771550070022526 0ustar minnesotaviolasociety.orgusers00000000000000package CGI::Pretty; # 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). use strict; use CGI (); $CGI::Pretty::VERSION = '1.05_00'; $CGI::DefaultClass = __PACKAGE__; $CGI::Pretty::AutoloadClass = 'CGI'; @CGI::Pretty::ISA = qw( CGI ); initialize_globals(); sub _prettyPrint { my $input = shift; foreach my $i ( @CGI::Pretty::AS_IS ) { if ( $$input =~ /<\/$i>/si ) { my ( $a, $b, $c, $d, $e ) = $$input =~ /(.*)<$i(\s?)(.*?)>(.*?)<\/$i>(.*)/si; _prettyPrint( \$a ); _prettyPrint( \$e ); $$input = "$a<$i$b$c>$d$e"; return; } } $$input =~ s/$CGI::Pretty::LINEBREAK/$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT/g if $CGI::Pretty::LINEBREAK; } sub comment { my($self,@p) = CGI::self_or_CGI(@_); my $s = "@p"; $s =~ s/$CGI::Pretty::LINEBREAK/$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT/g if $CGI::Pretty::LINEBREAK; return $self->SUPER::comment( "$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT$s$CGI::Pretty::LINEBREAK" ) . $CGI::Pretty::LINEBREAK; } sub _make_tag_func { my ($self,$tagname) = @_; return $self->SUPER::_make_tag_func($tagname) if $tagname=~/^(start|end)_/; # As Lincoln as noted, the last else clause is VERY hairy, and it # took me a while to figure out what I was trying to do. # What it does is look for tags that shouldn't be indented (e.g. PRE) # and makes sure that when we nest tags, those tags don't get # indented. # For an example, try print td( pre( "hello\nworld" ) ); # If we didn't care about stuff like that, the code would be # MUCH simpler. BTW: I won't claim to be a regular expression # guru, so if anybody wants to contribute something that would # be quicker, easier to read, etc, I would be more than # willing to put it in - Brian return qq{ sub $tagname { # handle various cases in which we're called # most of this bizarre stuff is to avoid -w errors shift if \$_[0] && (ref(\$_[0]) && (substr(ref(\$_[0]),0,3) eq 'CGI' || UNIVERSAL::isa(\$_[0],'CGI'))); my(\$attr) = ''; if (ref(\$_[0]) && ref(\$_[0]) eq 'HASH') { my(\@attr) = make_attributes(shift); \$attr = " \@attr" if \@attr; } my(\$tag,\$untag) = ("\L<$tagname\E\$attr>","\L\E"); return \$tag unless \@_; my \@result; my \$NON_PRETTIFY_ENDTAGS = join "", map { "" } \@CGI::Pretty::AS_IS; if ( \$NON_PRETTIFY_ENDTAGS =~ /\$untag/ ) { \@result = map { "\$tag\$_\$untag\$CGI::Pretty::LINEBREAK" } (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_"; } else { my \@args; if(ref(\$_[0]) eq 'ARRAY') { \@args = \@{\$_[0]} } else { foreach (\@_) { \$args[0] .= \$_; \$args[0] .= " " unless \$args[0] =~ /\\s\$/; } chop \$args[0]; } \@result = map { chomp; if ( \$_ !~ /<\\// ) { s/\$CGI::Pretty::LINEBREAK/\$CGI::Pretty::LINEBREAK\$CGI::Pretty::INDENT/g if \$CGI::Pretty::LINEBREAK; } else { my \$tmp = \$_; CGI::Pretty::_prettyPrint( \\\$tmp ); \$_ = \$tmp; } "\$tag\$CGI::Pretty::LINEBREAK\$CGI::Pretty::INDENT\$_\$CGI::Pretty::LINEBREAK\$untag\$CGI::Pretty::LINEBREAK" } \@args; } local \$" = ""; return "\@result"; } }; } sub start_html { return CGI::start_html( @_ ) . $CGI::Pretty::LINEBREAK; } sub end_html { return CGI::end_html( @_ ) . $CGI::Pretty::LINEBREAK; } sub new { my $class = shift; my $this = $class->SUPER::new( @_ ); Apache->request->register_cleanup(\&CGI::Pretty::_reset_globals) if ($CGI::MOD_PERL); $class->_reset_globals if $CGI::PERLEX; return bless $this, $class; } sub initialize_globals { # This is the string used for indentation of tags $CGI::Pretty::INDENT = "\t"; # This is the string used for seperation between tags $CGI::Pretty::LINEBREAK = "\n"; # These tags are not prettify'd. @CGI::Pretty::AS_IS = qw( a pre code script textarea ); 1; } sub _reset_globals { initialize_globals(); } 1; =head1 NAME CGI::Pretty - module to produce nicely formatted HTML code =head1 SYNOPSIS use CGI::Pretty qw( :html3 ); # Print a table with a single data element print table( TR( td( "foo" ) ) ); =head1 DESCRIPTION CGI::Pretty is a module that derives from CGI. It's sole function is to allow users of CGI to output nicely formatted HTML code. When using the CGI module, the following code: print table( TR( td( "foo" ) ) ); produces the following output:
foo
If a user were to create a table consisting of many rows and many columns, the resultant HTML code would be quite difficult to read since it has no carriage returns or indentation. CGI::Pretty fixes this problem. What it does is add a carriage return and indentation to the HTML code so that one can easily read it. print table( TR( td( "foo" ) ) ); now produces the following output:
foo
=head2 Tags that won't be formatted The and

 tags are not formatted.  If these tags were formatted, the
user would see the extra indentation on the web browser causing the page to
look different than what would be expected.  If you wish to add more tags to
the list of tags that are not to be touched, push them onto the C<@AS_IS> array:

    push @CGI::Pretty::AS_IS,qw(CODE XMP);

=head2 Customizing the Indenting

If you wish to have your own personal style of indenting, you can change the
C<$INDENT> variable:

    $CGI::Pretty::INDENT = "\t\t";

would cause the indents to be two tabs.

Similarly, if you wish to have more space between lines, you may change the
C<$LINEBREAK> variable:

    $CGI::Pretty::LINEBREAK = "\n\n";

would create two carriage returns between lines.

If you decide you want to use the regular CGI indenting, you can easily do 
the following:

    $CGI::Pretty::INDENT = $CGI::Pretty::LINEBREAK = "";

=head1 BUGS

This section intentionally left blank.

=head1 AUTHOR

Brian Paulsen , with minor modifications by
Lincoln Stein  for incorporation into the CGI.pm
distribution.

Copyright 1999, Brian Paulsen.  All rights reserved.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

Bug reports and comments to Brian@ThePaulsens.com.  You can also write
to lstein@cshl.org, but this code looks pretty hairy to me and I'm not
sure I understand it!

=head1 SEE ALSO

L

=cut
cgi-bin/extlib/CGI/Push.pm0000644002157400001440000002527607771550070022163 0ustar  minnesotaviolasociety.orgusers00000000000000package CGI::Push;

# 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-2000, 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::Push::VERSION='1.04';
use CGI;
use CGI::Util 'rearrange';
@ISA = ('CGI');

$CGI::DefaultClass = 'CGI::Push';
$CGI::Push::AutoloadClass = 'CGI';

# add do_push() and push_delay() to exported tags
push(@{$CGI::EXPORT_TAGS{':standard'}},'do_push','push_delay');

sub do_push {
    my ($self,@p) = CGI::self_or_default(@_);

    # unbuffer output
    $| = 1;
    srand;
    my ($random) = sprintf("%08.0f",rand()*1E8);
    my ($boundary) = "----=_NeXtPaRt$random";

    my (@header);
    my ($type,$callback,$delay,$last_page,$cookie,$target,$expires,$nph,@other) = rearrange([TYPE,NEXT_PAGE,DELAY,LAST_PAGE,[COOKIE,COOKIES],TARGET,EXPIRES,NPH],@p);
    $type = 'text/html' unless $type;
    $callback = \&simple_counter unless $callback && ref($callback) eq 'CODE';
    $delay = 1 unless defined($delay);
    $self->push_delay($delay);
    $nph = 1 unless defined($nph);

    my(@o);
    foreach (@other) { push(@o,split("=")); }
    push(@o,'-Target'=>$target) if defined($target);
    push(@o,'-Cookie'=>$cookie) if defined($cookie);
    push(@o,'-Type'=>"multipart/x-mixed-replace;boundary=\"$boundary\"");
    push(@o,'-Server'=>"CGI.pm Push Module") if $nph;
    push(@o,'-Status'=>'200 OK');
    push(@o,'-nph'=>1) if $nph;
    print $self->header(@o);

    $boundary = "$CGI::CRLF--$boundary";

    print "WARNING: YOUR BROWSER DOESN'T SUPPORT THIS SERVER-PUSH TECHNOLOGY.${boundary}$CGI::CRLF";

    my (@contents) = &$callback($self,++$COUNTER);

    # now we enter a little loop
    while (1) {
        print "Content-type: ${type}$CGI::CRLF$CGI::CRLF" unless $type =~ /^dynamic|heterogeneous$/i;
        print @contents;
        @contents = &$callback($self,++$COUNTER);
        if ((@contents) && defined($contents[0])) {
            print "${boundary}$CGI::CRLF";
            do_sleep($self->push_delay()) if $self->push_delay();
        } else {
            if ($last_page && ref($last_page) eq 'CODE') {
                print "${boundary}$CGI::CRLF";
                do_sleep($self->push_delay()) if $self->push_delay();
                print "Content-type: ${type}$CGI::CRLF$CGI::CRLF" unless $type =~ /^dynamic|heterogeneous$/i;
                print  &$last_page($self,$COUNTER);
            }
            print "${boundary}--$CGI::CRLF";
            last;
        }
    }
    print "WARNING: YOUR BROWSER DOESN'T SUPPORT THIS SERVER-PUSH TECHNOLOGY.$CGI::CRLF";
}

sub simple_counter {
    my ($self,$count) = @_;
    return $self->start_html("CGI::Push Default Counter"),
           $self->h1("CGI::Push Default Counter"),
           "This page has been updated ",$self->strong($count)," times.",
           $self->hr(),
           $self->a({'-href'=>'http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html'},'CGI.pm home page'),
           $self->end_html;
}

sub do_sleep {
    my $delay = shift;
    if ( ($delay >= 1) && ($delay!~/\./) ){
        sleep($delay);
    } else {
        select(undef,undef,undef,$delay);
    }
}

sub push_delay {
    my ($self,$delay) = CGI::self_or_default(@_);
    return defined($delay) ? $self->{'.delay'} = 
        $delay : $self->{'.delay'};
}

1;

=head1 NAME

CGI::Push - Simple Interface to Server Push

=head1 SYNOPSIS

    use CGI::Push qw(:standard);

    do_push(-next_page=>\&next_page,
            -last_page=>\&last_page,
            -delay=>0.5);

    sub next_page {
        my($q,$counter) = @_;
        return undef if $counter >= 10;
        return start_html('Test'),
               h1('Visible'),"\n",
               "This page has been called ", strong($counter)," times",
               end_html();
    }

    sub last_page {
        my($q,$counter) = @_;
        return start_html('Done'),
               h1('Finished'),
               strong($counter - 1),' iterations.',
               end_html;
    }

=head1 DESCRIPTION

CGI::Push is a subclass of the CGI object created by CGI.pm.  It is
specialized for server push operations, which allow you to create
animated pages whose content changes at regular intervals.

You provide CGI::Push with a pointer to a subroutine that will draw
one page.  Every time your subroutine is called, it generates a new
page.  The contents of the page will be transmitted to the browser
in such a way that it will replace what was there beforehand.  The
technique will work with HTML pages as well as with graphics files, 
allowing you to create animated GIFs.

Only Netscape Navigator supports server push.  Internet Explorer
browsers do not.

=head1 USING CGI::Push

CGI::Push adds one new method to the standard CGI suite, do_push().
When you call this method, you pass it a reference to a subroutine
that is responsible for drawing each new page, an interval delay, and
an optional subroutine for drawing the last page.  Other optional
parameters include most of those recognized by the CGI header()
method.

You may call do_push() in the object oriented manner or not, as you
prefer:

    use CGI::Push;
    $q = new CGI::Push;
    $q->do_push(-next_page=>\&draw_a_page);

        -or-

    use CGI::Push qw(:standard);
    do_push(-next_page=>\&draw_a_page);

Parameters are as follows:

=over 4

=item -next_page

    do_push(-next_page=>\&my_draw_routine);

This required parameter points to a reference to a subroutine responsible for
drawing each new page.  The subroutine should expect two parameters
consisting of the CGI object and a counter indicating the number
of times the subroutine has been called.  It should return the
contents of the page as an B of one or more items to print.  
It can return a false value (or an empty array) in order to abort the
redrawing loop and print out the final page (if any)

    sub my_draw_routine {
        my($q,$counter) = @_;
        return undef if $counter > 100;
        return start_html('testing'),
               h1('testing'),
               "This page called $counter times";
    }

You are of course free to refer to create and use global variables
within your draw routine in order to achieve special effects.

=item -last_page

This optional parameter points to a reference to the subroutine
responsible for drawing the last page of the series.  It is called
after the -next_page routine returns a false value.  The subroutine
itself should have exactly the same calling conventions as the
-next_page routine.

=item -type

This optional parameter indicates the content type of each page.  It
defaults to "text/html".  Normally the module assumes that each page
is of a homogenous MIME type.  However if you provide either of the
magic values "heterogeneous" or "dynamic" (the latter provided for the
convenience of those who hate long parameter names), you can specify
the MIME type -- and other header fields -- on a per-page basis.  See 
"heterogeneous pages" for more details.

=item -delay

This indicates the delay, in seconds, between frames.  Smaller delays
refresh the page faster.  Fractional values are allowed.

B

=item -cookie, -target, -expires, -nph

These have the same meaning as the like-named parameters in
CGI::header().

If not specified, -nph will default to 1 (as needed for many servers, see below).

=back

=head2 Heterogeneous Pages

Ordinarily all pages displayed by CGI::Push share a common MIME type.
However by providing a value of "heterogeneous" or "dynamic" in the
do_push() -type parameter, you can specify the MIME type of each page
on a case-by-case basis.  

If you use this option, you will be responsible for producing the
HTTP header for each page.  Simply modify your draw routine to
look like this:

    sub my_draw_routine {
        my($q,$counter) = @_;
        return header('text/html'),   # note we're producing the header here
               start_html('testing'),
               h1('testing'),
               "This page called $counter times";
    }

You can add any header fields that you like, but some (cookies and
status fields included) may not be interpreted by the browser.  One
interesting effect is to display a series of pages, then, after the
last page, to redirect the browser to a new URL.  Because redirect() 
does b work, the easiest way is with a -refresh header field,
as shown below:

    sub my_draw_routine {
        my($q,$counter) = @_;
        return undef if $counter > 10;
        return header('text/html'),   # note we're producing the header here
               start_html('testing'),
               h1('testing'),
               "This page called $counter times";
    }

    sub my_last_page {
        return header(-refresh=>'5; URL=http://somewhere.else/finished.html',
                      -type=>'text/html'),
               start_html('Moved'),
               h1('This is the last page'),
               'Goodbye!'
               hr,
               end_html; 
    }

=head2 Changing the Page Delay on the Fly

If you would like to control the delay between pages on a page-by-page
basis, call push_delay() from within your draw routine.  push_delay()
takes a single numeric argument representing the number of seconds you
wish to delay after the current page is displayed and before
displaying the next one.  The delay may be fractional.  Without
parameters, push_delay() just returns the current delay.

=head1 INSTALLING CGI::Push SCRIPTS

Server push scripts must be installed as no-parsed-header (NPH)
scripts in order to work correctly on many servers.  On Unix systems,
this is most often accomplished by prefixing the script's name with "nph-".  
Recognition of NPH scripts happens automatically with WebSTAR and 
Microsoft IIS.  Users of other servers should see their documentation
for help.

Apache web server from version 1.3b2 on does not need server
push scripts installed as NPH scripts: the -nph parameter to do_push()
may be set to a false value to disable the extra headers needed by an
NPH script.

=head1 AUTHOR INFORMATION

Copyright 1995-1998, Lincoln D. Stein.  All rights reserved.  

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

Address bug reports and comments to: lstein@cshl.org

=head1 BUGS

This section intentionally left blank.

=head1 SEE ALSO

L, L

=cut

cgi-bin/extlib/CGI/Switch.pm0000644002157400001440000000043507771550070022473 0ustar  minnesotaviolasociety.orgusers00000000000000use CGI;

$VERSION = '1.00';

1;

__END__

=head1 NAME

CGI::Switch - Backward compatibility module for defunct CGI::Switch

=head1 SYNOPSIS

Do not use this module.  It is deprecated.

=head1 ABSTRACT

=head1 DESCRIPTION

=head1 AUTHOR INFORMATION

=head1 BUGS

=head1 SEE ALSO

=cut
cgi-bin/extlib/CGI/Util.pm0000644002157400001440000002476007771550070022156 0ustar  minnesotaviolasociety.orgusers00000000000000package CGI::Util;

use strict;
use vars qw($VERSION @EXPORT_OK @ISA $EBCDIC @A2E @E2A);
require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(rearrange make_attributes unescape escape expires);

$VERSION = '1.3';

$EBCDIC = "\t" ne "\011";
if ($EBCDIC) {
  # (ord('^') == 95) for codepage 1047 as on os390, vmesa
  @A2E = (
   0,  1,  2,  3, 55, 45, 46, 47, 22,  5, 21, 11, 12, 13, 14, 15,
  16, 17, 18, 19, 60, 61, 50, 38, 24, 25, 63, 39, 28, 29, 30, 31,
  64, 90,127,123, 91,108, 80,125, 77, 93, 92, 78,107, 96, 75, 97,
 240,241,242,243,244,245,246,247,248,249,122, 94, 76,126,110,111,
 124,193,194,195,196,197,198,199,200,201,209,210,211,212,213,214,
 215,216,217,226,227,228,229,230,231,232,233,173,224,189, 95,109,
 121,129,130,131,132,133,134,135,136,137,145,146,147,148,149,150,
 151,152,153,162,163,164,165,166,167,168,169,192, 79,208,161,  7,
  32, 33, 34, 35, 36, 37,  6, 23, 40, 41, 42, 43, 44,  9, 10, 27,
  48, 49, 26, 51, 52, 53, 54,  8, 56, 57, 58, 59,  4, 20, 62,255,
  65,170, 74,177,159,178,106,181,187,180,154,138,176,202,175,188,
 144,143,234,250,190,160,182,179,157,218,155,139,183,184,185,171,
 100,101, 98,102, 99,103,158,104,116,113,114,115,120,117,118,119,
 172,105,237,238,235,239,236,191,128,253,254,251,252,186,174, 89,
  68, 69, 66, 70, 67, 71,156, 72, 84, 81, 82, 83, 88, 85, 86, 87,
 140, 73,205,206,203,207,204,225,112,221,222,219,220,141,142,223
	 );
  @E2A = (
   0,  1,  2,  3,156,  9,134,127,151,141,142, 11, 12, 13, 14, 15,
  16, 17, 18, 19,157, 10,  8,135, 24, 25,146,143, 28, 29, 30, 31,
 128,129,130,131,132,133, 23, 27,136,137,138,139,140,  5,  6,  7,
 144,145, 22,147,148,149,150,  4,152,153,154,155, 20, 21,158, 26,
  32,160,226,228,224,225,227,229,231,241,162, 46, 60, 40, 43,124,
  38,233,234,235,232,237,238,239,236,223, 33, 36, 42, 41, 59, 94,
  45, 47,194,196,192,193,195,197,199,209,166, 44, 37, 95, 62, 63,
 248,201,202,203,200,205,206,207,204, 96, 58, 35, 64, 39, 61, 34,
 216, 97, 98, 99,100,101,102,103,104,105,171,187,240,253,254,177,
 176,106,107,108,109,110,111,112,113,114,170,186,230,184,198,164,
 181,126,115,116,117,118,119,120,121,122,161,191,208, 91,222,174,
 172,163,165,183,169,167,182,188,189,190,221,168,175, 93,180,215,
 123, 65, 66, 67, 68, 69, 70, 71, 72, 73,173,244,246,242,243,245,
 125, 74, 75, 76, 77, 78, 79, 80, 81, 82,185,251,252,249,250,255,
  92,247, 83, 84, 85, 86, 87, 88, 89, 90,178,212,214,210,211,213,
  48, 49, 50, 51, 52, 53, 54, 55, 56, 57,179,219,220,217,218,159
	 );
  if (ord('^') == 106) { # as in the BS2000 posix-bc coded character set
     $A2E[91] = 187;   $A2E[92] = 188;  $A2E[94] = 106;  $A2E[96] = 74;
     $A2E[123] = 251;  $A2E[125] = 253; $A2E[126] = 255; $A2E[159] = 95;
     $A2E[162] = 176;  $A2E[166] = 208; $A2E[168] = 121; $A2E[172] = 186;
     $A2E[175] = 161;  $A2E[217] = 224; $A2E[219] = 221; $A2E[221] = 173;
     $A2E[249] = 192;
 
     $E2A[74] = 96;   $E2A[95] = 159;  $E2A[106] = 94;  $E2A[121] = 168;
     $E2A[161] = 175; $E2A[173] = 221; $E2A[176] = 162; $E2A[186] = 172;
     $E2A[187] = 91;  $E2A[188] = 92;  $E2A[192] = 249; $E2A[208] = 166;
     $E2A[221] = 219; $E2A[224] = 217; $E2A[251] = 123; $E2A[253] = 125;
     $E2A[255] = 126;
 }
  elsif (ord('^') == 176) { # as in codepage 037 on os400
     $A2E[10] = 37;  $A2E[91] = 186;  $A2E[93] = 187; $A2E[94] = 176;
     $A2E[133] = 21; $A2E[168] = 189; $A2E[172] = 95; $A2E[221] = 173;
 
     $E2A[21] = 133; $E2A[37] = 10;  $E2A[95] = 172; $E2A[173] = 221;
     $E2A[176] = 94; $E2A[186] = 91; $E2A[187] = 93; $E2A[189] = 168;
   }
}

# Smart rearrangement of parameters to allow named parameter
# calling.  We do the rearangement if:
# the first parameter begins with a -
sub rearrange {
    my($order,@param) = @_;
    return () unless @param;

    if (ref($param[0]) eq 'HASH') {
	@param = %{$param[0]};
    } else {
	return @param 
	    unless (defined($param[0]) && substr($param[0],0,1) eq '-');
    }

    # map parameters into positional indices
    my ($i,%pos);
    $i = 0;
    foreach (@$order) {
	foreach (ref($_) eq 'ARRAY' ? @$_ : $_) { $pos{lc($_)} = $i; }
	$i++;
    }

    my (@result,%leftover);
    $#result = $#$order;  # preextend
    while (@param) {
	my $key = lc(shift(@param));
	$key =~ s/^\-//;
	if (exists $pos{$key}) {
	    $result[$pos{$key}] = shift(@param);
	} else {
	    $leftover{$key} = shift(@param);
	}
    }

    push (@result,make_attributes(\%leftover,1)) if %leftover;
    @result;
}

sub make_attributes {
    my $attr = shift;
    return () unless $attr && ref($attr) && ref($attr) eq 'HASH';
    my $escape = shift || 0;
    my(@att);
    foreach (keys %{$attr}) {
	my($key) = $_;
	$key=~s/^\-//;     # get rid of initial - if present

	# old way: breaks EBCDIC!
	# $key=~tr/A-Z_/a-z-/; # parameters are lower case, use dashes

	($key="\L$key") =~ tr/_/-/; # parameters are lower case, use dashes

	my $value = $escape ? simple_escape($attr->{$_}) : $attr->{$_};
	push(@att,defined($attr->{$_}) ? qq/$key="$value"/ : qq/$key/);
    }
    return @att;
}

sub simple_escape {
  return unless defined(my $toencode = shift);
  $toencode =~ s{&}{&}gso;
  $toencode =~ s{<}{<}gso;
  $toencode =~ s{>}{>}gso;
  $toencode =~ s{\"}{"}gso;
# Doesn't work.  Can't work.  forget it.
#  $toencode =~ s{\x8b}{‹}gso;
#  $toencode =~ s{\x9b}{›}gso;
  $toencode;
}

sub utf8_chr ($) {
        my $c = shift(@_);

        if ($c < 0x80) {
                return sprintf("%c", $c);
        } elsif ($c < 0x800) {
                return sprintf("%c%c", 0xc0 | ($c >> 6), 0x80 | ($c & 0x3f));
        } elsif ($c < 0x10000) {
                return sprintf("%c%c%c",
                                           0xe0 |  ($c >> 12),
                                           0x80 | (($c >>  6) & 0x3f),
                                           0x80 | ( $c          & 0x3f));
        } elsif ($c < 0x200000) {
                return sprintf("%c%c%c%c",
                                           0xf0 |  ($c >> 18),
                                           0x80 | (($c >> 12) & 0x3f),
                                           0x80 | (($c >>  6) & 0x3f),
                                           0x80 | ( $c          & 0x3f));
        } elsif ($c < 0x4000000) {
                return sprintf("%c%c%c%c%c",
                                           0xf8 |  ($c >> 24),
                                           0x80 | (($c >> 18) & 0x3f),
                                           0x80 | (($c >> 12) & 0x3f),
                                           0x80 | (($c >>  6) & 0x3f),
                                           0x80 | ( $c          & 0x3f));

        } elsif ($c < 0x80000000) {
                return sprintf("%c%c%c%c%c%c",
                                           0xfe |  ($c >> 30),
                                           0x80 | (($c >> 24) & 0x3f),
                                           0x80 | (($c >> 18) & 0x3f),
                                           0x80 | (($c >> 12) & 0x3f),
                                           0x80 | (($c >> 6)  & 0x3f),
                                           0x80 | ( $c          & 0x3f));
        } else {
                return utf8(0xfffd);
        }
}

# unescape URL-encoded data
sub unescape {
  shift() if @_ > 1 and (ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
  my $todecode = shift;
  return undef unless defined($todecode);
  $todecode =~ tr/+/ /;       # pluses become spaces
    $EBCDIC = "\t" ne "\011";
    if ($EBCDIC) {
      $todecode =~ s/%([0-9a-fA-F]{2})/chr $A2E[hex($1)]/ge;
    } else {
      $todecode =~ s/%(?:([0-9a-fA-F]{2})|u([0-9a-fA-F]{4}))/
	defined($1)? chr hex($1) : utf8_chr(hex($2))/ge;
    }
  return $todecode;
}

# URL-encode data
sub escape {
  shift() if @_ > 1 and ( ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
  my $toencode = shift;
  return undef unless defined($toencode);
    if ($EBCDIC) {
      $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",$E2A[ord($1)])/eg;
    } else {
      $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
    }
  return $toencode;
}

# This internal routine creates date strings suitable for use in
# cookies and HTTP headers.  (They differ, unfortunately.)
# Thanks to Mark Fisher for this.
sub expires {
    my($time,$format) = @_;
    $format ||= 'http';

    my(@MON)=qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
    my(@WDAY) = qw/Sun Mon Tue Wed Thu Fri Sat/;

    # pass through preformatted dates for the sake of expire_calc()
    $time = expire_calc($time);
    return $time unless $time =~ /^\d+$/;

    # make HTTP/cookie date string from GMT'ed time
    # (cookies use '-' as date separator, HTTP uses ' ')
    my($sc) = ' ';
    $sc = '-' if $format eq "cookie";
    my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time);
    $year += 1900;
    return sprintf("%s, %02d$sc%s$sc%04d %02d:%02d:%02d GMT",
                   $WDAY[$wday],$mday,$MON[$mon],$year,$hour,$min,$sec);
}

# This internal routine creates an expires time exactly some number of
# hours from the current time.  It incorporates modifications from 
# Mark Fisher.
sub expire_calc {
    my($time) = @_;
    my(%mult) = ('s'=>1,
                 'm'=>60,
                 'h'=>60*60,
                 'd'=>60*60*24,
                 'M'=>60*60*24*30,
                 'y'=>60*60*24*365);
    # format for time can be in any of the forms...
    # "now" -- expire immediately
    # "+180s" -- in 180 seconds
    # "+2m" -- in 2 minutes
    # "+12h" -- in 12 hours
    # "+1d"  -- in 1 day
    # "+3M"  -- in 3 months
    # "+2y"  -- in 2 years
    # "-3m"  -- 3 minutes ago(!)
    # If you don't supply one of these forms, we assume you are
    # specifying the date yourself
    my($offset);
    if (!$time || (lc($time) eq 'now')) {
        $offset = 0;
    } elsif ($time=~/^\d+/) {
        return $time;
    } elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([mhdMy]?)/) {
        $offset = ($mult{$2} || 1)*$1;
    } else {
        return $time;
    }
    return (time+$offset);
}

1;

__END__

=head1 NAME

CGI::Util - Internal utilities used by CGI module

=head1 SYNOPSIS

none

=head1 DESCRIPTION

no public subroutines

=head1 AUTHOR INFORMATION

Copyright 1995-1998, Lincoln D. Stein.  All rights reserved.  

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

Address bug reports and comments to: lstein@cshl.org.  When sending
bug reports, please provide the version of CGI.pm, the version of
Perl, the name and version of your Web server, and the name and
version of the operating system you are using.  If the problem is even
remotely browser dependent, please provide information about the
affected browers as well.

=head1 SEE ALSO

L

=cut
cgi-bin/extlib/File/0000755002157400001440000000000007776605372021162 5ustar  minnesotaviolasociety.orgusers00000000000000cgi-bin/extlib/File/Spec/0000755002157400001440000000000007776605372022054 5ustar  minnesotaviolasociety.orgusers00000000000000cgi-bin/extlib/File/Spec/_vti_cnf/0000755002157400001440000000000007776605372023643 5ustar  minnesotaviolasociety.orgusers00000000000000cgi-bin/extlib/File/Spec/_vti_cnf/Functions.pm0000644002157400001440000000030307771550070026132 0ustar  minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl
vti_timelastmodified:TR|22 Dec 2003 11:06:32 -0000
vti_extenderversion:SR|5.0.2.2623
vti_cacheddtm:TX|22 Dec 2003 11:06:32 -0000
vti_filesize:IR|1625
vti_backlinkinfo:VX|
cgi-bin/extlib/File/Spec/_vti_cnf/Mac.pm0000644002157400001440000000030307771550070024662 0ustar  minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl
vti_timelastmodified:TR|22 Dec 2003 11:06:32 -0000
vti_extenderversion:SR|5.0.2.2623
vti_cacheddtm:TX|22 Dec 2003 11:06:32 -0000
vti_filesize:IR|8864
vti_backlinkinfo:VX|
cgi-bin/extlib/File/Spec/_vti_cnf/OS2.pm0000644002157400001440000000030307771550070024565 0ustar  minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl
vti_timelastmodified:TR|22 Dec 2003 11:06:32 -0000
vti_extenderversion:SR|5.0.2.2623
vti_cacheddtm:TX|22 Dec 2003 11:06:32 -0000
vti_filesize:IR|1142
vti_backlinkinfo:VX|
cgi-bin/extlib/File/Spec/_vti_cnf/Unix.pm0000644002157400001440000000030407771550070025106 0ustar  minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl
vti_timelastmodified:TR|22 Dec 2003 11:06:32 -0000
vti_extenderversion:SR|5.0.2.2623
vti_cacheddtm:TX|22 Dec 2003 11:06:32 -0000
vti_filesize:IR|10953
vti_backlinkinfo:VX|
cgi-bin/extlib/File/Spec/_vti_cnf/VMS.pm0000644002157400001440000000030407771550070024630 0ustar  minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl
vti_timelastmodified:TR|22 Dec 2003 11:06:32 -0000
vti_extenderversion:SR|5.0.2.2623
vti_cacheddtm:TX|22 Dec 2003 11:06:32 -0000
vti_filesize:IR|13396
vti_backlinkinfo:VX|
cgi-bin/extlib/File/Spec/_vti_cnf/Win32.pm0000644002157400001440000000030307771550070025064 0ustar  minnesotaviolasociety.orgusers00000000000000vti_encoding:SR|utf8-nl
vti_timelastmodified:TR|22 Dec 2003 11:06:32 -0000
vti_extenderversion:SR|5.0.2.2623
vti_cacheddtm:TX|22 Dec 2003 11:06:32 -0000
vti_filesize:IR|8723
vti_backlinkinfo:VX|
cgi-bin/extlib/File/Spec/Functions.pm0000644002157400001440000000313107771550070024345 0ustar  minnesotaviolasociety.orgusers00000000000000package File::Spec::Functions;

use File::Spec;
use strict;

use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);

$VERSION = '1.1';

require Exporter;

@ISA = qw(Exporter);

@EXPORT = qw(
	canonpath
	catdir
	catfile
	curdir
	rootdir
	updir
	no_upwards
	file_name_is_absolute
	path
);

@EXPORT_OK = qw(
	devnull
	tmpdir
	splitpath
	splitdir
	catpath
	abs2rel
	rel2abs
);

%EXPORT_TAGS = ( ALL => [ @EXPORT_OK, @EXPORT ] );

foreach my $meth (@EXPORT, @EXPORT_OK) {
    my $sub = File::Spec->can($meth);
    no strict 'refs';
    *{$meth} = sub {&$sub('File::Spec', @_)};
}


1;
__END__

=head1 NAME

File::Spec::Functions - portably perform operations on file names

=head1 SYNOPSIS

	use File::Spec::Functions;
	$x = catfile('a','b');

=head1 DESCRIPTION

This module exports convenience functions for all of the class methods
provided by File::Spec.

For a reference of available functions, please consult L,
which contains the entire set, and which is inherited by the modules for
other platforms. For further information, please see L,
L, L, or L.

=head2 Exports

The following functions are exported by default.

	canonpath
	catdir
	catfile
	curdir
	rootdir
	updir
	no_upwards
	file_name_is_absolute
	path


The following functions are exported only by request.

	devnull
	tmpdir
	splitpath
	splitdir
	catpath
	abs2rel
	rel2abs

All the functions may be imported using the C<:ALL> tag.

=head1 SEE ALSO

File::Spec, File::Spec::Unix, File::Spec::Mac, File::Spec::OS2,
File::Spec::Win32, File::Spec::VMS, ExtUtils::MakeMaker
cgi-bin/extlib/File/Spec/Mac.pm0000644002157400001440000002124007771550070023076 0ustar  minnesotaviolasociety.orgusers00000000000000package File::Spec::Mac;

use strict;
use vars qw(@ISA $VERSION);
require File::Spec::Unix;

$VERSION = '1.2';

@ISA = qw(File::Spec::Unix);

=head1 NAME

File::Spec::Mac - File::Spec for MacOS

=head1 SYNOPSIS

 require File::Spec::Mac; # Done internally by File::Spec if needed

=head1 DESCRIPTION

Methods for manipulating file specifications.

=head1 METHODS

=over 2

=item canonpath

On MacOS, there's nothing to be done.  Returns what it's given.

=cut

sub canonpath {
    my ($self,$path) = @_;
    return $path;
}

=item catdir

Concatenate two or more directory names to form a complete path ending with 
a directory.  Put a trailing : on the end of the complete path if there 
isn't one, because that's what's done in MacPerl's environment.

The fundamental requirement of this routine is that

	  File::Spec->catdir(split(":",$path)) eq $path

But because of the nature of Macintosh paths, some additional 
possibilities are allowed to make using this routine give reasonable results 
for some common situations.  Here are the rules that are used.  Each 
argument has its trailing ":" removed.  Each argument, except the first,
has its leading ":" removed.  They are then joined together by a ":".

So

	  File::Spec->catdir("a","b") = "a:b:"
	  File::Spec->catdir("a:",":b") = "a:b:"
	  File::Spec->catdir("a:","b") = "a:b:"
	  File::Spec->catdir("a",":b") = "a:b"
	  File::Spec->catdir("a","","b") = "a::b"

etc.

To get a relative path (one beginning with :), begin the first argument with :
or put a "" as the first argument.

If you don't want to worry about these rules, never allow a ":" on the ends 
of any of the arguments except at the beginning of the first.

Under MacPerl, there is an additional ambiguity.  Does the user intend that

	  File::Spec->catfile("LWP","Protocol","http.pm")

be relative or absolute?  There's no way of telling except by checking for the
existence of LWP: or :LWP, and even there he may mean a dismounted volume or
a relative path in a different directory (like in @INC).   So those checks
aren't done here. This routine will treat this as absolute.

=cut

sub catdir {
    shift;
    my @args = @_;
    my $result = shift @args;
    $result =~ s/:\Z(?!\n)//;
    foreach (@args) {
	s/:\Z(?!\n)//;
	s/^://s;
	$result .= ":$_";
    }
    return "$result:";
}

=item catfile

Concatenate one or more directory names and a filename to form a
complete path ending with a filename.  Since this uses catdir, the
same caveats apply.  Note that the leading : is removed from the filename,
so that 

	  File::Spec->catfile($ENV{HOME},"file");

and

	  File::Spec->catfile($ENV{HOME},":file");

give the same answer, as one might expect.

=cut

sub catfile {
    my $self = shift;
    my $file = pop @_;
    return $file unless @_;
    my $dir = $self->catdir(@_);
    $file =~ s/^://s;
    return $dir.$file;
}

=item curdir

Returns a string representing the current directory.

=cut

sub curdir {
    return ":";
}

=item devnull

Returns a string representing the null device.

=cut

sub devnull {
    return "Dev:Null";
}

=item rootdir

Returns a string representing the root directory.  Under MacPerl,
returns the name of the startup volume, since that's the closest in
concept, although other volumes aren't rooted there.

=cut

sub rootdir {
#
#  There's no real root directory on MacOS.  The name of the startup
#  volume is returned, since that's the closest in concept.
#
    require Mac::Files;
    my $system =  Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
					 &Mac::Files::kSystemFolderType);
    $system =~ s/:.*\Z(?!\n)/:/s;
    return $system;
}

=item tmpdir

Returns a string representation of the first existing directory
from the following list or '' if none exist:

    $ENV{TMPDIR}

=cut

my $tmpdir;
sub tmpdir {
    return $tmpdir if defined $tmpdir;
    $tmpdir = $ENV{TMPDIR} if -d $ENV{TMPDIR};
    $tmpdir = '' unless defined $tmpdir;
    return $tmpdir;
}

=item updir

Returns a string representing the parent directory.

=cut

sub updir {
    return "::";
}

=item file_name_is_absolute

Takes as argument a path and returns true, if it is an absolute path.  In 
the case where a name can be either relative or absolute (for example, a 
folder named "HD" in the current working directory on a drive named "HD"), 
relative wins.  Use ":" in the appropriate place in the path if you want to
distinguish unambiguously.

As a special case, the file name '' is always considered to be absolute.

=cut

sub file_name_is_absolute {
    my ($self,$file) = @_;
    if ($file =~ /:/) {
	return ($file !~ m/^:/s);
    } elsif ( $file eq '' ) {
        return 1 ;
    } else {
	return (! -e ":$file");
    }
}

=item path

Returns the null list for the MacPerl application, since the concept is 
usually meaningless under MacOS. But if you're using the MacPerl tool under 
MPW, it gives back $ENV{Commands} suitably split, as is done in 
:lib:ExtUtils:MM_Mac.pm.

=cut

sub path {
#
#  The concept is meaningless under the MacPerl application.
#  Under MPW, it has a meaning.
#
    return unless exists $ENV{Commands};
    return split(/,/, $ENV{Commands});
}

=item splitpath

=cut

sub splitpath {
    my ($self,$path, $nofile) = @_;

    my ($volume,$directory,$file) = ('','','');

    if ( $nofile ) {
        ( $volume, $directory ) = $path =~ m@((?:[^:]+(?::|\Z(?!\n)))?)(.*)@s;
    }
    else {
        $path =~ 
            m@^( (?: [^:]+: )? ) 
                ( (?: .*: )? )
                ( .* )
             @xs;
        $volume    = $1;
        $directory = $2;
        $file      = $3;
    }

    # Make sure non-empty volumes and directories end in ':'
    $volume    .= ':' if $volume    =~ m@[^:]\Z(?!\n)@ ;
    $directory .= ':' if $directory =~ m@[^:]\Z(?!\n)@ ;
    return ($volume,$directory,$file);
}


=item splitdir

=cut

sub splitdir {
    my ($self,$directories) = @_ ;
    #
    # split() likes to forget about trailing null fields, so here we
    # check to be sure that there will not be any before handling the
    # simple case.
    #
    if ( $directories !~ m@:\Z(?!\n)@ ) {
        return split( m@:@, $directories );
    }
    else {
        #
        # since there was a trailing separator, add a file name to the end, 
        # then do the split, then replace it with ''.
        #
        my( @directories )= split( m@:@, "${directories}dummy" ) ;
        $directories[ $#directories ]= '' ;
        return @directories ;
    }
}


=item catpath

=cut

sub catpath {
    my $self = shift ;

    my $result = shift ;
    $result =~ s@^([^/])@/$1@s ;

    my $segment ;
    for $segment ( @_ ) {
        if ( $result =~ m@[^/]\Z(?!\n)@ && $segment =~ m@^[^/]@s ) {
            $result .= "/$segment" ;
        }
        elsif ( $result =~ m@/\Z(?!\n)@ && $segment =~ m@^/@s ) {
            $result  =~ s@/+\Z(?!\n)@/@;
            $segment =~ s@^/+@@s;
            $result  .= "$segment" ;
        }
        else {
            $result  .= $segment ;
        }
    }

    return $result ;
}

=item abs2rel

See L for general documentation.

Unlike Cabs2rel()>, this function will make
checks against the local filesystem if necessary.  See
L for details.

=cut

sub abs2rel {
    my($self,$path,$base) = @_;

    # Clean up $path
    if ( ! $self->file_name_is_absolute( $path ) ) {
        $path = $self->rel2abs( $path ) ;
    }

    # Figure out the effective $base and clean it up.
    if ( !defined( $base ) || $base eq '' ) {
        $base = cwd() ;
    }
    elsif ( ! $self->file_name_is_absolute( $base ) ) {
        $base = $self->rel2abs( $base ) ;
    }

    # Now, remove all leading components that are the same
    my @pathchunks = $self->splitdir( $path );
    my @basechunks = $self->splitdir( $base );

    while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) {
        shift @pathchunks ;
        shift @basechunks ;
    }

    $path = join( ':', @pathchunks );

    # @basechunks now contains the number of directories to climb out of.
    $base = ':' x @basechunks ;

    return "$base:$path" ;
}

=item rel2abs

See L for general documentation.

Unlike Crel2abs()>, this function will make
checks against the local filesystem if necessary.  See
L for details.

=cut

sub rel2abs {
    my ($self,$path,$base ) = @_;

    if ( ! $self->file_name_is_absolute( $path ) ) {
        if ( !defined( $base ) || $base eq '' ) {
            $base = cwd() ;
        }
        elsif ( ! $self->file_name_is_absolute( $base ) ) {
            $base = $self->rel2abs( $base ) ;
        }
        else {
            $base = $self->canonpath( $base ) ;
        }

        $path = $self->canonpath("$base$path") ;
    }

    return $path ;
}


=back

=head1 SEE ALSO

L

=cut

1;
cgi-bin/extlib/File/Spec/OS2.pm0000644002157400001440000000216607771550070023007 0ustar  minnesotaviolasociety.orgusers00000000000000package File::Spec::OS2;

use strict;
use vars qw(@ISA $VERSION);
require File::Spec::Unix;

$VERSION = '1.1';

@ISA = qw(File::Spec::Unix);

sub devnull {
    return "/dev/nul";
}

sub case_tolerant {
    return 1;
}

sub file_name_is_absolute {
    my ($self,$file) = @_;
    return scalar($file =~ m{^([a-z]:)?[\\/]}is);
}

sub path {
    my $path = $ENV{PATH};
    $path =~ s:\\:/:g;
    my @path = split(';',$path);
    foreach (@path) { $_ = '.' if $_ eq '' }
    return @path;
}

my $tmpdir;
sub tmpdir {
    return $tmpdir if defined $tmpdir;
    my $self = shift;
    foreach (@ENV{qw(TMPDIR TEMP TMP)}, qw(/tmp /)) {
	next unless defined && -d;
	$tmpdir = $_;
	last;
    }
    $tmpdir = '' unless defined $tmpdir;
    $tmpdir =~ s:\\:/:g;
    $tmpdir = $self->canonpath($tmpdir);
    return $tmpdir;
}

1;
__END__

=head1 NAME

File::Spec::OS2 - methods for OS/2 file specs

=head1 SYNOPSIS

 require File::Spec::OS2; # Done internally by File::Spec if needed

=head1 DESCRIPTION

See File::Spec::Unix for a documentation of the methods provided
there. This package overrides the implementation of these methods, not
the semantics.
cgi-bin/extlib/File/Spec/Unix.pm0000644002157400001440000002531107771550070023324 0ustar  minnesotaviolasociety.orgusers00000000000000package File::Spec::Unix;

use strict;
use vars qw($VERSION);

$VERSION = '1.2';

use Cwd;

=head1 NAME

File::Spec::Unix - methods used by File::Spec

=head1 SYNOPSIS

 require File::Spec::Unix; # Done automatically by File::Spec

=head1 DESCRIPTION

Methods for manipulating file specifications.

=head1 METHODS

=over 2

=item canonpath

No physical check on the filesystem, but a logical cleanup of a
path. On UNIX eliminated successive slashes and successive "/.".

    $cpath = File::Spec->canonpath( $path ) ;

=cut

sub canonpath {
    my ($self,$path) = @_;
    $path =~ s|/+|/|g unless($^O eq 'cygwin');     # xx////xx  -> xx/xx
    $path =~ s|(/\.)+/|/|g;                        # xx/././xx -> xx/xx
    $path =~ s|^(\./)+||s unless $path eq "./";    # ./xx      -> xx
    $path =~ s|^/(\.\./)+|/|s;                     # /../../xx -> xx
    $path =~ s|/\Z(?!\n)|| unless $path eq "/";          # xx/       -> xx
    return $path;
}

=item catdir

Concatenate two or more directory names to form a complete path ending
with a directory. But remove the trailing slash from the resulting
string, because it doesn't look good, isn't necessary and confuses
OS2. Of course, if this is the root directory, don't cut off the
trailing slash :-)

=cut

sub catdir {
    my $self = shift;
    my @args = @_;
    foreach (@args) {
	# append a slash to each argument unless it has one there
	$_ .= "/" if $_ eq '' || substr($_,-1) ne "/";
    }
    return $self->canonpath(join('', @args));
}

=item catfile

Concatenate one or more directory names and a filename to form a
complete path ending with a filename

=cut

sub catfile {
    my $self = shift;
    my $file = pop @_;
    return $file unless @_;
    my $dir = $self->catdir(@_);
    $dir .= "/" unless substr($dir,-1) eq "/";
    return $dir.$file;
}

=item curdir

Returns a string representation of the current directory.  "." on UNIX.

=cut

sub curdir {
    return ".";
}

=item devnull

Returns a string representation of the null device. "/dev/null" on UNIX.

=cut

sub devnull {
    return "/dev/null";
}

=item rootdir

Returns a string representation of the root directory.  "/" on UNIX.

=cut

sub rootdir {
    return "/";
}

=item tmpdir

Returns a string representation of the first writable directory
from the following list or "" if none are writable:

    $ENV{TMPDIR}
    /tmp

=cut

my $tmpdir;
sub tmpdir {
    return $tmpdir if defined $tmpdir;
    foreach ($ENV{TMPDIR}, "/tmp") {
	next unless defined && -d && -w _;
	$tmpdir = $_;
	last;
    }
    $tmpdir = '' unless defined $tmpdir;
    return $tmpdir;
}

=item updir

Returns a string representation of the parent directory.  ".." on UNIX.

=cut

sub updir {
    return "..";
}

=item no_upwards

Given a list of file names, strip out those that refer to a parent
directory. (Does not strip symlinks, only '.', '..', and equivalents.)

=cut

sub no_upwards {
    my $self = shift;
    return grep(!/^\.{1,2}\Z(?!\n)/s, @_);
}

=item case_tolerant

Returns a true or false value indicating, respectively, that alphabetic
is not or is significant when comparing file specifications.

=cut

sub case_tolerant {
    return 0;
}

=item file_name_is_absolute

Takes as argument a path and returns true if it is an absolute path.

This does not consult the local filesystem on Unix, Win32, or OS/2.  It
does sometimes on MacOS (see L).
It does consult the working environment for VMS (see
L).

=cut

sub file_name_is_absolute {
    my ($self,$file) = @_;
    return scalar($file =~ m:^/:s);
}

=item path

Takes no argument, returns the environment variable PATH as an array.

=cut

sub path {
    my @path = split(':', $ENV{PATH});
    foreach (@path) { $_ = '.' if $_ eq '' }
    return @path;
}

=item join

join is the same as catfile.

=cut

sub join {
    my $self = shift;
    return $self->catfile(@_);
}

=item splitpath

    ($volume,$directories,$file) = File::Spec->splitpath( $path );
    ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );

Splits a path in to volume, directory, and filename portions. On systems
with no concept of volume, returns undef for volume. 

For systems with no syntax differentiating filenames from directories, 
assumes that the last file is a path unless $no_file is true or a 
trailing separator or /. or /.. is present. On Unix this means that $no_file
true makes this return ( '', $path, '' ).

The directory portion may or may not be returned with a trailing '/'.

The results can be passed to L to get back a path equivalent to
(usually identical to) the original path.

=cut

sub splitpath {
    my ($self,$path, $nofile) = @_;

    my ($volume,$directory,$file) = ('','','');

    if ( $nofile ) {
        $directory = $path;
    }
    else {
        $path =~ m|^ ( (?: .* / (?: \.\.?\Z(?!\n) )? )? ) ([^/]*) |xs;
        $directory = $1;
        $file      = $2;
    }

    return ($volume,$directory,$file);
}


=item splitdir

The opposite of L.

    @dirs = File::Spec->splitdir( $directories );

$directories must be only the directory portion of the path on systems 
that have the concept of a volume or that have path syntax that differentiates
files from directories.

Unlike just splitting the directories on the separator, empty
directory names (C<''>) can be returned, because these are significant
on some OSs (e.g. MacOS).

On Unix,

    File::Spec->splitdir( "/a/b//c/" );

Yields:

    ( '', 'a', 'b', '', 'c', '' )

=cut

sub splitdir {
    my ($self,$directories) = @_ ;
    #
    # split() likes to forget about trailing null fields, so here we
    # check to be sure that there will not be any before handling the
    # simple case.
    #
    if ( $directories !~ m|/\Z(?!\n)| ) {
        return split( m|/|, $directories );
    }
    else {
        #
        # since there was a trailing separator, add a file name to the end, 
        # then do the split, then replace it with ''.
        #
        my( @directories )= split( m|/|, "${directories}dummy" ) ;
        $directories[ $#directories ]= '' ;
        return @directories ;
    }
}


=item catpath

Takes volume, directory and file portions and returns an entire path. Under
Unix, $volume is ignored, and directory and file are catenated.  A '/' is
inserted if need be.  On other OSs, $volume is significant.

=cut

sub catpath {
    my ($self,$volume,$directory,$file) = @_;

    if ( $directory ne ''                && 
         $file ne ''                     && 
         substr( $directory, -1 ) ne '/' && 
         substr( $file, 0, 1 ) ne '/' 
    ) {
        $directory .= "/$file" ;
    }
    else {
        $directory .= $file ;
    }

    return $directory ;
}

=item abs2rel

Takes a destination path and an optional base path returns a relative path
from the base path to the destination path:

    $rel_path = File::Spec->abs2rel( $path ) ;
    $rel_path = File::Spec->abs2rel( $path, $base ) ;

If $base is not present or '', then L is used. If $base is relative, 
then it is converted to absolute form using L. This means that it
is taken to be relative to L.

On systems with the concept of a volume, this assumes that both paths 
are on the $destination volume, and ignores the $base volume. 

On systems that have a grammar that indicates filenames, this ignores the 
$base filename as well. Otherwise all path components are assumed to be
directories.

If $path is relative, it is converted to absolute form using L.
This means that it is taken to be relative to L.

No checks against the filesystem are made on most systems.  On MacOS,
the filesystem may be consulted (see
L).  On VMS, there is
interaction with the working environment, as logicals and
macros are expanded.

Based on code written by Shigio Yamaguchi.

=cut

sub abs2rel {
    my($self,$path,$base) = @_;

    # Clean up $path
    if ( ! $self->file_name_is_absolute( $path ) ) {
        $path = $self->rel2abs( $path ) ;
    }
    else {
        $path = $self->canonpath( $path ) ;
    }

    # Figure out the effective $base and clean it up.
    if ( !defined( $base ) || $base eq '' ) {
        $base = cwd() ;
    }
    elsif ( ! $self->file_name_is_absolute( $base ) ) {
        $base = $self->rel2abs( $base ) ;
    }
    else {
        $base = $self->canonpath( $base ) ;
    }

    # Now, remove all leading components that are the same
    my @pathchunks = $self->splitdir( $path);
    my @basechunks = $self->splitdir( $base);

    while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) {
        shift @pathchunks ;
        shift @basechunks ;
    }

    $path = CORE::join( '/', @pathchunks );
    $base = CORE::join( '/', @basechunks );

    # $base now contains the directories the resulting relative path 
    # must ascend out of before it can descend to $path_directory.  So, 
    # replace all names with $parentDir
    $base =~ s|[^/]+|..|g ;

    # Glue the two together, using a separator if necessary, and preventing an
    # empty result.
    if ( $path ne '' && $base ne '' ) {
        $path = "$base/$path" ;
    } else {
        $path = "$base$path" ;
    }

    return $self->canonpath( $path ) ;
}

=item rel2abs

Converts a relative path to an absolute path. 

    $abs_path = File::Spec->rel2abs( $path ) ;
    $abs_path = File::Spec->rel2abs( $path, $base ) ;

If $base is not present or '', then L is used. If $base is relative, 
then it is converted to absolute form using L. This means that it
is taken to be relative to L.

On systems with the concept of a volume, this assumes that both paths 
are on the $base volume, and ignores the $path volume. 

On systems that have a grammar that indicates filenames, this ignores the 
$base filename as well. Otherwise all path components are assumed to be
directories.

If $path is absolute, it is cleaned up and returned using L.

No checks against the filesystem are made on most systems.  On MacOS,
the filesystem may be consulted (see
L).  On VMS, there is
interaction with the working environment, as logicals and
macros are expanded.

Based on code written by Shigio Yamaguchi.

=cut

sub rel2abs {
    my ($self,$path,$base ) = @_;

    # Clean up $path
    if ( ! $self->file_name_is_absolute( $path ) ) {
        # Figure out the effective $base and clean it up.
        if ( !defined( $base ) || $base eq '' ) {
            $base = cwd() ;
        }
        elsif ( ! $self->file_name_is_absolute( $base ) ) {
            $base = $self->rel2abs( $base ) ;
        }
        else {
            $base = $self->canonpath( $base ) ;
        }

        # Glom them together
        $path = $self->catdir( $base, $path ) ;
    }

    return $self->canonpath( $path ) ;
}


=back

=head1 SEE ALSO

L

=cut

1;
cgi-bin/extlib/File/Spec/VMS.pm0000644002157400001440000003212407771550070023046 0ustar  minnesotaviolasociety.orgusers00000000000000package File::Spec::VMS;

use strict;
use vars qw(@ISA $VERSION);
require File::Spec::Unix;

$VERSION = '1.1';

@ISA = qw(File::Spec::Unix);

use Cwd;
use File::Basename;
use VMS::Filespec;

=head1 NAME

File::Spec::VMS - methods for VMS file specs

=head1 SYNOPSIS

 require File::Spec::VMS; # Done internally by File::Spec if needed

=head1 DESCRIPTION

See File::Spec::Unix for a documentation of the methods provided
there. This package overrides the implementation of these methods, not
the semantics.

=over

=item eliminate_macros

Expands MM[KS]/Make macros in a text string, using the contents of
identically named elements of C<%$self>, and returns the result
as a file specification in Unix syntax.

=cut

sub eliminate_macros {
    my($self,$path) = @_;
    return '' unless $path;
    $self = {} unless ref $self;

    if ($path =~ /\s/) {
      return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path;
    }

    my($npath) = unixify($path);
    my($complex) = 0;
    my($head,$macro,$tail);

    # perform m##g in scalar context so it acts as an iterator
    while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) { 
        if ($self->{$2}) {
            ($head,$macro,$tail) = ($1,$2,$3);
            if (ref $self->{$macro}) {
                if (ref $self->{$macro} eq 'ARRAY') {
                    $macro = join ' ', @{$self->{$macro}};
                }
                else {
                    print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}),
                          "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n";
                    $macro = "\cB$macro\cB";
                    $complex = 1;
                }
            }
            else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; }
            $npath = "$head$macro$tail";
        }
    }
    if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#gs; }
    $npath;
}

=item fixpath

Catchall routine to clean up problem MM[SK]/Make macros.  Expands macros
in any directory specification, in order to avoid juxtaposing two
VMS-syntax directories when MM[SK] is run.  Also expands expressions which
are all macro, so that we can tell how long the expansion is, and avoid
overrunning DCL's command buffer when MM[KS] is running.

If optional second argument has a TRUE value, then the return string is
a VMS-syntax directory specification, if it is FALSE, the return string
is a VMS-syntax file specification, and if it is not specified, fixpath()
checks to see whether it matches the name of a directory in the current
default directory, and returns a directory or file specification accordingly.

=cut

sub fixpath {
    my($self,$path,$force_path) = @_;
    return '' unless $path;
    $self = bless {} unless ref $self;
    my($fixedpath,$prefix,$name);

    if ($path =~ /\s/) {
      return join ' ',
             map { $self->fixpath($_,$force_path) }
	     split /\s+/, $path;
    }

    if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { 
        if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) {
            $fixedpath = vmspath($self->eliminate_macros($path));
        }
        else {
            $fixedpath = vmsify($self->eliminate_macros($path));
        }
    }
    elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) && $self->{$prefix}) {
        my($vmspre) = $self->eliminate_macros("\$($prefix)");
        # is it a dir or just a name?
        $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\Z(?!\n)/) ? vmspath($vmspre) : '';
        $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
        $fixedpath = vmspath($fixedpath) if $force_path;
    }
    else {
        $fixedpath = $path;
        $fixedpath = vmspath($fixedpath) if $force_path;
    }
    # No hints, so we try to guess
    if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) {
        $fixedpath = vmspath($fixedpath) if -d $fixedpath;
    }

    # Trim off root dirname if it's had other dirs inserted in front of it.
    $fixedpath =~ s/\.000000([\]>])/$1/;
    # Special case for VMS absolute directory specs: these will have had device
    # prepended during trip through Unix syntax in eliminate_macros(), since
    # Unix syntax has no way to express "absolute from the top of this device's
    # directory tree".
    if ($path =~ /^[\[>][^.\-]/) { $fixedpath =~ s/^[^\[<]+//; }
    $fixedpath;
}

=back

=head2 Methods always loaded

=over

=item canonpath (override)

Removes redundant portions of file specifications according to VMS syntax.

=cut

sub canonpath {
    my($self,$path) = @_;

    if ($path =~ m|/|) { # Fake Unix
      my $pathify = $path =~ m|/\Z(?!\n)|;
      $path = $self->SUPER::canonpath($path);
      if ($pathify) { return vmspath($path); }
      else          { return vmsify($path);  }
    }
    else {
      $path =~ s-\]\[--g;  $path =~ s/> foo.bar
      $path =~ s/([\[<])000000\./$1/;                   # [000000.foo     ==> foo
      1 while $path =~ s{([\[<-])\.-}{$1-};             # [.-.-           ==> [--
      $path =~ s/\.[^\[<\.]+\.-([\]\>])/$1/;            # bar.foo.-]      ==> bar]
      $path =~ s/([\[<])(-+)/$1 . "\cx" x length($2)/e; # encode leading '-'s
      $path =~ s/([\[<\.])([^\[<\.\cx]+)\.-\.?/$1/g;    # bar.-.foo       ==> foo
      $path =~ s/([\[<])(\cx+)/$1 . '-' x length($2)/e; # then decode
      return $path;
    }
}

=item catdir

Concatenates a list of file specifications, and returns the result as a
VMS-syntax directory specification.  No check is made for "impossible"
cases (e.g. elements other than the first being absolute filespecs).

=cut

sub catdir {
    my ($self,@dirs) = @_;
    my $dir = pop @dirs;
    @dirs = grep($_,@dirs);
    my $rslt;
    if (@dirs) {
	my $path = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs));
	my ($spath,$sdir) = ($path,$dir);
	$spath =~ s/\.dir\Z(?!\n)//; $sdir =~ s/\.dir\Z(?!\n)//; 
	$sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+\Z(?!\n)/s;
	$rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1);

	# Special case for VMS absolute directory specs: these will have had device
	# prepended during trip through Unix syntax in eliminate_macros(), since
	# Unix syntax has no way to express "absolute from the top of this device's
	# directory tree".
	if ($spath =~ /^[\[<][^.\-]/s) { $rslt =~ s/^[^\[<]+//s; }
    }
    else {
	if    (not defined $dir or not length $dir) { $rslt = ''; }
	elsif ($dir =~ /^\$\([^\)]+\)\Z(?!\n)/s)          { $rslt = $dir; }
	else                                        { $rslt = vmspath($dir); }
    }
    return $self->canonpath($rslt);
}

=item catfile

Concatenates a list of file specifications, and returns the result as a
VMS-syntax file specification.

=cut

sub catfile {
    my ($self,@files) = @_;
    my $file = pop @files;
    @files = grep($_,@files);
    my $rslt;
    if (@files) {
	my $path = (@files == 1 ? $files[0] : $self->catdir(@files));
	my $spath = $path;
	$spath =~ s/\.dir\Z(?!\n)//;
	if ($spath =~ /^[^\)\]\/:>]+\)\Z(?!\n)/s && basename($file) eq $file) {
	    $rslt = "$spath$file";
	}
	else {
	    $rslt = $self->eliminate_macros($spath);
	    $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file));
	}
    }
    else { $rslt = (defined($file) && length($file)) ? vmsify($file) : ''; }
    return $self->canonpath($rslt);
}


=item curdir (override)

Returns a string representation of the current directory: '[]'

=cut

sub curdir {
    return '[]';
}

=item devnull (override)

Returns a string representation of the null device: '_NLA0:'

=cut

sub devnull {
    return "_NLA0:";
}

=item rootdir (override)

Returns a string representation of the root directory: 'SYS$DISK:[000000]'

=cut

sub rootdir {
    return 'SYS$DISK:[000000]';
}

=item tmpdir (override)

Returns a string representation of the first writable directory
from the following list or '' if none are writable:

    sys$scratch
    $ENV{TMPDIR}

=cut

my $tmpdir;
sub tmpdir {
    return $tmpdir if defined $tmpdir;
    foreach ('sys$scratch', $ENV{TMPDIR}) {
	next unless defined && -d && -w _;
	$tmpdir = $_;
	last;
    }
    $tmpdir = '' unless defined $tmpdir;
    return $tmpdir;
}

=item updir (override)

Returns a string representation of the parent directory: '[-]'

=cut

sub updir {
    return '[-]';
}

=item case_tolerant (override)

VMS file specification syntax is case-tolerant.

=cut

sub case_tolerant {
    return 1;
}

=item path (override)

Translate logical name DCL$PATH as a searchlist, rather than trying
to C string value of C<$ENV{'PATH'}>.

=cut

sub path {
    my (@dirs,$dir,$i);
    while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); }
    return @dirs;
}

=item file_name_is_absolute (override)

Checks for VMS directory spec as well as Unix separators.

=cut

sub file_name_is_absolute {
    my ($self,$file) = @_;
    # If it's a logical name, expand it.
    $file = $ENV{$file} while $file =~ /^[\w\$\-]+\Z(?!\n)/s && $ENV{$file};
    return scalar($file =~ m!^/!s             ||
		  $file =~ m![<\[][^.\-\]>]!  ||
		  $file =~ /:[^<\[]/);
}

=item splitpath (override)

Splits using VMS syntax.

=cut

sub splitpath {
    my($self,$path) = @_;
    my($dev,$dir,$file) = ('','','');

    vmsify($path) =~ /(.+:)?([\[<].*[\]>])?(.*)/s;
    return ($1 || '',$2 || '',$3);
}

=item splitdir (override)

Split dirspec using VMS syntax.

=cut

sub splitdir {
    my($self,$dirspec) = @_;
    $dirspec =~ s/\]\[//g;  $dirspec =~ s/\-\-/-.-/g;
    $dirspec = "[$dirspec]" unless $dirspec =~ /[\[<]/; # make legal
    my(@dirs) = split('\.', vmspath($dirspec));
    $dirs[0] =~ s/^[\[<]//s;  $dirs[-1] =~ s/[\]>]\Z(?!\n)//s;
    @dirs;
}


=item catpath (override)

Construct a complete filespec using VMS syntax

=cut

sub catpath {
    my($self,$dev,$dir,$file) = @_;
    if ($dev =~ m|^/+([^/]+)|) { $dev = "$1:"; }
    else { $dev .= ':' unless $dev eq '' or $dev =~ /:\Z(?!\n)/; }
    if (length($dev) or length($dir)) {
      $dir = "[$dir]" unless $dir =~ /[\[<\/]/;
      $dir = vmspath($dir);
    }
    "$dev$dir$file";
}

=item abs2rel (override)

Use VMS syntax when converting filespecs.

=cut

sub abs2rel {
    my $self = shift;

    return vmspath(File::Spec::Unix::abs2rel( $self, @_ ))
        if ( join( '', @_ ) =~ m{/} ) ;

    my($path,$base) = @_;

    # Note: we use '/' to glue things together here, then let canonpath()
    # clean them up at the end.

    # Clean up $path
    if ( ! $self->file_name_is_absolute( $path ) ) {
        $path = $self->rel2abs( $path ) ;
    }
    else {
        $path = $self->canonpath( $path ) ;
    }

    # Figure out the effective $base and clean it up.
    if ( !defined( $base ) || $base eq '' ) {
        $base = cwd() ;
    }
    elsif ( ! $self->file_name_is_absolute( $base ) ) {
        $base = $self->rel2abs( $base ) ;
    }
    else {
        $base = $self->canonpath( $base ) ;
    }

    # Split up paths
    my ( $path_directories, $path_file ) =
        ($self->splitpath( $path, 1 ))[1,2] ;

    $path_directories = $1
        if $path_directories =~ /^\[(.*)\]\Z(?!\n)/s ;

    my $base_directories = ($self->splitpath( $base, 1 ))[1] ;

    $base_directories = $1
        if $base_directories =~ /^\[(.*)\]\Z(?!\n)/s ;

    # Now, remove all leading components that are the same
    my @pathchunks = $self->splitdir( $path_directories );
    my @basechunks = $self->splitdir( $base_directories );

    while ( @pathchunks && 
            @basechunks && 
            lc( $pathchunks[0] ) eq lc( $basechunks[0] ) 
          ) {
        shift @pathchunks ;
        shift @basechunks ;
    }

    # @basechunks now contains the directories to climb out of,
    # @pathchunks now has the directories to descend in to.
    $path_directories = '-.' x @basechunks . join( '.', @pathchunks ) ;
    $path_directories =~ s{\.\Z(?!\n)}{} ;
    return $self->canonpath( $self->catpath( '', $path_directories, $path_file ) ) ;
}


=item rel2abs (override)

Use VMS syntax when converting filespecs.

=cut

sub rel2abs {
    my $self = shift ;
    return vmspath(File::Spec::Unix::rel2abs( $self, @_ ))
        if ( join( '', @_ ) =~ m{/} ) ;

    my ($path,$base ) = @_;
    # Clean up and split up $path
    if ( ! $self->file_name_is_absolute( $path ) ) {
        # Figure out the effective $base and clean it up.
        if ( !defined( $base ) || $base eq '' ) {
            $base = cwd() ;
        }
        elsif ( ! $self->file_name_is_absolute( $base ) ) {
            $base = $self->rel2abs( $base ) ;
        }
        else {
            $base = $self->canonpath( $base ) ;
        }

        # Split up paths
        my ( $path_directories, $path_file ) =
            ($self->splitpath( $path ))[1,2] ;

        my ( $base_volume, $base_directories ) =
            $self->splitpath( $base ) ;

        $path_directories = '' if $path_directories eq '[]' ||
                                  $path_directories eq '<>';
        my $sep = '' ;
        $sep = '.'
            if ( $base_directories =~ m{[^.\]>]\Z(?!\n)} &&
                 $path_directories =~ m{^[^.\[<]}s
            ) ;
        $base_directories = "$base_directories$sep$path_directories";
        $base_directories =~ s{\.?[\]>][\[<]\.?}{.};

        $path = $self->catpath( $base_volume, $base_directories, $path_file );
   }

    return $self->canonpath( $path ) ;
}


=back

=head1 SEE ALSO

L

=cut

1;
cgi-bin/extlib/File/Spec/Win32.pm0000644002157400001440000002102307771550070023277 0ustar  minnesotaviolasociety.orgusers00000000000000package File::Spec::Win32;

use strict;
use Cwd;
use vars qw(@ISA $VERSION);
require File::Spec::Unix;

$VERSION = '1.2';

@ISA = qw(File::Spec::Unix);

=head1 NAME

File::Spec::Win32 - methods for Win32 file specs

=head1 SYNOPSIS

 require File::Spec::Win32; # Done internally by File::Spec if needed

=head1 DESCRIPTION

See File::Spec::Unix for a documentation of the methods provided
there. This package overrides the implementation of these methods, not
the semantics.

=over

=item devnull

Returns a string representation of the null device.

=cut

sub devnull {
    return "nul";
}

=item tmpdir

Returns a string representation of the first existing directory
from the following list:

    $ENV{TMPDIR}
    $ENV{TEMP}
    $ENV{TMP}
    /tmp
    /

=cut

my $tmpdir;
sub tmpdir {
    return $tmpdir if defined $tmpdir;
    my $self = shift;
    foreach (@ENV{qw(TMPDIR TEMP TMP)}, qw(/tmp /)) {
	next unless defined && -d;
	$tmpdir = $_;
	last;
    }
    $tmpdir = '' unless defined $tmpdir;
    $tmpdir = $self->canonpath($tmpdir);
    return $tmpdir;
}

sub case_tolerant {
    return 1;
}

sub file_name_is_absolute {
    my ($self,$file) = @_;
    return scalar($file =~ m{^([a-z]:)?[\\/]}is);
}

=item catfile

Concatenate one or more directory names and a filename to form a
complete path ending with a filename

=cut

sub catfile {
    my $self = shift;
    my $file = pop @_;
    return $file unless @_;
    my $dir = $self->catdir(@_);
    $dir .= "\\" unless substr($dir,-1) eq "\\";
    return $dir.$file;
}

sub path {
    my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'};
    my @path = split(';',$path);
    foreach (@path) { $_ = '.' if $_ eq '' }
    return @path;
}

=item canonpath

No physical check on the filesystem, but a logical cleanup of a
path. On UNIX