cache foo

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

index 3577c14..f0fec43 100644 (file)
--- a/FS/FS/CGI.pm
+++ b/FS/FS/CGI.pm
@@ -1,7 +1,7 @@
  package FS::CGI;
  
  use strict;
-use vars qw(@EXPORT_OK @ISA);
+use vars qw(@EXPORT_OK @ISA @header);
  use Exporter;
  use CGI;
  use URI::URL;
@@ -11,6 +11,10 @@ use FS::UID;
  @ISA = qw(Exporter);
  @EXPORT_OK = qw(header menubar idiot eidiot popurl table itable ntable);
  
+@header = ( '-Expires' => '-1',
+            '-Pragma' => 'no-cache',
+            '-Cache-Control' => 'no-cache' );
+
  =head1 NAME
  
  FS::CGI - Subroutines for the web interface
@@ -43,7 +47,9 @@ Returns an HTML header.
  =cut
  
  sub header {
-  my($title,$menubar)=@_;
+  my($title,$menubar,$etc)=@_; #$etc is for things like onLoad= etc.
+  use Carp;
+  $etc = '' unless defined $etc;
  
    my $x =  <<END;
      <HTML>
@@ -52,7 +58,7 @@ sub header {
            $title
          </TITLE>
        </HEAD>
-      <BODY BGCOLOR="#e8e8e8">
+      <BODY BGCOLOR="#e8e8e8"$etc>
            <FONT SIZE=7>
              $title
            </FONT>
@@ -89,12 +95,12 @@ sub idiot {
    #warn "idiot depriciated";
    my($error)=@_;
    my $cgi = &FS::UID::cgi();
-  if ( $cgi->isa('CGI::Base') ) {
-    no strict 'subs';
-    &CGI::Base::SendHeaders;
-  } else {
-    print $cgi->header( '-expires' => 'now' );
-  }
+#  if ( $cgi->isa('CGI::Base') ) {
+#    no strict 'subs';
+#    &CGI::Base::SendHeaders;
+#  } else {
+    print $cgi->header( @FS::CGI::header );
+#  }
    print <<END;
  <HTML>
    <HEAD>
@@ -121,9 +127,17 @@ Sends headers and an HTML error message, then exits.
  =cut
  
  sub eidiot {
-  #warn "eidiot depriciated";
+  warn "eidiot depriciated";
    idiot(@_);
-  exit;
+  if (exists $ENV{MOD_PERL}) {
+    $main::Response->End()
+      if defined $main::Response
+         && $main::Response->isa('Apache::ASP::Response');
+    require Apache;
+    Apache::exit();
+  } else {
+    exit;
+  }
  }
  
  =item popurl LEVEL
@@ -134,8 +148,8 @@ Returns current URL with LEVEL levels of path removed from the end (default 0).
  
  sub popurl {
    my($up)=@_;
-  my($cgi)=&FS::UID::cgi;
-  my($url)=new URI::URL $cgi->url;
+  my $cgi = &FS::UID::cgi;
+  my $url = new URI::URL ( $cgi->isa('Apache') ? $cgi->uri : $cgi->url );
    my(@path)=$url->path_components;
    splice @path, 0-$up;
    $url->path_components(@path);