X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=site_perl%2FCGI.pm;h=b21a88837b1d2c0111d698ec2f939fc9cb3d9055;hb=09a5eb8c6c43659d31fc043f556e404dcf322b13;hp=0e6daeebcbd8beb42357dfe1dc2e2f9d50f4ca1f;hpb=e6f96a8435359ef6d24d16ec69650172c7e6b5ce;p=freeside.git diff --git a/site_perl/CGI.pm b/site_perl/CGI.pm index 0e6daeebc..b21a88837 100644 --- a/site_perl/CGI.pm +++ b/site_perl/CGI.pm @@ -4,11 +4,12 @@ use strict; use vars qw(@EXPORT_OK @ISA); use Exporter; use CGI; +use URI::URL; use CGI::Carp qw(fatalsToBrowser); use FS::UID; @ISA = qw(Exporter); -@EXPORT_OK = qw(header menubar idiot eidiot); +@EXPORT_OK = qw(header menubar idiot eidiot popurl table); =head1 NAME @@ -16,7 +17,7 @@ FS::CGI - Subroutines for the web interface =head1 SYNOPSIS - use FS::CGI qw(header menubar idiot eidiot); + use FS::CGI qw(header menubar idiot eidiot popurl); print header( 'Title', '' ); print header( 'Title', menubar('item', 'URL', ... ) ); @@ -24,6 +25,9 @@ FS::CGI - Subroutines for the web interface idiot "error message"; eidiot "error message"; + $url = popurl; #returns current url + $url = popurl(3); #three levels up + =head1 DESCRIPTION Provides a few common subroutines for the web interface. @@ -82,7 +86,13 @@ Sends headers and an HTML error message. sub idiot { my($error)=@_; my($cgi)=FS::UID::cgi; - print $cgi->header, <isa('CGI::Base') ) { + no strict 'subs'; + &CGI::Base::SendHeaders; + } else { + print $cgi->header; + } + print < Error processing your request @@ -111,6 +121,34 @@ sub eidiot { exit; } +=item popurl LEVEL + +Returns current URL with LEVEL levels of path removed from the end (default 0). + +=cut + +sub popurl { + my($up)=@_; + my($cgi)=&FS::UID::cgi; + my($url)=new URI::URL $cgi->url; + my(@path)=$url->path_components; + splice @path, 0-$up; + $url->path_components(@path); + my $x = $url->as_string; + $x .= '/' unless $x =~ /\/$/; + $x; +} + +=item table + +Returns HTML tag for beginning a table. + +=cut + +sub table { + ""; +} + =back =head1 BUGS @@ -119,11 +157,9 @@ Not OO. Not complete. -Uses CGI-modules instead of CGI.pm - =head1 SEE ALSO -L +L, L =head1 HISTORY @@ -137,7 +173,28 @@ lose the background, eidiot ivan@sisd.com 98-sep-2 pod ivan@sisd.com 98-sep-12 $Log: CGI.pm,v $ -Revision 1.3 1998-11-08 10:50:19 ivan +Revision 1.12 1998-12-23 02:23:16 ivan +popurl always has trailing slash + +Revision 1.11 1998/11/12 07:43:54 ivan +*** empty log message *** + +Revision 1.10 1998/11/12 01:53:47 ivan +added table command + +Revision 1.9 1998/11/09 08:51:49 ivan +bug squash + +Revision 1.7 1998/11/09 06:10:59 ivan +added sub url + +Revision 1.6 1998/11/09 05:44:20 ivan +*** empty log message *** + +Revision 1.4 1998/11/09 04:55:42 ivan +support depriciated CGI::Base as well as CGI.pm (for now) + +Revision 1.3 1998/11/08 10:50:19 ivan s/CGI::Base/CGI/; etc.