Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/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;

In reply to diary.pl by shockme

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others meditating upon the Monastery: (14)
    As of 2014-12-18 20:24 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      Is guessing a good strategy for surviving in the IT business?





      Results (61 votes), past polls