binbash12/Ryan Parker's - Perl CGI Module

## Ryan Parker's - Perl CGI Module
# ryan's cgi
# created by Ryan J. Parker
# run 'perldoc rcgi' to read class documentation

# lol, just found and posted by Matthew Cluver to show Ryan his back in the day skillz...

package rcgi;

# called when creating the rcgi class
sub new()
{
	my $self = {};
	bless $self;
	return($self);
}

# print a content-type header
# if no content-type is passed to the routine,
# then a text/html content-type will be printed.
sub print_header()
{
	my ($self,$content_type) = @_;
	$content_type = $content_type || "text/html";
	print "Content-type: $content_type\n\n";
}

# prints a cookie header.. name and value _must_ be passed!
sub print_cookie_header()
{
	my ($self,%passed) = @_;
	my $error	= "error printing cookie: ";
	my $cookie	= "Set-Cookie: ";
	if (!$passed{'name'} || !$passed{'value'}) {
		$error .= "name and value not passed.";
		$self->print_herror_exit($error);
	}
	$cookie .= escape($self,$passed{'name'}) . "=";
	$cookie .= escape($self,$passed{'value'}) . "; ";
	if (defined($passed{'expires'})) {
		$cookie .= "expires=" . $self->cookie_date($self->expire_calc($passed{'expires'})) . "; ";
	}
	if (defined($passed{'domain'})) {
		$cookie .= "domain=$passed{'domain'}; ";
	}
	if (defined($passed{'path'})) {
		$cookie .= "path=$passed{'path'};";
	}
	print "$cookie\n";
	return($cookie);
}

# prints a header and error-passed to routine
sub print_herror()
{
	my ($self,$error) = @_;
	$self->print_header();
	print "<html><body>\n";
	print "$error\n";
	print "</body></html>\n";
}

# prints a header and error-passed to routine-and exits
sub print_herror_exit()
{
	my ($self,$error) = @_;
	$self->print_header();
	print "<html><title>ERROR</title><body>$error</body></html>\n";
	exit(1);
}

# prints an error-passed to routine
sub print_error()
{
	my ($self,$error) = @_;
	print "<html><body>\n";
	print "$error\n";
	print "</body></html>\n";
}

# prints an error-passed to routine-and exits
sub print_error_exit()
{
	my ($self,$error) = @_;
	print "$error\n";
	exit(1);
}

# reads data input and returns a %data hash
sub get_data()
{
	my $query_string;
	my $method = $ENV{'REQUEST_METHOD'};
	my (%data,$param,$value);
	if ($method eq "GET") {
		$query_string = $ENV{'QUERY_STRING'};
	} else {
		read(STDIN, $query_string, $ENV{'CONTENT_LENGTH'});
	}
	my @items = split('&', $query_string);
	foreach (@items)
	{
		($param,$value) = split('=');
		$param = unescape($self,$param);
		$value = unescape($self,$value);
		if (exists($data{$param})) {
			$data{$param} .= ",$value";
		} else {
			$data{$param} = $value;
		}
	}
	return(%data);
}

# reads cookies and returns a %cookies hash
sub get_cookies()
{
	my $http_cookie = $ENV{'HTTP_COOKIE'};
	my %cookies;
	my @items = split(';', $http_cookie);
	foreach (@items)
	{
		($name,$value) = split('=');
		$cookies{unescape($self,$name)} = unescape($self,$value);
	}
	return(%cookies);
}

# unescapes a string
sub unescape()
{
	my ($self,$string) = @_;
	# turn pluses into spaces
	$string =~ tr/+/ /;
	$string =~ s/%([0-9a-fA-F]{2})/pack("c", hex($1))/ge;
	return($string)
}

# escapes a string
sub escape()
{
	my ($self,$string) = @_;
	$string =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
	return($string);
}

# calculates the time for cookie to expire...
sub expire_calc()
{
	my ($self,$time) = @_;
	my (%mult) = ('s'=>1,
		      'm'=>60,
		      'h'=>60*60,
		      'd'=>60*60*24,
		      'M'=>60*60*24*30,
		      'y'=>60*60*24*365);
	my ($offset);
	if (!time || ($time eq 'now')) {
		$offset = 0;
	} elsif ($time =~ /^([+-]?\d+)([mhdMy]?)/) {
		$offset = ($mult{$2} || 1)*$1;
	} else {
		return($time);
	}
	return(time+$offset);
}

# creates the date string suitable for a cookie header...
sub cookie_date()
{
	my ($self,$time) = @_;
	my (@MON)  = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
	my (@WDAY) = qw/Sun Mon Tue Wed Thu Fri Sat/;

	# return pre-formatted dates...
	if ("$time" =~ m/^[^0-9]/o) {
		return($time);
	}
	my ($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time);
	$year += 1900;
	return(sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",
		$WDAY[$wday],$mday,$MON[$mon],$year,$hour,$min,$sec));
}

# prints a form html tag
# action	=> "action"	(url called when form is submitted.)
# enctype	=> "enctype"	(encoding type..)
# method	=> "method"	(method used to send data)
# target	=> "target"	(where the form is show.. eg. frame, or -
#				 above the other frames, or in a new -
#				 window, etc.)
sub form()
{
	my ($self,%passed) = @_;
	my $form = "<form";
	if (defined($passed{'action'})) {
		$form .= " action=\"$passed{'action'}\"";
	}
	if (defined($passed{'enctype'})) {
		$form .= " enctype=\"$passed{'enctype'}\"";
	}
	if (defined($passed{'method'})) {
		$form .= " method=\"$passed{'method'}\"";
	}
	if (defined($passed{'target'})) {
		$form .= " target=\"$passed{'target'}\"";
	}
	$form .= ">\n";
	print $form;
}

# prints the end of a form
sub end_form()
{
	print "</form>\n";
}

# prints an input html tag...
# type => "type" specifies the type.... etc.
sub input()
{
	my ($self,%passed) = @_;
	my $input = "<input";
	if (defined($passed{'type'})) {
		$input .= " type=\"$passed{'type'}\"";
	}
	if (defined($passed{'name'})) {
		$input .= " name=\"$passed{'name'}\"";
	}
	if (defined($passed{'value'})) {
		$input .= " value=\"$passed{'value'}\"";
	}
	if (defined($passed{'size'})) {
		$input .= " size=\"$passed{'size'}\"";
	}
	if (defined($passed{'src'})) {
		$input .= " src=\"$passed{'src'}\" border=\"0\"";
	}
	if (defined($passed{'maxlength'})) {
		$input .= " maxlength=\"$passed{'maxlength'}\"";
	}
	if (defined($passed{'checked'})) {
		$input .= " checked";
	}
	if (defined($passed{'readonly'})) {
		$input .= " readonly";
	}
	$input .= ">\n";
	print $input;
}

1;

# documentation below ....

=head1 NAME

rcgi - ryan's cgi class

=head1 SYNOPSIS

  use rcgi;
  my $cgi = new rcgi;

=head1 ROUTINES

=head2 PRINTING A HEADER

  # text/html is default $content_type.
  $cgi->print_header($content_type);

=head2 PRINTING A COOKIE HEADER

  # prints a Set-Cookie header
  # you _must_ print all of your cookies before calling
  # $cgi->print_header() .. once you call $cgi->print_header()
  # you can't print any more cookies!!
  # ARGUMENTS:
  #  Arguments are passed to the function in a hash.
  #  A list of the possible arguments follows:
  #  name 	=> "name" 	(name of cookie)
  #  value 	=> "value" 	(value of cookie)
  #  expires 	=> "date" 	(date that cookie expires)
  #   if expires is set to "now", then the cookie expires
  #   when it's sent.  expires can be set to any time after
  #   now. eg: "+2h" in two hours, "+2d" in two days, etc.
  #  domain	=> "domain"	(the domain that the cookie is sent from)
  #  path	=> "path"	(the URIs where cookie can be used)
  # NOTE: name and value are the only arguments that _must_ be passed.
  $cgi->print_cookie_header([ARGUMENTS]);

=head2 PRINTING A HEADER AND ERROR

  # prints a text/html content-type header and $error.
  $cgi->print_herror($error);

=head2 PRINTING A HEADER AND ERROR THEN EXITING

  # prints a text/html content-type header and $error then exits.
  $cgi->print_herror_exit($error);

=head2 PRINTING AN ERROR

  # prints $error.
  $cgi->print_error($error);

=head2 PRINTING AN ERROR THEN EXITING

  # prints $error then exits.
  $cgi->print_error_exit($error);

=head2 GETTING DATA INPUT FROM FORM

  # reads data input then returns %data has with name/value pairs.
  # eg. if there was:
  # <input type="text" name="ryan" value="parker">
  # print "$data{'ryan'}"; would print "parker"
  my %data = $cgi->get_data();

=head2 GETTING COOKIE DATA

  # reads cookie data then returns %cookies with name/value pairs.
  # (much like %data)
  my %cookies = $cgi->get_cookies();

=head2 UNESCAPING (URL UN-ENCODING) DATA PASSED TO CGI PROGRAM

  # unescapes $string and returns unescaped $string.
  $unescaped_string = $cgi->unescape($string);

=head2 ESCAPING (URL ENCODING) DATA

  # escapes $string and returns escaped $string.
  $escaped_string = $cgi->escape($string);

=head1 AUTHOR

  rcgi was created by Ryan J. Parker.  this class is constantly
  being updated with new features, etc.  if you have a suggestion,
  then contact him.
	# ryan's cgi
	# created by Ryan J. Parker
	# run 'perldoc rcgi' to read class documentation

	# lol, just found and posted by Matthew Cluver to show Ryan his back in the day skillz...

	package rcgi;

	# called when creating the rcgi class
	sub new()
	{
	my $self = {};
	bless $self;
	return($self);
	}

	# print a content-type header
	# if no content-type is passed to the routine,
	# then a text/html content-type will be printed.
	sub print_header()
	{
	my ($self,$content_type) = @_;
	$content_type = $content_type \|\| "text/html";
	print "Content-type: $content_type\n\n";
	}

	# prints a cookie header.. name and value _must_ be passed!
	sub print_cookie_header()
	{
	my ($self,%passed) = @_;
	my $error = "error printing cookie: ";
	my $cookie = "Set-Cookie: ";
	if (!$passed{'name'} \|\| !$passed{'value'}) {
	$error .= "name and value not passed.";
	$self->print_herror_exit($error);
	}
	$cookie .= escape($self,$passed{'name'}) . "=";
	$cookie .= escape($self,$passed{'value'}) . "; ";
	if (defined($passed{'expires'})) {
	$cookie .= "expires=" . $self->cookie_date($self->expire_calc($passed{'expires'})) . "; ";
	}
	if (defined($passed{'domain'})) {
	$cookie .= "domain=$passed{'domain'}; ";
	}
	if (defined($passed{'path'})) {
	$cookie .= "path=$passed{'path'};";
	}
	print "$cookie\n";
	return($cookie);
	}

	# prints a header and error-passed to routine
	sub print_herror()
	{
	my ($self,$error) = @_;
	$self->print_header();
	print "<html><body>\n";
	print "$error\n";
	print "</body></html>\n";
	}

	# prints a header and error-passed to routine-and exits
	sub print_herror_exit()
	{
	my ($self,$error) = @_;
	$self->print_header();
	print "<html><title>ERROR</title><body>$error</body></html>\n";
	exit(1);
	}

	# prints an error-passed to routine
	sub print_error()
	{
	my ($self,$error) = @_;
	print "<html><body>\n";
	print "$error\n";
	print "</body></html>\n";
	}

	# prints an error-passed to routine-and exits
	sub print_error_exit()
	{
	my ($self,$error) = @_;
	print "$error\n";
	exit(1);
	}

	# reads data input and returns a %data hash
	sub get_data()
	{
	my $query_string;
	my $method = $ENV{'REQUEST_METHOD'};
	my (%data,$param,$value);
	if ($method eq "GET") {
	$query_string = $ENV{'QUERY_STRING'};
	} else {
	read(STDIN, $query_string, $ENV{'CONTENT_LENGTH'});
	}
	my @items = split('&', $query_string);
	foreach (@items)
	{
	($param,$value) = split('=');
	$param = unescape($self,$param);
	$value = unescape($self,$value);
	if (exists($data{$param})) {
	$data{$param} .= ",$value";
	} else {
	$data{$param} = $value;
	}
	}
	return(%data);
	}

	# reads cookies and returns a %cookies hash
	sub get_cookies()
	{
	my $http_cookie = $ENV{'HTTP_COOKIE'};
	my %cookies;
	my @items = split(';', $http_cookie);
	foreach (@items)
	{
	($name,$value) = split('=');
	$cookies{unescape($self,$name)} = unescape($self,$value);
	}
	return(%cookies);
	}

	# unescapes a string
	sub unescape()
	{
	my ($self,$string) = @_;
	# turn pluses into spaces
	$string =~ tr/+/ /;
	$string =~ s/%([0-9a-fA-F]{2})/pack("c", hex($1))/ge;
	return($string)
	}

	# escapes a string
	sub escape()
	{
	my ($self,$string) = @_;
	$string =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
	return($string);
	}

	# calculates the time for cookie to expire...
	sub expire_calc()
	{
	my ($self,$time) = @_;
	my (%mult) = ('s'=>1,
	'm'=>60,
	'h'=>60*60,
	'd'=>606024,
	'M'=>606024*30,
	'y'=>606024*365);
	my ($offset);
	if (!time \|\| ($time eq 'now')) {
	$offset = 0;
	} elsif ($time =~ /^([+-]?\d+)([mhdMy]?)/) {
	$offset = ($mult{$2} \|\| 1)*$1;
	} else {
	return($time);
	}
	return(time+$offset);
	}

	# creates the date string suitable for a cookie header...
	sub cookie_date()
	{
	my ($self,$time) = @_;
	my (@MON) = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
	my (@WDAY) = qw/Sun Mon Tue Wed Thu Fri Sat/;

	# return pre-formatted dates...
	if ("$time" =~ m/^[^0-9]/o) {
	return($time);
	}
	my ($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time);
	$year += 1900;
	return(sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",
	$WDAY[$wday],$mday,$MON[$mon],$year,$hour,$min,$sec));
	}

	# prints a form html tag
	# action => "action" (url called when form is submitted.)
	# enctype => "enctype" (encoding type..)
	# method => "method" (method used to send data)
	# target => "target" (where the form is show.. eg. frame, or -
	# above the other frames, or in a new -
	# window, etc.)
	sub form()
	{
	my ($self,%passed) = @_;
	my $form = "<form";
	if (defined($passed{'action'})) {
	$form .= " action=\"$passed{'action'}\"";
	}
	if (defined($passed{'enctype'})) {
	$form .= " enctype=\"$passed{'enctype'}\"";
	}
	if (defined($passed{'method'})) {
	$form .= " method=\"$passed{'method'}\"";
	}
	if (defined($passed{'target'})) {
	$form .= " target=\"$passed{'target'}\"";
	}
	$form .= ">\n";
	print $form;
	}

	# prints the end of a form
	sub end_form()
	{
	print "</form>\n";
	}

	# prints an input html tag...
	# type => "type" specifies the type.... etc.
	sub input()
	{
	my ($self,%passed) = @_;
	my $input = "<input";
	if (defined($passed{'type'})) {
	$input .= " type=\"$passed{'type'}\"";
	}
	if (defined($passed{'name'})) {
	$input .= " name=\"$passed{'name'}\"";
	}
	if (defined($passed{'value'})) {
	$input .= " value=\"$passed{'value'}\"";
	}
	if (defined($passed{'size'})) {
	$input .= " size=\"$passed{'size'}\"";
	}
	if (defined($passed{'src'})) {
	$input .= " src=\"$passed{'src'}\" border=\"0\"";
	}
	if (defined($passed{'maxlength'})) {
	$input .= " maxlength=\"$passed{'maxlength'}\"";
	}
	if (defined($passed{'checked'})) {
	$input .= " checked";
	}
	if (defined($passed{'readonly'})) {
	$input .= " readonly";
	}
	$input .= ">\n";
	print $input;
	}

	1;

	# documentation below ....

	=head1 NAME

	rcgi - ryan's cgi class

	=head1 SYNOPSIS

	use rcgi;
	my $cgi = new rcgi;

	=head1 ROUTINES

	=head2 PRINTING A HEADER

	# text/html is default $content_type.
	$cgi->print_header($content_type);

	=head2 PRINTING A COOKIE HEADER

	# prints a Set-Cookie header
	# you _must_ print all of your cookies before calling
	# $cgi->print_header() .. once you call $cgi->print_header()
	# you can't print any more cookies!!
	# ARGUMENTS:
	# Arguments are passed to the function in a hash.
	# A list of the possible arguments follows:
	# name => "name" (name of cookie)
	# value => "value" (value of cookie)
	# expires => "date" (date that cookie expires)
	# if expires is set to "now", then the cookie expires
	# when it's sent. expires can be set to any time after
	# now. eg: "+2h" in two hours, "+2d" in two days, etc.
	# domain => "domain" (the domain that the cookie is sent from)
	# path => "path" (the URIs where cookie can be used)
	# NOTE: name and value are the only arguments that _must_ be passed.
	$cgi->print_cookie_header([ARGUMENTS]);

	=head2 PRINTING A HEADER AND ERROR

	# prints a text/html content-type header and $error.
	$cgi->print_herror($error);

	=head2 PRINTING A HEADER AND ERROR THEN EXITING

	# prints a text/html content-type header and $error then exits.
	$cgi->print_herror_exit($error);

	=head2 PRINTING AN ERROR

	# prints $error.
	$cgi->print_error($error);

	=head2 PRINTING AN ERROR THEN EXITING

	# prints $error then exits.
	$cgi->print_error_exit($error);

	=head2 GETTING DATA INPUT FROM FORM

	# reads data input then returns %data has with name/value pairs.
	# eg. if there was:
	# <input type="text" name="ryan" value="parker">
	# print "$data{'ryan'}"; would print "parker"
	my %data = $cgi->get_data();

	=head2 GETTING COOKIE DATA

	# reads cookie data then returns %cookies with name/value pairs.
	# (much like %data)
	my %cookies = $cgi->get_cookies();

	=head2 UNESCAPING (URL UN-ENCODING) DATA PASSED TO CGI PROGRAM

	# unescapes $string and returns unescaped $string.
	$unescaped_string = $cgi->unescape($string);

	=head2 ESCAPING (URL ENCODING) DATA

	# escapes $string and returns escaped $string.
	$escaped_string = $cgi->escape($string);

	=head1 AUTHOR

	rcgi was created by Ryan J. Parker. this class is constantly
	being updated with new features, etc. if you have a suggestion,
	then contact him.