Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
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 ( [id://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__

[download]

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__

[download]

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

In Section Seekers of Perl Wisdom

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: note [id://1091660]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others taking refuge in the Monastery: (6)
As of 2024-09-20 14:49 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    The PerlMonks site front end has:





    Results (26 votes). Check out past polls.
    Notices?
    • erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.