package Gm_Web;
###############################################################################
# Greymatter 1.7.2
# Copyright (c)2000-2007, The Greymatter team
# http://greymatterforum.proboards82.com/
# By possessing this software, you agree not to hold the author responsible for
# any problems that may arise from your installation or usage of Greymatter
# itself, or from any content generated by yourself or others through the use of
# this program. You may freely modify and redistribute this program, so
# long as every copyright notice (including in this manual and in the Greymatter
# code) remains fully intact. Finally, you may not sell or in any way
# make a financial profit from this program, either in original or modified form.
# Your possession of this software signifies that you agree to these terms;
# please delete your copy of this software if you don't agree to these terms.
# Original Creators Noah Grey
###############################################################################
#==============================================================================
# Note no exporting because items from this package should be fully qualified
## Gm Web
# This package groups functions that deal with html or web experience.
# This is pretty much, if a subroutine generates html, it belongs here.
# Notice that not everything needs to go here. Notice the radio button
# logic basically is there to remove boring if...else checked logic. This
# is the place for those kinds of optimizations
#
# CONVENTIONS
# 1. Return a string rather than printing, this is just more elegant. Leave prints
# to the calling subroutine, if possible
# 2. Private subroutines should start with the '_' character. By private I mean
# it will never be called outside of this package.
# 3. If you have more than 1 or 2 parameters, especially if they are not required,
# use named parameters such as in createRadioButton. By putting stuff in a
# hash we gain the flexibility to add more optional parameters without having
# to pass in '' placeholders or modify existing code.
# 4. Subs starting with 'create' should return a string.
# 5. Subs starting with 'display' are expected to contain print statements
# 6. Use ' and " where appropriate. If you don't have any variables or newlines
# then use ', its quicker and cleaner.
# 7. Don't put all text on one huge long line. It messes with some programs
# that don't do line wraps.
use strict;
use warnings;
use Gm_Utils qw( println );
use Gm_Constants;
use Gm_Storage;
use Gm_Trace;
use vars qw($gmversion $gmheadtag $gmframetop $gmfonttag $gmframebottom $gmadmincss);
$gmversion = Gm_Constants::GM_VERSION; ## god this is stupid, just so the below blocks don't crap
## TODO MOVE TO SOMEOTHER FILE AS SEMI CONSTANTS OR SOMETHING OR CLEAN UP
$gmadmincss = qq#
#;
## Some TEMP STUFF, PUT THIS BACK IN LIBRARY OR SOMETHING WHEN ITS CLEANED UP
$gmheadtag = qq#
);
## TODO, make this stuff POD, at least its a standard ...
## Get Web Params
# Will get the parameters from the web request
# RETURN: a reference to a hash of the web params
sub getWebParams {
my (%params) = @_;
## NOTE THIS SHOULD BE SWITCHED TO USE THE CGI.PM MODULE
# However, due to the use of the 'thomas' variable, see gm.cgi, we can't do that
# yet, CGI.pm was introduced to perl v. 5.004
## Loading up vars from params
my $errHandler = $params{'errHandler'} || \&Gm_Utils::gmWarn;
my (%IN) = ();
my $input = '';
if ($ENV{'REQUEST_METHOD'} eq 'GET'){
$input = $ENV{'QUERY_STRING'};
} else {
unless( read(STDIN, $input, $ENV{'CONTENT_LENGTH'} ) == $ENV{'CONTENT_LENGTH'} ){
$input = '';
}
}
my @pairs = split(/&/, $input);
foreach my $pair (@pairs) {
my ($name, $value) = split(/=/, $pair);
&Gm_Trace::Trace(level => 4, msg => ":$name:$value:");
$name =~ tr/+/ /;
## this could be done differently, but is pack less susceptable to chr?
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
## for bookmarklets?
unless( ($name eq 'logtext') || ($name eq 'loglink') ){
$value =~ tr/+/ /;
}
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
#warn "($name, $value)";
## NOTE that we may not want to put every variable to the same test, some
# we can trust more than others, such as the author's entry text, this current
# stops someone from posting about the very issues we are trying to stop.
# ALSO this messes with saving TEMPLATES and CONFIGS (where those chars can be legit)
unless( $name =~ m/^edited/i || $name =~ m/template$/i ){
#warn "($name, $value)";
if( Gm_Utils::hackWebTest( $name ) || Gm_Utils::hackClTest( $name ) ||
Gm_Utils::hackWebTest( $value ) || Gm_Utils::hackClTest( $value ) ){
&$errHandler('We don\'t take kindly to that sort of activity here. '.
'Your attempt to break the script has been logged and the administrators have '.
'been notified. ');
## TODO MAKE UTIL HACKNOTIFY FUNCTION, see changelog todo
}
}
# What if we have multiple values for the form element, hmm?
if( exists( $IN{$name} ) && defined( $IN{$name} )){
if( $name eq "thomas" ){
# For some reason, this variable appears multiple times on a page,
# perhaps so a reload won't mess with it? Who knows..., but anyway
# DO NOT APPEND, must replace
$IN{$name} = $value;
&Gm_Trace::Trace(level => 4, msg => "1:$name:$value:");
warn 'Avoiding appending because of "thomas" variable, bad!';
} else {
# really append
$IN{$name} .= "\t$value";
&Gm_Trace::Trace(level => 4, msg => "2:$name:$value:");
}
} else {
$IN{$name} = $value;
&Gm_Trace::Trace(level => 4, msg => "3:$name:$value:");
}
}
return( \%IN );
}
## Create Radio Button
# Will return a string of html that represents a radio button
# ARG name: name of the radio button
# ARG value: the value of the radio button
# ARG checked: will compare this to 'value' to see if should be checked
# RETURN: the radio html
sub createRadioButton {
my (%params) = @_;
my $name = $params{'name'} || '';
my $value = $params{'value'} || '';
my $checked = $params{'checked'} || '';
my $line = '';
return $line;
}
## Print Request Header
# Will return the header for the http request (NOT the html header). Can be
# modified here to incorperate cookie and other logic.
# RETURN: the request header
sub createRequestHeader {
return "Content-type: text/html\n\n";
}
## Create User Error
# Will create the user error using the correct templates
# ARG1: Error string
# RETURN: the User Error html
sub createUserError {
my $dangerwarning = shift;
# NOTE that we are using the adminerror handler, since we are in the user
# if we can't create the user error, calling displayUserErrorExit == infinite loop
my $gmTemplates = Gm_Storage::getTemplates( errHandler=>\&displayAdminErrorExit);
my $line = $gmTemplates->{'gmusererrorheadertemplate'}; #User error header
$line .= $dangerwarning;
$line .= $gmTemplates->{'gmusererrorfootertemplate'}; #User error footer
# TODO makes this gracefully do template replacement
## currently cannot handle it because gm_formatentry calls
## gm_generatecalendar which enters into a loop that depends on
## a variable being set: gm_generatecalendar (at least, to research further)
return $line;
}
## Create User Error
# Will create the user error using the correct templates
# ARG1: Error string
# RETURN: the User Error html
sub createAdminError {
my $dangerwarning = shift;
my $line = "$gmheadtag\n$gmframetop";
$line .= "Error Notice
$dangerwarning";
$line .= "$gmframebottom
\n";
return $line;
}
## Error Page Exit
# Private sub that will display the header, given error message, and exit.
# ARG1: Error string to print
sub _displayErrorPageExit{
my $error = shift;
println( createRequestHeader() );
println( $error );
exit; # its an error so we are done
}
## Display User Page Exit
# Will display the given error message, print the header, and exit.
# ARG1: Error string to print
sub displayUserErrorExit {
my $error = shift;
_displayErrorPageExit( createUserError( $error ) );
}
## Display Admin Error Page Exit
# Will display the given error message, print the header, and exit.
# ARG1: Error string to print
# DEPRECATES: gm_dangermouse
sub displayAdminErrorExit {
my $error = shift;
_displayErrorPageExit( createAdminError( $error ) );
}
1;