Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Re: Desert Island Modules

by jonadab (Parson)
on Jul 07, 2005 at 10:08 UTC ( [id://473060]=note: print w/replies, xml ) Need Help??


in reply to Re^2: Desert Island Modules
in thread Desert Island Modules

Can you describe what you do use for CGI programming?

Sure. As far as writing the HTML output, I have some custom elisp that facilitates writing wellformed XHTML. For instance, if I hit Ctrl-t table <enter> I get the following, with my cursor inside the first tr element:

<table><thead> <tr> </tr> </thead><tbody> <tr></tr> </tbody></table>

I have a hook set up to load that stuff whenever cperl-mode starts up. For the other half of CGI, getting data in, I mostly use the following:

sub getforminput { my %opt = @_; # OPTIONS: # multiples - What to do if there are multiple inputs with t +he # same name. By default, you get an arrayref, b +ut # if you set this to 'first' or 'last', you'll g +et # the first or last value, respectively. 'join' # will "firstval,secondval,thirdval,...,lastval" +. # filename - If true, and if the browser supplies a filenam +e for # a file upload, send it as 'filename'. (Multip +les # are not supported by this, so you can't also h +ave # a form element named 'filename'.) Default is # to ignore any user-supplied filename(s), which # is generally recommended for security anyway. # content_type - If true, and the browser supplies a Content-ty +pe # with a file upload, send it as 'content_type', # with similar caveats as for filename. use Taint; die "Cannot both fold and reject multiples.\n" if $opt{fold_multiple +s} and $opt{reject_multiples}; my ($formdata, %input); { my $num_bytes=$ENV{CONTENT_LENGTH}; if ($num_bytes > 0) { $num_bytes == read (STDIN, $formdata, $num_bytes) or warn "CONTE +NT_LENGTH is full of lies!"; } else { $formdata=$ENV{QUERY_STRING}; } } loginput($formdata) if $formdata; if ($ENV{CONTENT_TYPE}=~/multipart\/form-data.*boundary=(.+?)$/) { my $boundary=$1; Taint::taint($boundary); foreach my $part (split /--$boundary/, $formdata) { my $partname=""; my ($headers, $value, @moreval) = $part =~ /^(.*?)\r?\n\s?\r?\n( +.*?)(?:\r?\n)?$/s; Taint::taint($headers, $value); $value=join("\n\n", ($value, @moreval)) if @moreval; foreach my $h (split (/\r?\n/, $headers)) { if ($h =~ /Content-Disposition: ([^;]+); (.*?)$/) { my ($content_disposition, $t)=($1,$2); Taint::taint($t); foreach (split /; /, $t) { if (/^name=(.*?)$/) { ($partname) = $1 =~ /\"?([^"]*)/; Taint::taint($partname); } elsif (/^filename=(.*?)$/ and $opt{filename}) { my ($filename) = $1 =~ /\"?([^"]*)/; Taint::taint($filename); $input{filename} = $filename; # Note that multiples aren +'t supported for this. } } } else { if ($h =~ /Content-Type:\s+(.*)/ and $opt{content_type}) { ($input{content_type}) = $1 =~ m!([\w]+/[\w]+)!; } } } if ($partname) { if ($opt{multiples} eq 'first') { $input{$partname} = $value unless exists $input{$partname}; +# Take first value only; reject subsequent ones. } elsif ($opt{multiples} eq 'last') { $input{$partname} = $value; +# Take the latest value every time. } elsif ($opt{multiples} eq 'join') { $input{$partname} = (join ",", $input{$partname} , $value); +# Join with commas. } else { # +# Default: construct an arrayref if necessary. if (exists $input{$partname} and ref $input{$partname}) { push @{$input{$partname}}, $value; } elsif (exists $input{$partname}) { $input{$partname} = [$input{$partname}, $value]; } else { $input{$partname} = $value; }} }} } else { foreach (split /&/, $formdata) { s/\+/ /g; # That's how CGI encodes spaces. my ($name, $value) = split(/=/, $_); $name =~ s/%(..)/pack("c",hex($1))/ge; # These lines reverse th +e %nn encodings $value =~ s/%(..)/pack("c",hex($1))/ge; # CGI does for punctuati +on marks and such. Taint::taint($name, $value); $input{$name}=$value; }} if ($formdata) { return \%input; } else { return undef; } }

I tried to save myself from maintaining that by using modules, but it turned out to be false laziness, because it's not that big and not that hard to maintain, and having the ability to do things like keep a log of all input data for any given script turns out to be a fantastic debugging aid (not just for debugging this function, but especially for debugging the calling code). I have had significantly less trouble with this code than with the module I was using previously (CGI::Lite). I guess some wheels are worth reinventing.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://473060]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (5)
As of 2024-03-28 23:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found