#!/usr/pgrad/sholden/arch/SunOSsun4u/bin/perl -T
# ...obviously the above line will need to reflect where perl actually is...
#
# Bookmarker - a cgi script to manage bookmarks
# Uses a mysql database the schema (as mysql statements to create the tables) is
# located at the end of this file (after __END__).
# The idea is to store bookmarks on a web server so that they can be
# accessed from multiple machines and browsers (at home and work for example).
# The interface is not customisable (apart from editing the code) and is not
# pretty by any stretch, but it seems to work well enoough for me.
# The only set back is how to add bookmarks, on browsers which support
# javascript urls the following works (as a standard bookmark or favourite
# in the browser) - as one line with no spaces of course:
# ---
# javascript:document.location="http://www.cs.usyd.edu.au/~sholden/bookmarks.cgi
# ?mode=add;name="+document.title+";url="+document.location
# ---
# Obviously the url of the bookmarks.cgi needs to be changed to wherever you
# happen to place the script. Possibly there should be some esscaping on
# special characters in the title and location, which I'll add if I ever run
# across a problem.
#
# There are a few variables below that will need to be customised to suit your
# database and cookie preferences.
use CGI ':standard';
use CGI::Carp 'fatalsToBrowser';
use HTML::Entities;
use URI::Escape;
use DBI;
use strict;
# Variables that require modification to suit installation
our $AUTHENTICATION = 'param';# current options are 'cookie' and 'param'
# 'cookie' requires cookie support in the
# browser - and the password is stored in
# plain text in the cookie, which is bad.
# 'param' uses the CGI parameters to pass the
# the password - the password is often passed
# in plain text as part of the URL and will be
# visible in logs and proxies - which is worse!
# the password itself is the password to the
# database.
our $DB_DATASOURCE = 'DBI:mysql:bookmark_sample;host=mrmph.cs.usyd.edu.au';
our $DB_USERNAME = 'b_sample';
# End Variables that require modification to suit installation
# Hopefully nothing below this needs to be modified
our %dispatch = (
list => \&list_bookmarks,
list_cat => \&list_bookmarks_by_cat,
add => \&add_bookmark,
# idiots keep deleting things... so disable it
#delete => \&delete_bookmark,
edit => \&edit_bookmark,
new_form => \&new_bookmark,
cat_add => \&add_category,
cat_update => \&update_category,
cat_manage => \&cat_management,
search => \&search_bookmarks,
set_cookie => \&generate_password_cookie,
logout => \&cookie_logout,
);
our $dbh;
our $mode = param('mode');
our $pass = param('pass');
$pass = "" unless $AUTHENTICATION eq 'param';
our $e_pass = encode_entities($pass);
if ($mode eq 'set_cookie') { generate_password_cookie(); }
db_connect() || password_request_form_and_exit();
$mode = 'list' unless exists $dispatch{$mode};
$dispatch{$mode}->();
db_disconnect();
###############
# Deal with the database connection and disconnection
###############
sub db_connect {
my $password;
if ($AUTHENTICATION eq 'param') {
$password = param('pass');
} elsif ($AUTHENTICATION eq 'cookie') {
$password = cookie('bookmarker_pass');
}
$password = shift if @_; # argument overrides $AUTHENITICATION
eval {
$dbh = DBI->connect($DB_DATASOURCE, $DB_USERNAME, $password,
{RaiseError=>1});
};
if ($@) {
if ($@=~/Access denied/) {
#die "*$password*", DBI->errstr;
return undef;
} else {
die "Error connection to database : ",DBI->errstr;
}
}
return 1;
}
sub db_disconnect {
$dbh->disconnect;
}
###############
# Deal with the addition of a new bookmark
###############
sub add_bookmark {
my $url=param('url') || '[no url specified]';
my $name = param('name');
$name = $url unless defined $name;
my $sth = $dbh->prepare("insert into bookmark (name,url) VALUES (?,?)");
$sth->execute($name,$url);
$sth->finish;
$sth = $dbh->prepare("select LAST_INSERT_ID() AS ID");
$sth->execute();
my $id = $sth->fetchrow_hashref()->{ID};
$sth->finish;
store_changes_to_bookmark($id);
print redirect(create_url('mode'=>'edit', id=>$id));
}
###############
# Deal with addition of new category
###############
sub add_category {
my $pid = param('parentID');
my $name = param('name');
my $sth;
my @args;
if (defined $pid) {
$sth=$dbh->prepare(
'insert into category (name,parentID) VALUES (?,?)');
@args = ($name,$pid);
} else {
$sth=$dbh->prepare('insert into category (name) VALUES (?)');
@args = ($name);
}
$sth->execute(@args);
# redirect to the category management page
print redirect(create_url('mode'=>'cat_manage'));
}
###############
# Deal with category management
###############
sub cat_management {
my @root = get_category_tree();
page_header('Bookmarker - Category Management');
print '
';
for my $elem (sort {$a->{name} cmp $b->{name}} @root) {
output_category_tree($elem);
}
print '
';
output_add_cat_form();
print '
';
page_footer();
}
sub output_category_tree {
my $c = shift;
print '
';
output_modify_cat_form($c);
print '
';
for my $sc (sort {$a->{name} cmp $b->{name}} @{$c->{children}}) {
output_category_tree($sc);
}
print '
';
output_add_cat_form($c->{id});
print '
';
}
sub output_add_cat_form {
my $id = shift;
print start_form();
print hidden(-name=>'mode', -default=>'cat_add', -override=>1);
print hidden(-name=>'pass');
print textfield(-name=>'name', -override=>1);
print hidden(-name=>'parentID', -default=>$id)
if defined $id;
print submit(-value=>'Add');
print end_form;
}
sub output_modify_cat_form {
my $cat = shift;
print start_form();
print hidden(-name=>'mode', -value=>'cat_update', -override=>1);
print hidden(-name=>'pass');
print hidden(-name=>'id', -default=>$cat->{id}, -override=>1);
print textfield(-name=>'name', -default=>$cat->{name}, -override=>1);
print submit(-value=>'Update');
print end_form;
}
###############
# Deal with category update
###############
sub update_category {
my $id = param('id');
my $name = param('name');
$name = '[none]' unless defined $name;
my $sth = $dbh->prepare('update category set name=? where id=?');
$sth->execute($name,$id);
# redirect to the category management page
print redirect(create_url('mode'=>'cat_manage'));
}
###############
# Deal with deleting bookmark
###############
sub delete_bookmark {
my $id = param('id');
my $sth = $dbh->prepare('delete from bookmark where ID = ?');
$sth->execute($id);
page_header('Bookmarker - Bookmark Deleted');
print '
Bookmark deleted
';
page_footer();
}
###############
# Deal with adding new bookmark form
###############
sub new_bookmark {
page_header('Bookmarker - Add Bookmark');
output_bookmark_edit_form();
page_footer();
}
###############
# Deal with editing bookmark
###############
sub edit_bookmark {
my $id = param('id');
# update the database if new data is given
if (param('update')) {
store_changes_to_bookmark($id);
}
# output a form for editing the specified bookmark
page_header('Bookmarker - Bookmark Editor');
output_bookmark_edit_form($id);
page_footer();
}
sub store_changes_to_bookmark {
my $id = shift;
my $url = param('url');
$url = '[no url specified]' unless defined $url;
my $name = param('name');
$name = $url unless defined $name;
my $note = param('note');
my $sth=$dbh->prepare(
'update bookmark set name=?, url=? where ID=?');
$sth->execute($name,$url,$id);
$sth->finish;
$sth=$dbh->prepare('delete from notation where bookmarkID=?');
$sth->execute($id);
$sth->finish;
if ($note!~/^\s*$/) {
$sth=$dbh->prepare(
'insert into notation (bookmarkID,note) VALUES (?,?)');
$sth->execute($id,$note);
$sth->finish;
}
$sth=$dbh->prepare('delete from book_cat where bookmarkID = ?');
$sth->execute($id);
$sth->finish;
$sth=$dbh->prepare(
'insert into book_cat (bookmarkID,categoryID) VALUES (?,?)');
for my $cat (param('categories')) {
$sth->execute($id,$cat);
}
$sth->finish;
}
sub output_bookmark_edit_form {
my $id = shift;
my $sth = $dbh->prepare(
'select * from bookmark left join notation on
bookmark.id = notation.bookmarkID where bookmark.ID = ?');
$sth->execute($id);
if (my $row = $sth->fetchrow_hashref() || !defined($id)) {
$row = {'name'=>'','url'=>'','note'=>''} unless defined $id;
my $name = $row->{name};
my $url = $row->{url};
my $note = $row->{note};
print start_form;
if (defined $id) {
print hidden(-name=>'id',-default=>$id,-override=>1);
print hidden(-name=>'mode',-default=>'edit',
-override=>1);
} else {
print hidden(-name=>'mode',-default=>'add',
-override=>1);
}
print hidden(-name=>'pass');
print table(Tr([
td(['URL :',textfield(-name=>'url',-default=>$url,
-override=>1)]),
td(['Name :',textfield(-name=>'name',-default=>$name,
-override=>1)]),
td(['Note :',textarea(-name=>'note',-default=>$note,
-rows=>5, -columns=>40, -override=>1)]),
td(['Categories :',category_selection_string($id)]),
td({-colspan=>2,align=>'center'}, (defined($id)?
submit(-name=>'update',-value=>'Update'):
submit(-name=>'create',-value=>'Create')))
]));
print end_form;
}
}
sub category_selection_string {
my $id = shift;
my $string = "";
my $sth = $dbh->prepare(
'select categoryID from book_cat where bookmarkID = ?');
$sth->execute($id);
my %cats;
while (my $row = $sth->fetchrow_hashref()) {
$cats{$row->{categoryID}} = 1;
}
$sth->finish;
$string = '"
}
sub category_option_string {
my $start = shift;
my $c = shift;
my $cats = shift;
my %opts = (-value=>$c->{id});
$opts{'selected'} = undef if exists $cats->{$c->{id}};
my $string .= option(\%opts,"${start}$c->{name}");
for my $cat (@{$c->{children}}) {
$string.=category_option_string("$start$c->{name}:",$cat,$cats);
}
return $string;
}
###############
# Deal with listing all bookmarks
###############
sub list_bookmarks {
my $sth = $dbh->prepare('select * from bookmark order by name');
$sth->execute();
page_header('Bookmarker - Flat Bookmark List');
print '
';
output_bookmark_list($sth);
print '
';
page_footer();
}
###############
# Deal with listing bookmarks by category
###############
sub list_bookmarks_by_cat {
my $id = param('id');
my @root = get_category_tree();
page_header('Bookmarker - Category Bookmark List');
print '
';
if (defined $id) {
my $cat = find_category_in_tree($id,\@root);
output_bookmarks_by_cat($cat);
} else {
for (sort {$a->{name} cmp $b->{name}} @root) {
output_bookmarks_by_cat($_);
}
output_bookmarks_with_no_cat();
}
print '
';
page_footer();
}
sub output_bookmarks_by_cat {
my $cat = shift;
print '
';
for my $c (sort {$a->{name} cmp $b->{name}} @{$cat->{children}}) {
output_bookmarks_by_cat($c);
}
my $sth = $dbh->prepare('select bookmark.* from bookmark, book_cat,
category where bookmark.ID = book_cat.bookmarkID and
category.ID = book_cat.categoryID and category.ID = ?
order by bookmark.name');
$sth->execute($cat->{id}+0);
output_bookmark_list($sth);
print '
';
}
sub output_bookmarks_with_no_cat {
my $sth = $dbh->prepare('select * from bookmark left join book_cat
on bookmark.ID = book_cat.bookmarkID
where book_cat.bookmarkID is null');
$sth->execute();
output_bookmark_list($sth);
}
###############
# Search functionality...
###############
sub search_bookmarks {
my $needle = param('needle');
page_header('Bookmarker - search');
output_search_form($needle);
if (defined $needle) {
output_search_results($needle);
}
page_footer();
}
sub output_search_form {
my $needle = shift;
$needle = "" unless defined $needle;
print start_form();
print textfield(-name=>'needle');
print hidden(-name=>'mode',-default=>'search',-override=>1);
print hidden(-name=>'pass');
print submit(-value=>'Search');
print hr;
print end_form();
}
sub output_search_results {
my $needle = shift;
$needle = $dbh->quote("%$needle%");
my $sth = $dbh->prepare("select bookmark.* from
bookmark left join notation on bookmark.ID = notation.bookmarkID
where bookmark.name LIKE $needle or bookmark.url LIKE $needle or
notation.note LIKE $needle order by bookmark.name");
$sth->execute();
print '
';
output_bookmark_list($sth);
print '
';
}
###############
# Deal with requesting and accepting a password and logging out
###############
sub password_request_form_and_exit {
print header;
print start_html('Bookmarker - Password Request');
print h1('Password Required');
print start_form;
print hidden(-name=>'mode',-default=>'set_cookie',-override=>1)
if $AUTHENTICATION eq 'cookie';
print password_field(-name=>'pass',-value=>'',-override=>1);
print submit(-value=>'Login');
print end_form;
print end_html;
exit();
}
sub generate_password_cookie {
db_connect(param('pass')) || password_request_form_and_exit();
my $path = url('-absolute');
$path=~s|^\w+://[^/]+||;
my $cookie = cookie(-name=>'bookmarker_pass', -path=>$path,
-value=>param('pass'), -expires=>'+1y');
print header(-cookie => $cookie);
print start_html('Login Cookie Set');
print a({-href=>url()},'Click to continue');
print end_html;
exit();
}
sub cookie_logout {
my $path = url('-absolute');
$path=~s|^\w+://[^/]+||;
my $cookie = cookie(-name=>'bookmarker_pass', -path=>$path,
-value=>'');
print header(-cookie => $cookie);
print start_html('Bookmarker - Logout Complete');
print h1('Logout complete');
print end_html;
exit();
}
###############
# Helper functions used by various other functions
###############
sub create_url {
my %params = @_;
my $url = url().'?';
while (my ($key, $value) = each %params) {
$url .= uri_escape($key).'='.uri_escape($value).';';
}
$url .= 'pass='.uri_escape($pass) unless $pass eq "";
return $url;
}
sub get_category_tree {
my $sth = $dbh->prepare('select * from category');
$sth->execute();
my %cats;
my @root;
while (my $row = $sth->fetchrow_hashref()) {
$cats{$row->{ID}} = {name=>$row->{name},
parentID=>$row->{parentID},
children=>[], id=>$row->{ID}};
}
for my $k (keys %cats) {
if (defined $cats{$k}{parentID}) {
push @{$cats{$cats{$k}{parentID}}{children}}, $cats{$k};
} else {
push @root, $cats{$k};
}
}
return @root;
}
sub find_category_in_tree {
my $id = shift;
my $root = shift;
for my $c (@{$root}) {
if ($c->{id} == $id) {
return $c;
} else {
my $r = find_category_in_tree($id,$c->{children});
return $r if defined $r;
}
}
return undef;
}
sub output_bookmark_list {
my $sth = shift;
while (my $row = $sth->fetchrow_hashref()) {
my $name = $row->{name};
my $url = $row->{url};
my $id = $row->{ID};
print '