Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

diary.pl

by shockme (Chaplain)
on Feb 06, 2002 at 14:44 UTC ( [id://143627]=sourcecode: print w/replies, xml ) Need Help??
Category: Web Stuff
Author/Contact Info /msg shockme
Description: After reading this thread, I found myself facing some downtime, so I decided to throwt his together. I needed a small project with which I could begin learning CGI.pm, and this seemed a good candidate. It's not perfect and could use some tweaking here and there, but it scratches my itch.

Kudos to dws for his help when I became inevitably entagled. Sadly, I have yet to attain CGI-zen.

#!/usr/bin/perl -wT

use strict;
use vars qw/$DBI $dbh/;
use CGI qw/:all/;
use CGI::Carp qw( fatalsToBrowser );
use DBI;

$|++;   # disable buffering

my $q = new CGI;
print $q->header( "text/html" );

my $DSN    = "DBI:mysql:database_name"; # database to connect to
# my $host   = "localhost";       # database host name
my $user   = "userid";             # userid to connect with
my $passwd = "seekrit";         # password to connect with

# connect to database
my $dbh = DBI->connect($DSN, $user, $passwd) || die "Cannot connect: $
+DBI:errstr\n" unless $dbh;
# my $drh = DBI->install_driver("mysql");


if (($q->param( "new" )) or ($q->param( "update" ))) {
    print_form($dbh, $q);
}
elsif ($q->param( "insert" )) {
    insert_entry($dbh, $q);
    display_date_index($dbh, $q);
}
elsif ($q->param( "modify" )) {
    modify_entry($dbh, $q);
    display_date_index($dbh, $q);
}
elsif ($q->param( "search" )) {
    print_search_form($dbh, $q);
}
elsif ($q->param( "find" )) {
    find_it($dbh, $q);
}
elsif (!($q->param( "user" ))) {
    display_user_index($dbh, $q);
}
elsif (!($q->param( "diary_key" ))) {
    display_date_index($dbh, $q);
}
else {
    display_entry($dbh, $q);
}

display_index($q, undef);
print $q->end_html;
exit;

display_index($q, undef);
print $q->end_html;
exit;

sub display_user_index {
    my ($dbh, $q) = @_;

    print $q->start_html( -title => "Diary User Index", -bgcolor => "#
+FFFFFF");
    display_index($q, undef);

    my $SQLText = qq[ SELECT user_key, userid FROM user ORDER BY useri
+d ];
    my $sth     = $dbh->prepare($SQLText);
    my $query   = $sth->execute;
    while (my $ref = $sth->fetchrow_hashref()) {
        print $q->a( { -href=>"diary.pl?user=$ref->{'user_key'}" }, $r
+ef->{'userid'});
        print $q->br;
    }
}

sub display_date_index {
    my ($dbh, $q) = @_;

    my $user_key = $q->param( "user" );

    print $q->start_html( -title => "Diary Date Index", -bgcolor => "#
+FFFFFF");
    display_index($q, undef);

    my $SQLText = qq[ SELECT diary_key, diary_date, diary_title, useri
+d
                    FROM diary, user
                    WHERE user_key = ( ? )
                    AND fk_user_key = user_key
                    ORDER BY diary_date DESC ];

    my $sth     = $dbh->prepare($SQLText);
    my $query   = $sth->execute($user_key);
    while (my $ref = $sth->fetchrow_hashref()) {
        print $q->a( { -href=>"diary.pl?user=$user_key&diary_key=$ref-
+>{'diary_key'}" }, $ref->{'diary_date'});
        print " - $ref->{'diary_title'}";
        print $q->br;
    }
}

sub display_entry {
    my ($dbh, $q) = @_;

    my $user = $q->param('user');
    my $diary_key = $q->param('diary_key');

    print $q->start_html( -title => "Diary Entries for $q->param('user
+'): $q->param('date')", -bgcolor => "#FFFFFF");
    display_index($q, undef);

    my $sth     = get_entry($dbh, $user, $diary_key);
    my $ref     = $sth->fetchrow_hashref();

    print "<B>$ref->{'diary_title'}</B><br><br>";
    print "$ref->{'diary_entry'}";
}

sub display_index {
    my ($q, $ref) = @_;

    print ("<center>");
    print $q->a( { -href=>"diary.pl" }, "User Index");
    print (" ");

    my $user_key = $q->param( "user" );
    print $q->a( { -href=>"diary.pl?new=1&user=$user_key" }, "Add New"
+);
    print(" ");

    my $diary_key = $q->param('diary_key');
    print $q->a( { -href=>"diary.pl?update=1&user=$user_key&diary_key=
+$diary_key" }, "Update Entry")
        if ($q->param('user') and $q->param('diary_key'));

    print $q->a( { -href=>"diary.pl?search=1" }, "Search");
    print ("</center>");
}

sub get_entry {
    my ($dbh, $user_key, $diary_key) = @_;
#    my $user_key = $q->param('user');
#    my $diary_key = $q->param('diary_key');

    my $SQLText =  qq[ SELECT diary_title, diary_entry
                    FROM diary, user
                    WHERE user_key = ( ? )
                    AND fk_user_key = user_key
                    AND diary_key = ( ? ) ];

    my $sth     = $dbh->prepare($SQLText);
    my $query   = $sth->execute($user_key, $diary_key);
    return $sth;
}

sub insert_entry {
    my ($dbh, $q, $method) = @_;

    my $date = calcDate(0);
    my $title = $q->param('title');
    my $entry = $q->param('entry');
    my $user_key = $q->param('user');

    $entry =~ s/\n/<P>/g;

    my $SQLText = qq[ INSERT INTO diary SET
                   diary_date  = ( ? ),
                   diary_title = ( ? ),
                   diary_entry = ( ? ),
                   fk_user_key = ( ? ) ];

    my $sth     = $dbh->prepare($SQLText);
    my $query   = $sth->execute($date, $title, $entry, $user_key);
}

sub modify_entry {
    my ($dbh, $q, $method) = @_;

    my $title = $q->param('title');
    my $entry = $q->param('entry');
    my $user_key = $q->param('user');
    my $diary_key = $q->param('diary_key');

    $entry =~ s/\n/<P>/g;

    my $SQLText = qq[ UPDATE diary SET
                   diary_title = ( ? ),
                   diary_entry = ( ? ),
                   fk_user_key = ( ? )
                   WHERE diary_key = ( ? ) ];

    my $sth     = $dbh->prepare($SQLText);
    my $query   = $sth->execute($title, $entry, $user_key, $diary_key)
+;
}

sub calcDate {
    my $offset = shift;
    my($mday, $mon, $year) = (localtime(time - $offset * 86400))[3..5]
+;
    return sprintf "%04s-%02s-%02s", $year + 1900, $mon + 1, $mday;
}

sub print_form {
    my ($dbh, $q) = @_;
    my ($name, $title, $value, $entry, $ref, $sth) = "";
    my $user_key = $q->param( "user" );
    my $diary_key = $q->param( "diary_key" );

    print $q->start_html( -title => "Diary Entry", -bgcolor => "#FFFFF
+F");
    display_index($q, undef);

    if ($q->param( "new" )) {
        $name  = "insert";
        $value = "Add";
        $title = "";
        $entry = "";
    }
    # else $q->param('updEntry')
    else {
        $name  = "modify";
        $value = "Update";
        $sth   = get_entry($dbh, $user_key, $diary_key);
        $ref   = $sth->fetchrow_hashref();
        $title = $ref->{'diary_title'};
        $entry = $ref->{'diary_entry'};

        $entry =~ s/<P>/\n/g;
    }

    print <<END_FORM;
    <FORM ACTION="diary.pl" METHOD="POST">
    <TABLE BORDER=0 CELLSPACING=1 CELLPADDING=1>
    <TR><TD>Title</TD>
        <TD><INPUT TYPE="TEXT" SIZE=100 NAME="title" VALUE="$title"></
+TD>
    </TR>
    <TR>
        <TD COLSPAN=2><TEXTAREA COLS=100 ROWS=20 NAME="entry" VALUE="$
+entry"></TD>
    </TR>
    <TR><TD><INPUT TYPE="SUBMIT" NAME="$name" VALUE="$value"></TD>
        <TD><INPUT TYPE="RESET" VALUE="Clear"></TD>
    </TR>
    <TR><TD><INPUT TYPE="HIDDEN" NAME="user" VALUE="$user_key"></TD></
+TR>
    <TR><TD><INPUT TYPE="HIDDEN" NAME="diary_key" VALUE="$diary_key"><
+/TD></TR>
    </TABLE>
    </FORM>
END_FORM
}

sub print_search_form {
    my ($dbh, $q) = @_;
    my ($term, $range) = "";

    print $q->start_html( -title => "Search Diaries", -bgcolor => "#FF
+FFFF");
    display_index($q, undef);

    my $SQLText =  qq[ SELECT user_key, userid
                    FROM user
                    ORDER BY userid ];

    my $sth     = $dbh->prepare($SQLText);
    my $query   = $sth->execute;

    print <<FIRST_PART;
    <FORM ACTION="diary.pl" METHOD="POST">
    <TABLE BORDER=0 CELLSPACING=1 CELLPADDING=1>
    <TR><TD>Users <SELECT NAME="searchUser">
                          <OPTION VALUE="all">All Users
FIRST_PART

    while (my $row = $sth->fetchrow_hashref()) {
        print("<OPTION VALUE=$row->{'user_key'}>$row->{'userid'}");
    }

    print <<SECOND_PART;
    </SELECT></TD>
    </TR>
    <TR>
        <TD><INPUT TYPE="TEXT" SIZE=100 NAME="term" VALUE="$term"></TD
+>
    </TR>
    <TR><TD><INPUT TYPE="RADIO" CHECKED NAME="range" VALUE="phrase">Ex
+act Phrase
            <INPUT TYPE="RADIO" NAME="range" VALUE="words">All Words
        </TD>
    </TR>
    <TR><TD><INPUT TYPE="RADIO" CHECKED NAME="range" VALUE="any">Any W
+ords
    <TR><TD><INPUT TYPE="SUBMIT" NAME="find" VALUE="Find">
            <INPUT TYPE="RESET" VALUE="Clear"></TD>
    </TR>
    </TABLE>
    </FORM>
SECOND_PART
}

sub find_it {
    my ($dbh, $q) = @_;

    my $searchPhrase = $q->param( "term" );
    my $titlePhrase  = $q->param( "term" );
    my $searchRange  = $q->param( "range" );
    my $searchUser   = $q->param( "searchUser" );

    print $q->start_html( -title => "Search results for $searchPhrase"
+, -bgcolor => "#FFFFFF");
    display_index($q, undef);

    if ($searchRange eq "words") {
        $searchPhrase =~ s/^ //g;
        $searchPhrase =~ s/ $//g;
        $searchPhrase =~ s/ /%" AND diary_entry LIKE "%/g;
        $titlePhrase  = $searchPhrase = "diary_entry LIKE \"%" . $sear
+chPhrase . "%\"";
        $titlePhrase  =~ s/diary_entry/diary_title/g;
    }
    elsif ($searchRange eq "any") {
        $searchPhrase =~ s/^ //g;
        $searchPhrase =~ s/ $//g;
        $searchPhrase =~ s/ /%" OR diary_entry LIKE "%/g;
        $titlePhrase  = $searchPhrase = "diary_entry LIKE \"%" . $sear
+chPhrase . "%\"";
        $titlePhrase  =~ s/diary_entry/diary_title/g;
    }
    else {
        $searchPhrase = "diary_entry LIKE \"%" . $searchPhrase . "%\""
+;
        $titlePhrase  = "diary_title LIKE \"%" . $titlePhrase . "%\"";
    }

    my $SQLText = qq[ SELECT user_key, userid, diary_key, diary_date, 
+diary_title
                   FROM user, diary
                   WHERE user_key = fk_user_key
                   AND (($searchPhrase)
                   OR ($titlePhrase)) ];

    if ($searchUser ne "all") {
        $SQLText = $SQLText . " AND fk_user_key = \"$searchUser\"";
    }

    $SQLText = $SQLText . " ORDER BY diary_date DESC";
    my $sth     = $dbh->prepare($SQLText);
    my $query   = $sth->execute;

    print <<FIRST_PART;
    <TABLE BORDER=0 CELLSPACING=5 CELLPADDING=1>
    <TR><TH>User</TH><TH>Date</TH><TH>Title</TH></TR>
FIRST_PART

    my $Found = 0;
    while (my $row = $sth->fetchrow_hashref()) {
        $Found = 1;
        print("<TR><TD>$row->{'userid'}</TD><TD>$row->{'diary_date'}</
+TD>");
        print("<TD><a href=\"diary.pl?user=$row->{'user_key'}&diary_ke
+y=$row->{'diary_key'}\">$row->{'diary_title'}</a></TD></TR>");
    }

    if (!($Found)) {
        print("<TR><TD COLSPAN=3>No Records Found</TD></TR>");
    }

    print <<SECOND_PART;
    </TABLE>
SECOND_PART
}

Update: Added the following MySQL table definition.

CREATE TABLE diary (
  diary_key int(11) NOT NULL auto_increment,
  diary_date date NOT NULL default '0000-00-00',
  diary_title varchar(255) default NULL,
  diary_entry longtext,
  fk_user_key int(8) NOT NULL default '0',
  PRIMARY KEY  (diary_key),
  KEY diary_ndx (diary_key,fk_user_key)
) TYPE=MyISAM;
Replies are listed 'Best First'.
(crazyinsomniac) Re: diary.pl
by crazyinsomniac (Prior) on Feb 07, 2002 at 08:12 UTC
    I took a quick look at this, and I see a lot of familiar technique (you remind me of me) which I wouldn't employ now ;)

    I will now ask you a few similar questions, and hopefully get you thinking about what I mean.

    Why do you include use CGI qw/:all/;?
    What do you think the above code does?

    Why do you include my $q = new CGI;?

    Why do you include $q->param?
    Why do you include print <<END_FORM;?

    Do you see a conflict of technique yet?

    I also see print("<center>"); and while it is understandable that you can't always say print center('stuff in here');, there is always print start_center,'stuff',end_center; (that trick only available if you're aware of use CGI qw/*center/;

    Some might argue performance when choosing between print("<center>"); and print start_center;, but my point is, either use the CGI.pm functional or OO interface, but don't mix. Also, if you do bother to 'import' :all the CGI functions, use them. Also, either stick to heredocs, or stick to CGI functions for generating html, don't mix.

    And probably the least important of my comments if (!($Found)) { if fine, but why did you choose to write it that way (probably cause it looks a lot like Java or c/c++ or something)? You are programming in perl now, and while some might argue that keeping things familiar helps you keep things straight, beginning to think in terms perlsyn helps you think of new solutions ( if (! $Found) { or if (not $Found) { or unless ($Found) { ).

    Consider this, if you wanted to iterate over an @array, how often would you write for(my $i=0;$i<90;$i++) {print $array[$i].$jerky."\n";}?

    for my $i(@array) { print $i.$jerky."\n" } print $_.$jerky."\n" for @array; print shift(@array).$jerky."\n" while @array; print map $_.$jerky."\n", @array; print map { "${_}${jerky}\n" } @array;
    Think about it (but don't worry too much, after all, you at least have -wT -Mstrict in there ) :)

    However, you also might wanna look into CGI's escape, unescape, and escapeHTML functions, especially for this line -href=>"diary.pl?user=$user_key&diary_key=$ref->{'diary_key'}"

    Happy Coding!

    update:

    # Another minor comment, sql statemends end in ; # so I try to end all mine in ;, and I always reccomend # others do as well (;) my $SQLText = qq[ UPDATE diary SET diary_title = ( ? ), diary_entry = ( ? ), fk_user_key = ( ? ) WHERE diary_key = ( ? );];
    and this one is almost ridiculous, but $entry =~ s/\n/<P>/g; i feel might be more appropriately written as
    $entry =~ s/\n\n/<P>/g; $entry =~ s/\n/<br>/g;
    (yeah, I know, *almost*, who am I kidding ;D)

     
    ______crazyinsomniac_____________________________
    Of all the things I've lost, I miss my mind the most.
    perl -e "$q=$_;map({chr unpack qq;H*;,$_}split(q;;,q*H*));print;$q/$q;"

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others admiring the Monastery: (7)
As of 2024-03-19 09:47 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found