First pass at adding key files

2024-06-17 21:49:12 +10:00
commit aa25e9347f
1274 changed files with 392549 additions and 0 deletions
--- a/site/slowtwitch.com/cgi-bin/articles/GT/CGI/Cookie.pm
+++ b/site/slowtwitch.com/cgi-bin/articles/GT/CGI/Cookie.pm
@ -0,0 +1,103 @@
+# ==================================================================
+# Gossamer Threads Module Library - http://gossamer-threads.com/
+#
+#   GT::CGI::Cookie
+#   CVS Info : 087,071,086,086,085      
+#   $Id: Cookie.pm,v 1.7 2008/06/09 23:39:47 brewt Exp $
+# 
+# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
+# ==================================================================
+#
+# Description:
+#   Handles cookie creation and formatting
+#
+
+package GT::CGI::Cookie;
+#================================================================================
+
+use strict;
+use GT::CGI;
+use GT::Base;
+use vars qw/@ISA $ATTRIBS @MON @WDAY/;
+
+@ISA = qw/GT::Base/;
+
+$ATTRIBS = {
+    -name     => '',
+    -value    => '',
+    -expires  => '',
+    -path     => '',
+    -domain   => '',
+    -secure   => '',
+    -httponly => '',
+};
+@MON  = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
+@WDAY = qw/Sun Mon Tue Wed Thu Fri Sat/;
+
+sub cookie_header {
+#--------------------------------------------------------------------------------
+# Returns a cookie header.
+#
+    my $self    = shift;
+
+# make sure we have a name to use
+    $self->{-name} or return;
+
+    my $name  = GT::CGI::escape($self->{-name});
+    my $value = GT::CGI::escape($self->{-value});
+
+# build the header that creates the cookie
+    my $header = "Set-Cookie: $name=$value";
+
+    $self->{-expires} and $header .= "; expires=" . $self->format_date('-', $self->{-expires});
+    if (my $path = $self->{-path}) { $path =~ s/[\x00-\x1f].*//s; $header .= "; path=$path"; }
+    if (my $domain = $self->{-domain}) { $domain =~ s/[\x00-\x1f].*//s; $header .= "; domain=$domain"; }
+    $self->{-secure}  and $header .= "; secure";
+    $self->{-httponly} and $header .= "; httponly";
+
+    return $header;
+}
+
+sub format_date {
+# -------------------------------------------------------------------
+# Returns a string in http_gmt format, but accepts one in unknown format.
+#   Wed, 23 Aug 2000 21:20:14 GMT
+#
+    my ($self, $sep, $datestr) = @_;
+    my $unix_time = defined $datestr ? $self->expire_calc($datestr) : time;
+
+    my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($unix_time);
+    $year += 1900;
+
+    return sprintf(
+        "%s, %02d$sep%s$sep%04d %02d:%02d:%02d GMT",
+        $WDAY[$wday], $mday, $MON[$mon], $year, $hour, $min, $sec
+    );
+}
+*_format_date = \&format_date; # deprecated
+
+sub expire_calc {
+# -------------------------------------------------------------------
+# Calculates when a date based on +- times. See CGI.pm for more info.
+#
+    my ($self, $time) = @_;
+    my %mult = (s => 1, m => 60, h => 3600, d => 86400, M => 2592000, y => 31536000);
+    my $offset;
+
+    if (!$time or lc $time eq 'now') {
+        $offset = 0;
+    }
+    elsif ($time =~ /^\d/) {
+        return $time;
+    }
+    elsif ($time=~/^([+-]?(?:\d+(?:\.\d*)?|\.\d+))([smhdMy]?)/) {
+        $offset = $1 * ($mult{$2} || 1);
+    }
+    else {
+        return $time;
+    }
+    return time + $offset;
+}
+*_expire_calc = \&expire_calc; # deprecated
+
+1;