*** empty log message ***

[freeside.git] / site_perl / CGI.pm
diff --git a/site_perl/CGI.pm b/site_perl/CGI.pm

index 65bf201..3ce53de 100644 (file)
--- a/site_perl/CGI.pm
+++ b/site_perl/CGI.pm
@@ -9,7 +9,7 @@ use CGI::Carp qw(fatalsToBrowser);
  use FS::UID;
  
  @ISA = qw(Exporter);
-@EXPORT_OK = qw(header menubar idiot eidiot popurl table);
+@EXPORT_OK = qw(header menubar idiot eidiot popurl table itable ntable);
  
  =head1 NAME
  
@@ -45,21 +45,21 @@ Returns an HTML header.
  sub header {
    my($title,$menubar)=@_;
  
-  <<END;
+  my $x =  <<END;
      <HTML>
        <HEAD>
          <TITLE>
            $title
          </TITLE>
        </HEAD>
-      <BODY BGCOLOR="#ffffff">
-          <FONT COLOR="#FF0000" SIZE=7>
+      <BODY BGCOLOR="#e8e8e8">
+          <FONT SIZE=7>
              $title
            </FONT>
            <BR><BR>
-          $menubar
-      <BR><BR>
  END
+  $x .=  $menubar. "<BR><BR>" if $menubar;
+  $x;
  }
  
  =item menubar ITEM, URL, ...
@@ -79,18 +79,21 @@ sub menubar { #$menubar=menubar('Main Menu', '../', 'Item', 'url', ... );
  
  =item idiot ERROR
  
+This is depriciated.  Don't use it.
+
  Sends headers and an HTML error message.
  
  =cut
  
  sub idiot {
+  #warn "idiot depriciated";
    my($error)=@_;
-  my($cgi)=FS::UID::cgi;
+  my $cgi = &FS::UID::cgi();
    if ( $cgi->isa('CGI::Base') ) {
      no strict 'subs';
      &CGI::Base::SendHeaders;
    } else {
-    print $cgi->header;
+    print $cgi->header( '-expires' => 'now' );
    }
    print <<END;
  <HTML>
@@ -103,7 +106,6 @@ sub idiot {
      </CENTER>
      Your request could not be processed because of the following error:
      <P><B>$error</B>
-    <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and try again.
    </BODY>
  </HTML>
  END
@@ -112,11 +114,14 @@ END
  
  =item eidiot ERROR
  
+This is depriciated.  Don't use it.
+
  Sends headers and an HTML error message, then exits.
  
  =cut
  
  sub eidiot {
+  #warn "eidiot depriciated";
    idiot(@_);
    exit;
  }
@@ -134,7 +139,9 @@ sub popurl {
    my(@path)=$url->path_components;
    splice @path, 0-$up;
    $url->path_components(@path);
-  $url->as_string;
+  my $x = $url->as_string;
+  $x .= '/' unless $x =~ /\/$/;
+  $x;
  }
  
  =item table
@@ -144,7 +151,45 @@ Returns HTML tag for beginning a table.
  =cut
  
  sub table {
-  "<TABLE BORDER=1>";
+  my $col = shift;
+  if ( $col ) {
+    qq!<TABLE BGCOLOR="$col" BORDER=1 WIDTH="100%">!;
+  } else { 
+    "<TABLE BORDER=1>";
+  }
+}
+
+=item itable
+
+Returns HTML tag for beginning an (invisible) table.
+
+=cut
+
+sub itable {
+  my $col = shift;
+  my $cellspacing = shift || 0;
+  if ( $col ) {
+    qq!<TABLE BGCOLOR="$col" BORDER=0 CELLSPACING=$cellspacing WIDTH="100%">!;
+  } else {
+    qq!<TABLE BORDER=0 CELLSPACING=$cellspacing WIDTH="100%">!;
+  }
+}
+
+=item ntable
+
+This is getting silly.
+
+=cut
+
+sub ntable {
+  my $col = shift;
+  my $cellspacing = shift || 0;
+  if ( $col ) {
+    qq!<TABLE BGCOLOR="$col" BORDER=0 CELLSPACING=$cellspacing>!;
+  } else {
+    "<TABLE BORDER>";
+  }
+
  }
  
  =back
@@ -171,7 +216,26 @@ lose the background, eidiot ivan@sisd.com 98-sep-2
  pod ivan@sisd.com 98-sep-12
  
  $Log: CGI.pm,v $
-Revision 1.11  1998-11-12 07:43:54  ivan
+Revision 1.18  1999-04-15 15:22:12  ivan
+make &idiot() work, yuck.
+
+Revision 1.17  1999/02/07 09:59:43  ivan
+more mod_perl fixes, and bugfixes Peter Wemm sent via email
+
+Revision 1.16  1999/01/25 12:26:05  ivan
+yet more mod_perl stuff
+
+Revision 1.15  1999/01/18 09:41:48  ivan
+all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+(good idea anyway)
+
+Revision 1.14  1999/01/18 09:22:37  ivan
+changes to track email addresses for email invoicing
+
+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