CGI-Framework
view release on metacpan or search on metacpan
lib/CGI/Framework.pm view on Meta::CPAN
print "You are trying to submit a form with some missing information. Please start from the beginning.";
$self->finalize();
}
}
#
# THIS IS A SUB, NOT A METHOD
# Takes an arrayref which should be a reference to the @_ array from whatever sub's calling it
# If the first argument is an instance: of this class, shifts it from the arrayref
# else returns $LASTINSTANCE
# or die()s if lastinstance isn't set
#
sub _getself {
my $arrayref = shift;
my $self;
ref($arrayref) eq "ARRAY" || die "Arrayref not provided to _getself\n";
if (ref($arrayref->[0]) eq "CGI::Framework") {
$self = shift @$arrayref;
return $self;
}
elsif (ref($LASTINSTANCE) eq "CGI::Framework") {
return $LASTINSTANCE;
}
else {
croak "Cannot use this method/sub without creating an instance of CGI::Framework first";
}
}
#
# THIS IS A SUB, NOT A METHOD
# Takes a directory name
# Creates a skeleton of a new project under it
#
sub INITIALIZENEWPROJECT {
my $dir = shift || die "\n\nError: You must supply a directory as the first argument\n\n";
my $cgi_dir = "$dir/cgi-bin";
my $lib_dir = "$dir/lib";
my $sessions_dir = "$dir/sessions";
my $templates_dir = "$dir/templates";
my $public_dir = "$dir/public_html";
my $images_dir = "$public_dir/images";
local (*FH);
my $filename;
my $content;
my $mode;
$dir =~ m#^([/\\])|(\w:)# || die "\n\nYou must specify a fully-qualified, not a relative path\n\n";
-d $dir && die "\n\n$dir already exists. This is not recommended. Please specify a non-existant directory\n\n";
print "\n\nINITIALIZING A NEW PROJECT IN $dir\n\n";
#
# Create the directories
#
foreach ($dir, $cgi_dir, $lib_dir, $sessions_dir, $templates_dir, $public_dir, $images_dir) {
print "Creating directory $_ ";
mkdir($_, 0755) || die "\n\n:Error: Failed to create $_ : $!\n\n";
print "\n";
}
print "Changing $sessions_dir mode ";
chmod(0777, $sessions_dir) || die "\n\nError: Failed to chmod $sessions_dir to 777: $!\n\n";
print "\n";
#
# Create the files
#
foreach (
[
"$templates_dir/header.html", 0644, <<"EOM"
<html>
<!-- Stub CGI created by CGI::Framework's INITIALIZENEWPROJECT command -->
<head>
<title>Welcome to my page</title>
</head>
<body bgcolor=silver text=navy link=orange alink=orange vlink=orange>
<cgi_framework_header>
<TMPL_INCLUDE NAME="errors.html">
EOM
],
[
"$templates_dir/footer.html", 0644, <<"EOM"
<!-- Stub CGI created by CGI::Framework's INITIALIZENEWPROJECT command -->
<hr>
<center><font size=1>Copyright (C) 2005 ME !!!</font></center>
<cgi_framework_footer>
</body>
</html>
EOM
],
[
"$templates_dir/login.html", 0644, <<"EOM"
<!-- Stub CGI created by CGI::Framework's INITIALIZENEWPROJECT command -->
<TMPL_INCLUDE NAME="header.html">
The time is now: <TMPL_VAR NAME="currenttime">
<p>
<b>Enter your username:</b>
<br>
<input type="text" name="username" value="<TMPL_VAR NAME="username" ESCAPE=HTML>">
<p>
<b>Enter your password:</b>
<br>
<input type="password" name="password" value="<TMPL_VAR NAME="password" ESCAPE=HTML>">
<p>
<input type="button" value=" login >> " onclick="return process('mainmenu');">
<TMPL_INCLUDE NAME="footer.html">
EOM
],
[
"$templates_dir/mainmenu.html", 0644, <<"EOM"
<!-- Stub CGI created by CGI::Framework's INITIALIZENEWPROJECT command -->
lib/CGI/Framework.pm view on Meta::CPAN
}
if (\$f->form("username") eq "goodusername" && \$f->form("password") eq "cleverpassword") {
# Logged in fine
\$f->remember("username");
\$f->session("authenticated", 1);
}
elsif (\$f->form("username") && \$f->form("password")) {
\$f->add_error("Login failed");
}
}
1;
EOM
],
[
"$lib_dir/pre_post.pm", 0644, <<"EOM"
# Stub module created by CGI::Framework's INITIALIZENEWPROJECT command
use strict;
sub pre_login {
my \$f = shift;
\$f->html("currenttime", scalar localtime(time));
}
sub pre_youraccount {
my \$f = shift;
my \@services = (
{
type => "Cell Phone",
details => "(514) 123-4567",
amount => '\$25.00',
},
{
type => "Laptop Rental",
details => "SuperDuper Pentium 4 3.01hz",
amount => '\$35.99',
},
);
\$f->html("services", \\\@services);
}
sub post_logout {
my \$f = shift;
\$f->clear_session();
}
1;
EOM
],
[ "$images_dir/dotarrow.gif", 0644, "\x47\x49\x46\x38\x39\x61\x0b\x00\x08\x00\xb3\x00\x00\xff\xff\xff\xff\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00...
[ "$images_dir/exclamation.gif", 0644, "\x47\x49\x46\x38\x39\x61\x0e\x00\x0e\x00\xa2\xff\x00\xff\xff\xff\xff\xe6\xb3\xff\xcc\x66\x80\x80\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x21\xff\x0b\x41\x44\x4f\x42\x45\x3a\x49\x52\x31\x2e\x30\x02...
) {
($filename, $mode, $content) = @$_;
print "Creating file $filename ";
open(FH, ">$filename") || die "\n\nError: Failed to open $filename for writing: $!\n\n";
print FH $content;
close(FH);
print "Setting permission to ", sprintf("%o", $mode), " ";
chmod($mode, $filename) || die "\n\nError: Failed to set mode on $filename to $mode: $!\n\n";
print "\n";
}
print "\n\nDONE: Your stub project is now ready in $dir\n\n";
exit;
}
############################################################################
#
# OLD COMPATABILITY SUBS START HERE
sub adderror {
return add_error(@_);
}
sub clearsession {
return clear_session(@_);
}
sub showtemplate {
return show_template(@_);
}
sub logthis {
return log_this(@_);
}
1;
__END__
( run in 0.698 second using v1.01-cache-2.11-cpan-39bf76dae61 )