#!"c:/xampp/perl/bin/perl.exe" --
#!/usr/bin/perl --
#~
#~
## perltidy -olq -csc -csci=10 -cscl="sub : BEGIN END if " -otr -opr -ce -nibc -i=4 -pt=0 "-nsak=*"
#!/usr/bin/perl --
use strict;
use warnings;
use constant DEBUG => !!( 1 || $ENV{PERL_DEBUG_MYAPPNAME} );
use diagnostics;
use CGI::Carp qw( fatalsToBrowser );
BEGIN { CGI::Carp::set_message( sub {
print "something broke, we know what it is, thank you, try again later
\n";
if( DEBUG ) { # secrets
print '', CGI->escapeHTML(@_), '
';
}
} ); }
use CGI;
use DBI;
Main( @ARGV );
exit( 0 );
sub Main {
## return DebugCGI(); ## "for debugging cgi programs" << great comment << sarcasm :)
my $query = CGI->new;
#~ my $article_id = digit_only( $query->param( 'article_id' ) );
my $article_id = article_id( $query );
return ArticleDance( $article_id );
} ## end sub Main
sub article_id {
my( $q ) = @_;
my $id = $q->param( 'article_id' );
return if not $id;
return digit_only( $id );
} ## end sub article_id
sub digit_only {
my( $it ) = @_;
$it =~ s{\D}{}g;
return $it;
} ## end sub digit_only
sub ArticleDance {
my( $article_id ) = @_;
if( $article_id ) {
my $dbh = database_connect();
return print_article( $dbh, $article_id );
} else {
#~ return print_error_message();
return error_artid();
}
} ## end sub ArticleDance
sub error_artid {
print_error_message( 'article_id not good' );
} ## end sub error_artid
sub print_error_message {
my $errmsg = join ' ', '', CGI->escapeHTML( "@_" ), '';
print qq{
Fudgy error
<body>
$errmsg
};
} ## end sub print_error_message
sub print_article {
my( $dbh, $article_id ) = @_;
my( $added, $title, $author, $img, $msg ) =
fetch_article( $dbh, $article_id );
print template_head( $title, $added, $img, $msg ),
author_profile( $author ),
template_footer(),
;
} ## end sub print_article
sub fetch_article {
my( $dbh, $article ) = @_;
## todo fixup -- I can't test this
my $sql = q{
SELECT
DATE_FORMAT(date_added,'%D %M %Y')
AS
date,
article_title,
author_id,
image,
message
FROM
article
WHERE
article_id = ?
LIMIT 0,1
};
## wordy
#~ my( $date, $title, $author, $img, $msg ) = $dbh->selectrow_array( $sql, {}, $article );
#~ return ( $date, $title, $author, $img, $msg ;
return $dbh->selectrow_array( $sql, {}, $article );
} ## end sub fetch_article
sub author_profile {
my( $dbh, $author_id ) = @_;
#~ qq{select title,f_name,l_name,profile,image from author where author_id = '$author_id'};
my $statement = q{
SELECT
title,
f_name,
l_name,
profile,
image
FROM
author
WHERE
author_id = ?
LIMIT 0,1
};
## more typing you don't need
#~ my $sth = $dbh->prepare( $statement );
#~ $sth->execute( $author_id );
#~ my @data = $sth->fetchrow_array;
my @data = $dbh->selectrow_array( $statement, {}, $author_id );
return template_author_profile( @data );
} ## end sub author_profile
sub database_connect {
my $dsn = "DBI:mysql:closewalk:localhost";
my $username = 'notroot';
my $password = '';
## die on error ... no more typing "or die" all over the place
my $att = {qw/RaiseError 1/};
return DBI->connect_cached( $dsn, $username, $password, $att );
} ## end sub database_connect
sub template_head {
my( $title, $added, $img, $msg ) = @_;
return qq{
$title
...
};
} ## end sub template_head
sub template_author_profile {
my( $title, $f_name, $l_name, $profile, $image ) = @_;
return qq{
$title
...
};
} ## end sub template_author_profile
sub template_footer {
return qq{
<b>...</b>
};
} ## end sub template_footer
sub DebugCGI {
my $cgi = CGI->new;
binmode STDOUT, ':encoding(UTF-8)';
$cgi->charset( 'UTF-8' );
print $cgi->header( -charset => 'UTF-8' );
print $cgi->start_html,
$cgi->b( rand time, ' ', scalar gmtime ),
'<table border="1" width="%100"><tr><td>',
$cgi->Dump,
'</td>',
'<td><div style="white-space: pre-wrap; overflow: scroll;">',
$cgi->escapeHTML( DD( $cgi ) ),
'</div></td></tr></table>',
CGI->new( \%ENV )->Dump,
$cgi->end_html;
} ## end sub DebugCGI
sub DebugCGI {
my $cgi = CGI->new;
binmode STDOUT, ':encoding(UTF-8)';
$cgi->charset( 'UTF-8' );
print $cgi->header( -charset => 'UTF-8' );
print $cgi->start_html,
$cgi->b( rand time, ' ', scalar gmtime ),
'<table border="1" width="%100"><tr><td>',
$cgi->Dump,
'</td>',
'<td><div style="white-space: pre-wrap; overflow: scroll;">',
$cgi->escapeHTML( DD( $cgi ) ),
'</div></td></tr></table>',
CGI->new( \%ENV )->Dump,
$cgi->end_html;
} ## end sub DebugCGI
sub DD {
require Data::Dumper;
return scalar Data::Dumper->new( \@_ )->Indent( 1 )->Useqq( 1 )->Dump;
} ## end sub DD
__END__