#!/usr/bin/perl
# ----------------------------------------------------------------------------
# This software is Copyright (C) 2007, All Rights Reserved
# ----------------------------------------------------------------------------
# This program is protected by local and international copyright laws. Any
# use of this program is subject to the the terms of the license agreement
# included as part of this distribution archive. Any other uses are strictly
# prohibited without the written permission of the Vendor and all
# other rights are reserved.
# -----------------------------------------------------------------------------
# Warning : Modifying this program violates your license agreement!
# -----------------------------------------------------------------------------

package IT::Cookie;

use strict;

use IT::Globals;

# library globals
use vars qw($TESTPLAN_MODE);
$TESTPLAN_MODE = 0;   # have functions return extra info when in testplan mode

# ----------------------------------------------------------------------------
# Function    : setCookie
# Description : print a cookie header to set a cookie in the users browser.
#               This function must be called before the content header is sent.
#               Cookies have a max size of 4k and each host can send up to 20.
#               Individual browsers may have different limits.
# Usage       : &IT::Cookie::setCookie("name", "value", [$expiryDate]);
#
# Arguments   : $expiryDate - cookie will be deleted at this date. Must be in
#               time() format.  Gets converted to Wdy, DD-Mon-YYYY HH:MM:SS GMT
#
# IIS/5.0 Bug : Set-Cookie Is Ignored in CGI When Combined With Location
#               http://support.microsoft.com/kb/q176113/
#               (solution: use alternative redirect (meta tag or javascript based)
#
# ----------------------------------------------------------------------------

sub setCookie {
  my($name, $value, $expiryTime) = @_;

  # error checking
  my $returnValueExpected = defined wantarray;
  if ($returnValueExpected && !$TESTPLAN_MODE) { &IT::Error::dieAsCaller("return value expected from function that doesn't return anything!"); }
  if ($IT::Common::CONTENT_TYPE_CALL_COUNT)    { &IT::Error::dieAsCaller("setCookie must be called BEFORE content header is sent!"); }
  if ($name eq '')                             { &IT::Error::dieAsCaller("Cookie name must be specified!"); }
  if ($name =~ /^\$/)                          { &IT::Error::dieAsCaller("Cookie names may not start with '\$' (RFC 2109)!"); }
  if ($expiryTime =~ /[^0-9]/)                 { &IT::Error::dieAsCaller("expiryTime must be a time() value or undefined!"); }
  if (@_ > 3)                                  { &IT::Error::dieAsCaller("setCookie only takes 3 arguments!"); }

  # create cookie header
  my $cookieHeader = "Set-Cookie: ";
  $cookieHeader .= join "=", &IT::Common::urlEncode($name), &IT::Common::urlEncode($value);
  if ($expiryTime) {
    $cookieHeader .= "; expires=";
    $cookieHeader .= &_convertTimeToCookieDateString($expiryTime);
  }
  $cookieHeader .= $CRLF;

  if ($TESTPLAN_MODE) { return $cookieHeader; }
  else                { print $cookieHeader; }
}

# ----------------------------------------------------------------------------
# Function    : getCookies
# Description : parse the cookie header sent by the users browser and return a
#               hash of cookie names and values
# Usage       : $COOKIE = &IT::Cookie::getCookies();
# ----------------------------------------------------------------------------

sub getCookies {
  if (@_) { die "no args allowed!"; }
  my $cookies = {};

  foreach my $cookie (split(/; /, $ENV{'HTTP_COOKIE'})) {
    my($encodedName, $encodedValue) = split(/=/,$cookie);

    my $name  = &IT::Common::urlDecode($encodedName);
    my $value = &IT::Common::urlDecode($encodedValue);

    if (!exists $cookies->{$name}) {
      $cookies->{$name} = $value;
    }
  }

  return $cookies;
}

# ----------------------------------------------------------------------------
# Function    : _convertTimeToCookieDateString
# Description : convert time() value to the following date format:
#               Wdy, DD-Mon-YYYY HH:MM:SS GMT  <-- format
#               Mon, 01-Jan-1999 HH:MM:SS GMT  <-- example
# Usage       : my $dateString = &_convertTimeToCookieDateString($time);
# ----------------------------------------------------------------------------

sub _convertTimeToCookieDateString {
  my $time = shift;

  my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($time);
  $year += 1900;

  my @shortWeekdayNames = qw(Sun Mon Tue Wed Thu Fri Sat Sun);
  my $shortWeekdayName  = $shortWeekdayNames[$wday];

  my @shortMonthNames   = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
  my $shortMonthName    =  $shortMonthNames[$mon];

  # example format:       Mon, 01-Jan-1999 HH:MM:SS GMT
  my $dateString        = sprintf("%s, %02d-%s-%d %02d:%02d:%02d GMT", $shortWeekdayName, $mday, $shortMonthName, $year, $hour, $min, $sec);


  return $dateString;
}

# ----------------------------------------------------------------------------
# end of file
1;

