/usr/share/perl5/RefDB/CGI.pm

## package RefDB::CGI
## RefDB CGI support module

## markus@mhoenicka.de 2002-12-27
## $Id: CGI.pm,v 1.1 2002/12/29 23:06:44 mhoenicka Exp $

##   This program is free software; you can redistribute it and/or modify
##   it under the terms of the GNU General Public License as published by
##   the Free Software Foundation; either version 2 of the License, or
##   (at your option) any later version.
##   
##   This program is distributed in the hope that it will be useful,
##   but WITHOUT ANY WARRANTY; without even the implied warranty of
##   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##   GNU General Public License for more details.
   
##   You should have received a copy of the GNU General Public License
##   along with this program; if not, write to the Free Software
##   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

## Package main documentation

=head1 NAME

RefDB::CGI - CGI support for RefDB Perl scripts

=head1 SYNOPSIS

  use RefDB::CGI;

  if (RefDB::CGI::check_cgi("GET") == 0) {
      $template = RefDB::CGI::load_html("/usr/local/share/myapp/template.html");
  }



=head1 DESCRIPTION

Provides functions important to run RefDB scripts as CGI applications.

=head1 FEEDBACK

Send bug reports, questions, and comments to the refdb-users mailing list at:

refdb-users@lists.sourceforge.net

For list information and archives, please visit:

http://lists.sourceforge.net/lists/listinfo/refdb-users


=head1 AUTHOR

Markus Hoenicka, markus@mhoenicka.de

=head1 SEE ALSO

This module is part of the RefDB package, a reference manager and bibliography tool for markup languages. Please visit http://refdb.sourceforge.net for further information.

=cut

package RefDB::CGI;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

$VERSION = "1.2";

=head1 package functions

=head2 check_cgi

Title   : check_cgi

Usage   : $cgi = check_cgi($mode);

Function: Checks whether app runs as a CGI app accepting GET or POST data

Argument: mode: either "GET" or "POST"

Returns : 0 if CGI app called properly
          1 if incorrect mode
          2 if missing content length of POST data
          3 if not CGI at all

=cut

##********************************************************************
## check_cgi(): checks whether we run as CGI app
## Argument: mode, either "GET" or "POST"
## Returns: 0 if CGI app called appropriately, >0 if not
##********************************************************************
sub check_cgi {
    my $mode = shift;
    my $retcode;

    my $request_method = $ENV{'REQUEST_METHOD'};

    ## A web server will set the environment variable REQUEST_METHOD
    ## (among others) for CGI processes. If this envar is not set,
    ## we're not a CGI app
    if (defined($request_method)) {
	if ($request_method eq "GET") {
	    if ($mode eq "GET") {
		$retcode = 0;
	    }
	    else {
		$retcode = 1;
	    }
	}
	elsif ($request_method eq "POST") {
	    if ($mode eq "GET") {
		$retcode = 1;
	    }
	    else {
		my $content_length = $ENV{'CONTENT_LENGTH'};

		if (!defined($content_length)) {
		    $retcode = 2;
		}
		else {
		    $retcode = 0;
		}
	    }
	}
	else {
	    $retcode = 3; # no CGI
	}
    }
    else {
	$retcode = 3;
    }
	
    if ($retcode == 0) {
	## all fine, proper mode detected
	return 0;
    }
    elsif ($retcode == 1) {
	  print "Content-type: text/plain\n\nIncorrect request method: $request_method<<\n";
	  return 1;
    }
    elsif ($retcode == 2) {
## this is a web server error, should never happen
	  print "Content-type: text/plain\n\nUnknown request size\n";
	  return 2;
      }
    else { ## retcode == 3
	# print "Not running as a CGI application\n";
	return 3;
    }
} ## end of check_cgi

=head2 load_html

Title   : load_html

Usage   : $template = load_html("full/path/to/template.html")

Function: Reads a HTML template into a string

Returns : string if file was found, undef if not

=cut

##********************************************************************
## load_html(): reads html template into a string
## Arguments: path of template  file
## Return value: template string if ok, undef if failed
##********************************************************************
sub load_html {
    my $frag = shift;
    my $fragstring;

    if (open FRAG, "<$frag") {
	while (<FRAG>) {
	    $fragstring = $fragstring . $_;
	}
	return $fragstring;
    }
    else {
	return undef;
    }

} ## end of load_html


1;
__END__
librefdb-perlmod-perl 1.2-2 / usr / share / perl5 / RefDB / CGI.pm
