Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Re^5: I need help with displaying newline or paragraph using perl on my website (pass arguments more subs)

by Anonymous Monk
on Jun 29, 2014 at 22:45 UTC ( #1091660=note: print w/replies, xml ) Need Help??


in reply to Re^4: I need help with displaying newline or paragraph using perl on my website
in thread I need help with displaying newline or paragraph using perl on my website

Why aren't you passing $dbh around? You should do that, and you should have more subs, and pass more arguments; programming, its all about argument passing and good subroutine names :) if you need comments to explain what the subroutine does you need to change your subroutine name

No comments like this >> A subroutine for the database connection if the name db_connect does doesn't communicate that, change it, name your subroutine database_connection ... Ways of commenting subroutines

To give you some ideas look at this code read this program

#!"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 "<h1>something broke, we know what it is, thank you, try aga +in later</h1>\n"; if( DEBUG ) { # secrets print '<p>', CGI->escapeHTML(@_), '</p>'; } } ); } use CGI; use DBI; Main( @ARGV ); exit( 0 ); sub Main { ## return DebugCGI(); ## "for debugging cgi programs" << great comm +ent << 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 ' ', '<b>', CGI->escapeHTML( "@_" ), '</b>'; print qq{ <!DOCTYPE html> <html> <title> 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_arra +y( $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 autho +r_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 )->D +ump; } ## end sub DD __END__

You can see i haven't quite thought it through... but you should do that, its your app :) sub Main is a good example, the idea is to model the app in its own terms

Probably  print ArticleDance...; is what it should be where ArticleDance does  return $headers, $body; ... so there are no  sub print_... they all just return $stuff

update: here is some of those changes

#!"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 => !!( 0 || $ENV{PERL_DEBUG_MYAPPNAME} ); #~ use diagnostics; #~ use CGI::Carp qw{ fatalsToBrowser }; use CGI; use DBI; use CGI::Carp qw( fatalsToBrowser ); BEGIN { CGI::Carp::set_message( sub { print "<h1>something broke, we know what it is, thank you, try aga +in later</h1>\n"; if( DEBUG ) { # secrets print '<p>', CGI->escapeHTML(@_), '</p>'; } } ); } Main( @ARGV ); exit( 0 ); sub Main { ## return DebugCGI(); ## "for debugging cgi programs" << great comm +ent << sarcasm :) my $query = CGI->new; #~ my $article_id = digit_only( $query->param( 'article_id' ) ); my $article_id = article_id( $query ); #~ return ArticleDance( $article_id ); my $body = ArticleDance( $article_id ); my $headers = http_headers( $query ); print $headers, $body; } ## 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 Article( $dbh, $article_id ); } else { #~ return print_error_message(); return error_artid(); } } ## end sub ArticleDance sub http_headers { my( $q ) = @_; return $q->header( -nph => 1 ); } ## end sub http_headers sub error_artid { return error_message( 'article_id not good' ); } ## end sub error_artid sub error_message { my $errmsg = join ' ', '<b>', CGI->escapeHTML( "@_" ), '</b>'; return qq{ <!DOCTYPE html> <html> <title> Fudgy error <body> $errmsg }; } ## end sub error_message sub 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 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_arra +y( $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 autho +r_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 DD { require Data::Dumper; return scalar Data::Dumper->new( \@_ )->Indent( 1 )->Useqq( 1 )->D +ump; } ## end sub DD __END__

For the whys and the hows of some things see

Tutorials: Variable Scoping in Perl: the basics,
Coping with Scoping

placeholders bobby-tables.com: A guide to preventing SQL injection in Perl

see Re: No such file or directory error/No such file or directory error, see template at (tye)Re: Stupid question (and see one discussion of that template at Re^2: RFC: Creating unicursal stars

  • Comment on Re^5: I need help with displaying newline or paragraph using perl on my website (pass arguments more subs)
  • Select or Download Code

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (3)
As of 2021-04-10 12:33 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?