lib/MHArc/CGI.pm

   1 ##--------------------------------------------------------------------------##
   2 ##  File:
   3 ##      $Id: CGI.pm,v 1.2 2002/09/18 17:23:29 ehood Exp $
   4 ##  Description:
   5 ##      POD at end of file.
   6 ##--------------------------------------------------------------------------##
   7 ##  Copyright (C) 2002  Earl Hood <earl@earlhood.com>
   8 ##
   9 ##  This program is free software; you can redistribute it and/or modify
  10 ##  it under the terms of the GNU General Public License as published by
  11 ##  the Free Software Foundation; either version 2 of the License, or
  12 ##  (at your option) any later version.
  13 ##
  14 ##  This program is distributed in the hope that it will be useful,
  15 ##  but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ##  GNU General Public License for more details.
  18 ##
  19 ##  You should have received a copy of the GNU General Public License
  20 ##  along with this program; if not, write to the Free Software
  21 ##  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  22 ##  02111-1307, USA
  23 ##--------------------------------------------------------------------------##
  24
  25 package MHArc::CGI;
  26
  27 use Exporter;
  28 @ISA = qw(Exporter);
  29
  30 @EXPORT_OK = qw(
  31   &parse_input
  32   &print_content_type
  33   &print_error
  34   &print_forbidden
  35   &print_input_error
  36   &print_location
  37   &print_not_found_error
  38   &print_script_error
  39 );
  40
  41 ##--------------------------------------------------------------------------##
  42
  43 BEGIN {
  44   $Debug = 0;
  45 }
  46
  47 ##--------------------------------------------------------------------------##
  48
  49 sub parse_input {
  50     my($method) = ($ENV{"REQUEST_METHOD"}) || 'GET';
  51     my($data);
  52     if ($method eq "GET") {
  53         $data = $ENV{"QUERY_STRING"} || "";
  54     } elsif ($method eq "POST") {
  55         read(STDIN, $data, $ENV{"CONTENT_LENGTH"});
  56     } else {
  57         warn qq/Unknown method: $method/;
  58         return undef;
  59     }
  60
  61     my(@pairs, $name, $value);
  62     local $_;
  63
  64     my $form = { };
  65     if ($data ne '') {
  66         @pairs = split(/&/, $data);
  67         foreach (@pairs) {
  68             ($name, $value) = split(/=/);
  69             $name = expandstr($name);
  70             $value = expandstr($value);
  71             $form->{$name} = $value;
  72         }
  73     }
  74     $form;
  75 }
  76
  77 sub print_forbidden {
  78   print STDOUT 'Status: 403 Forbidden', "\r\n";
  79   print_content_type('text/plain');
  80   print STDOUT "Access Denied\n";
  81 }
  82
  83 sub print_input_error {
  84   print STDOUT 'Status: 400 Bad Request', "\r\n";
  85   print_content_type('text/plain');
  86   print STDOUT "Input Error\n";
  87 }
  88
  89 sub print_error {
  90   print_content_type('text/plain');
  91   print STDOUT "Script Error\n";
  92 }
  93
  94 sub print_not_found_error {
  95   print STDOUT 'Status: 404 Not Found', "\r\n";
  96   print_content_type('text/plain');
  97   print STDOUT "Not Found\n";
  98 }
  99
 100 sub print_location {
 101   print STDOUT 'Location: ', $_[0], "\r\n\r\n";
 102 }
 103
 104 sub print_content_type {
 105     my($type) = shift;
 106     print STDOUT "Content-type: $type\r\n\r\n";
 107 }
 108
 109 sub expandstr {
 110     my($str) = shift;
 111     $str =~ tr/+/ /;
 112     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/ge;
 113     $str;
 114 }
 115
 116 ##--------------------------------------------------------------------------##
 117 1;
 118 __END__
 119
 120 =head1 NAME
 121
 122 MHArc::CGI - General CGI-related utilities for mail archiving system.
 123
 124 =head1 SYNOPSIS
 125
 126   use MHArc::CGI;
 127
 128 =head1 DESCRIPTION
 129
 130 This module contains a collection of CGI-related utility routines used
 131 by the various mharc CGI programs.
 132
 133 =head1 VARIABLES
 134
 135 The following module variables can be set to affect the behavior
 136 of the utility routines:
 137
 138 =over
 139
 140 =item C<$Debug>
 141
 142 If set to a true value, routines will print out debugging information,
 143 if appropriate.
 144
 145 =back
 146
 147 =head1 ROUTINES
 148
 149 By default, no routines are exported into the calling namespace.
 150 Routines in this module can be imported by explicitly listing the
 151 routines to import in the C<use> declaration:
 152
 153   use MHArc::CGI qw( parse_input );
 154
 155 The following routines are availale:
 156
 157 =over
 158
 159 =item ...
 160
 161 =back
 162
 163 =head1 VERSION
 164
 165 C<$Id: CGI.pm,v 1.2 2002/09/18 17:23:29 ehood Exp $>
 166
 167 =head1 AUTHOR
 168
 169 Earl Hood, earl@earlhood.com
 170
 171 This module is part of the mharc archiving system and comes with
 172 ABSOLUTELY NO WARRANTY and may be copied only under the terms of
 173 the GNU General Public License, which may be found in the MHArc
 174 distribution.
 175
 176 =cut
 177