Log in

View Full Version : My latest Perl contraption


TheMatrix
May 22nd, 2011, 10:25 PM
I'm so proud of myself :D

I made an HTML interface to the CGI::Session module of Perl.
Here is the 203 line long script:

#!/usr/bin/perl -wT

use strict;
use vars qw( $SESSION $SESSID $CGI );

use CGI;
use CGI::Session;

$CGI = new CGI;
$SESSION = CGI::Session->new();

unless( $CGI->param("submit_query_for_download" ) ) {
#Headers
print $SESSION->header();

#Page headers
print qq`
<html>
<head>
<title>CGI Session</title>
</head>
<body>
<h1>Session Data</h1>
<p><b>Your session ID:</b><pre>`.$SESSION->id().qq`</pre></p>
<hr noshadow>
`;
}
my $r = 1;
if( $CGI->param("start_page") ) {
start(); #
$r = 0;
} elsif( $CGI->param("submit_query_for_delete") ) {
foreach( $CGI->param("query") ) {
$SESSION->clear( $_ ); #
}
} elsif( $CGI->param("submit_query_for_maintainance") ) {
maintain_form( $CGI->param("query") ); #
$r = 0;
} elsif( $CGI->param("delete_all_data") ) {
delete_all(); #
} elsif( $CGI->param("submit_query_for_download") ) {
$CGI->header( "application/octet-stream" );
my $format = $CGI->param( "Download_format" );
download( $CGI->param("query"), $format ); #
} elsif( $CGI->param("add_data") ) {
my $name = $CGI->param( "new_name" );
my $value = $CGI->param( "new_value" );
add_to_session( $name, $value ); #
} elsif( $CGI->param("maintain_retrieved_values") ) {
my %maintain = ();
foreach( $CGI->param("maintain_name") ) {
my $name = $_;
my $value = $CGI->param( "maintain_value_$name" );
$SESSION->clear( $name );
$SESSION->param( -name => "$name", -value => "$value" );
}
maintain_do( %maintain ); #
} else {
start(); #
$r = 0;
}

unless( $r == 0 ) {
print qq`
<script type="text/javascript">
window.location = 'index.cgi';
</script>
`;
}


#/------------------------
# Main Subs
#

sub start {
print qq`
<form name="session_form" action="" method=POST>
<table border=1>
<tr bgcolor="#cccccc">
<td colspan=3>
<div align=right>
<input type=submit name="submit_query_for_maintainance" value="Maintain"><input type=submit name="submit_query_for_delete" value="Delete">
<input type=submit name="delete_all_data" value="Delete All"><input type=submit value="Refresh">
</div>
</td>
<tr bgcolor="#dddddd">
<th>Select?</th>
<th>Name</th>
<th>Value</th>
</tr>`;
my $rows = 0;
foreach( $SESSION->param() ) {
my $name = $_;
my $value = $SESSION->param( "$_" );

unless( defined $name ) {
last;
}

if( ($rows % 2) == 0 ) {
print '<tr bgcolor="#eeeeee">';
} else {
print '<tr bgcolor="#ffffff">';
}

print '<td><input type=checkbox name="query" value="'.$name.'" align=center></td>';
print '<td>'.$name.'</td>';
print '<td>'.$value.'</td>';
print "</tr>\n";
$rows++;
}
unless( $rows != 0 ) {
print '<tr>';
print '<td colspan=3><p align=center>There is no data in the session.</p></td>';
print "</tr>\n";
}

print qq`
<tr bgcolor="#efefef">
<td><input type=submit name="add_data" value="Add"></td>
<td><input type=text name="new_name"></td>
<td align=center><input type=text name="new_value"></td>
<tr bgcolor="#cccccc">
<td colspan=3>
<div align=right>
<div align=right>
<input type=submit name="submit_query_for_maintainance" value="Maintain"><input type=submit name="submit_query_for_delete" value="Delete">
<input type=submit name="delete_all_data" value="Delete All"><input type=submit value="Refresh">
</div>
</td>
</table><hr noshadow></body></html>`;
}

sub maintain_form {
my( @query ) = @_;

print qq`
<table border=1>
<form method=POST action="index.cgi">
<tr>
<th>Name</th>
<th>Value</th>
</tr>
`;
my $rows = 0;
foreach( @query ) {
my $name = $_;
my $current = $SESSION->param( "$name" );

if( ($rows % 2) == 0 ) {
print '<tr bgcolor="#eeeeee">';
} else {
print '<tr bgcolor="#ffffff">';
}

print '<td>'.$name.'<input type=hidden name="maintain_name" value="'.$name.'"></td>';
print '<td><input type=text name="maintain_value_'.$name.'" value="'.$current.'"></td>';
print "</tr>\n";
$rows++;
}
print qq`
<tr bgcolor="#cccccc">
<td colspan=2><div align=right>
<input type=submit name="maintain_retrieved_values" value="Update">
</div></td>
</tr></table></form></body></html>
`;
}

sub delete_all {
$SESSION->delete();
}

sub download {
my( @query, $format ) = @_;

print "NAME,VALUE\n";
foreach( @query ) {
my $name = $_;
my $value = $SESSION->param( "$name" );

print "'$name','$value'\n";
}
}

sub add_to_session {
my( $name, $value ) = @_;

$SESSION->param( -name => "$name", -value => "$value" );
}

sub maintain_do {
my( %maintain ) = @_;

foreach( %maintain ) {
my $name = $_;
my $value = $maintain{$name};

$SESSION->clear( $name );
$SESSION->param( -name => "$name", -value => "$value" );
}
}


That took me about 2 hours to write. It works really well! I didn't use all of the possible CGI::Session features, but hey, this is version 1! Heck, I didn't even use all of my own features!

So yeah.

EDIT: Yaay! 400th post!

AutoPlay
May 25th, 2011, 03:59 PM
The codings a little messy to look at but overall its brilliant!

good job!

TheMatrix
May 25th, 2011, 11:57 PM
thanks!

gleeguy
May 28th, 2011, 07:26 PM
thanks!

A linux coder like me? I think i'm in love, PENGUIN POWER!!!

Commander Thor
May 28th, 2011, 07:32 PM
Perl isn't strictly Linux, js.

gleeguy
May 28th, 2011, 07:55 PM
Perl isn't strictly Linux, js.

I knew that obviously, it was kinda a inside joke

TheMatrix
May 29th, 2011, 01:15 AM
A linux coder like me? I think i'm in love, PENGUIN POWER!!!
don't forget lizard power (http://nl.opensuse.org/)...... :P

i'm an opensuse fan :P