args function + default headers

diff --git a/lib/perl/NB/CGI.pm b/lib/perl/NB/CGI.pm
index ee8721469d0d6ae958782d16733d10ab79f3993c..55b5e77f938127e744ad1bfa95ca6062f815333d 100644 (file)
--- a/lib/perl/NB/CGI.pm
+++ b/lib/perl/NB/CGI.pm
@@ -188,10 +188,55 @@ sub header_status {
   return ($ENV{SERVER_PROTOCOL}||'HTTP/1.1')." $status\r\n";
 }
 
+sub args2hash {
+  my @p = @_;
+  my %hash;
+  #warn join('|',@p);
+
+  for (my $i=0;$i<@p-1;$i++)
+  {
+               #next if index($p[$i], '-') == -1;
+               next if $p[$i] !~ /^-(.*)$/;
+               $hash{$1} = $p[$i+1];
+               #warn $1."=".$hash{$1};
+  }
+
+  return wantarray ? %hash : \%hash;
+}
+
+sub argsAdd {
+  my $p = shift;
+  my $key = shift; $key = "-$key";
+  my $val = shift;
+
+  # Delete existing
+  for (my $i=0;$i<@$p-1;$i++)
+  {
+               next if $p->[$i] ne $key;
+               splice(@$p,$i,2);
+  }
+
+  # Add new one
+  #push(@$p,$key,$val);
+  unshift(@$p,$key,$val);
+  return &args2hash(@$p);
+}
+
 sub header {
   return "" if $NO_HEADERS;
   my($self,@p) = &CGI::self_or_default(@_);
-  # NB 27.11.23 my $status = '200 OK';
+  my %p = &args2hash(@p);
+  #&argsAdd(\@p,'expires',-1) unless $p{expires};
+  # Cache-Control: private, no-cache, no-store, must-revalidate, post-check=0, pre-check=0
+  if ($p{expires}||0 <0)
+  {
+       %p = &argsAdd(\@p,'Cache-Control','private, no-cache, no-store, must-revalidate, post-check=0, pre-check=0');
+       %p = &argsAdd(\@p,'Pragma','no-cache');
+  }
+  #warn join('|',@p);
+  #warn join('|',keys(%p));
+  #die join('|',keys(%p));
+  #die $p{expires};
   my $status = '';
 
   if (!&CGI::nph())