#!/usr/bin/perl -w
=head1 NAME
Webnote - an online tool for taking notes
=head1 DESCRIPTION
This is based on great webnote from
L<http://www.aypwip.org/webnote/>
=head1 METHODS
=cut
package Webnote;
use strict;
BEGIN {
use Exporter ();
use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$VERSION = 0.1;
@ISA = qw (Exporter);
#Give a hoot don't pollute, do not export more than needed by default
@EXPORT = qw ();
@EXPORT_OK = qw ();
%EXPORT_TAGS = ();
}
use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
use XML::Simple;
use DBI;
use POSIX qw(strftime);
use Date::Parse;
use URI::Escape;
use Encode qw/decode from_to encode/;
use XML::RSS;
use Data::Dumper;
my $debug = 1;
my $webnote1 = <<EOF1;
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<base href="%s">
<script type="text/javascript" src="objects.js"></script>
<script type="text/javascript" src="webnote.js"></script>
<script type="text/javascript">
<!--
function loadinit()
{
debugOn = %d;
workspace.setName(unescape('%s'));
workspace.loadedTime = '%s';
init();
workspace.nextNoteNum = %d;
EOF1
my $webnote2 = <<EOF2;
workspace.changed = false;
}
// -->
</script>
<link rel="stylesheet" href="style.css" type="text/css" />
<link rel="alternate" type="application/rss+xml" title="RSS" href="%s" />
<title>%s</title>
</head>
<body onload='loadinit();' style='background-color: #f0f0f0;'>
<div id='content'>
<div id='toolbar'>
<div class='controls'>
<img src='images/new.gif' class='controls' onclick="workspace.createNote()" title="new note" alt='new note' />
<img src='images/save.gif' class='controlsDisabled' onclick="workspace.save()" title="save workspace" id="saveImg" alt='save workspace' />
<img src='images/reload.gif' class='controls' onclick="workspace.loadlist()" title="load previous version" alt='load previous version' />
<img src='images/undo.gif' class='controlsDisabled' onclick="workspace.history.undo()" title="nothing to undo" id="undoImg" alt='undo icon' />
<img src='images/redo.gif' class='controlsDisabled' onclick="workspace.history.redo()" title="nothing to redo" id="redoImg" alt='redo icon' />
</div>
<div id='filters'>
<input class='filters' style='width: 135px; padding: 1px 2px 1px 2px;' id='textfilter' title='enter a regular expression to filter by' onchange='workspace.filter(this.value)' onkeydown='if(13==event.keyCode){workspace.filter(this.value);}; event.cancelBubble=true;'/>
<!-- this button is strictly for looks -->
<input class='filters' style='width: 50px;' type='button' value='filter' />
</div>
<div id='mini' title='you have no notes'>
</div>
<div id='links'>
<a href="%s" title='rss feed of these notes' ><img style='margin: 6px 2px;border:0;width:19px;height:9px;' src='images/minixml.gif' alt='xml' /></a>
</div>
<div id='wsname'>
</div>
</div>
<div id='db'></div>
<div style='display: none;'><img src='images/close.gif' alt='red X' /></div>
</div>
</body>
</html>
EOF2
sub debug {
return unless ($debug);
return unless (@_);
print STDERR '[' . localtime() . '] ' . Carp::shortmess(@_);
}
=head2 new
Create new Webnote object
my $wn = new Webnote(
dsn => 'dbi:Pg:dbname=webnote',
db_user => 'foobar',
db_passwd => 'secret',
db_codepage => 'ISO-8859-2',
adminEmail => 'dpavlin(at)rot13(dot)org',
debug => 1,
);
If C<db_codepage> isn't specified, ISO-8859-1 will be used.
=cut
sub new {
my $class = shift;
my $self = {@_};
bless($self, $class);
die "need dsn" unless ($self->{'dsn'});
$self->{'dbh'} = DBI->connect($self->{'dsn'}, $self->{'db_user'}, $self->{'db_passwd'}) || die $DBI::errstr;
$self->{'cgi'} = new CGI || die "can't make CGI object";
$debug = $self->{'debug'};
# default database codepage
$self->{'db_codepage'} ||= 'ISO-8859-1';
$self ? return $self : return undef;
}
=head2 run
Main loop of Webnote.
$wn->run( default => sub {
my $self = shift;
# do something if no action is handled
# (by default, it's form to enter workspace name)
} );
This is main loop of Webnote back-end which will handle following methods
(invoked via URL):
=over 12
=item /save
Save workplace to database
=item /getdates
Get all modifications of workplace
=item /getrecent
Get last modification of workplace
=item /load
Load workplace
=item /rss
Generate RSS for all notes in workplace
=item /stats
Generate RSS for statistics of all workplaces
=back
If there isn't any method specified in URL, it will by default produce form
to enter workspace name. This can be overridden with C<default> parametar
and coderef.
C<default> coderef should emit it's own headers and return true.
=cut
sub run {
my $self = shift;
my $arg = {@_};
my $q = $self->{'cgi'} || die "no CGI?";
my $method = $q->path_info();
debug "method: $method ",$q->query_string()," [",($q->content_type() || 'unknown'),"]";
if ( ( $q->content_type() && $q->content_type() eq 'text/xml' ) || $method eq '/save') {
$self->save();
} elsif (my $name = $q->param('name')) {
if ($method eq '/getdates') {
my $offset = $q->param('offset') || 0;
$self->getdates($name, $offset, 100);
} elsif ($method eq '/getrecent') {
$self->getdates($name,0,1);
} else {
# handle /load too
$self->load($name);
}
} elsif ($method =~ m#^/rss/(.+)$#) {
$self->rss($1);
} elsif ($method eq '/stats') {
$self->stats();
} elsif ($method) {
print $q->header,
"unknown method: $method";
} elsif (ref $arg->{'default'}) {
no strict 'refs';
$arg->{'default'}->($self) || die "default method didn't return true";
} else {
print $q->header,
$q->start_html(
-title=>'webnote - with perl back-end',
-style=>{'src'=>'style.css'},
),
$q->start_form,
"load or create workspace ",$q->textfield('name'),
$q->submit(-name=>'Go'),
$q->end_form;
}
}
=head2 save
Save note to database. This action is called when there is C<text/xml>
content from POST request.
$wn->save() || die "can't save";
=cut
sub save {
my $self = shift;
my $q = $self->{'cgi'} || return;
my $xml_post;
if ($q->content_type() && $q->content_type() eq 'text/xml') {
# this is ugly cludge!
$xml_post = $q->{'POSTDATA'}->[0];
} elsif ($q->path_info() eq '/save') {
my $post = $q->query_string() || return;
# fix microsoft smart quotes
$post =~ s/%E2%80%9[CD]/"/gi;
$post =~ s/%E2%80%9[89]/'/gi;
$xml_post = uri_unescape( $post );
} else {
return;
}
return unless ($xml_post);
$xml_post =~ s/%u201[cd]/"/gi;
$xml_post =~ s/%u201[89]/'/gi;
$xml_post =~ s/^POSTDATA=//;
# $xml_post = decode('UTF-8',$xml_post);
# $xml_post = '<xml version="1.0" encoding="UTF-8"?>' . $xml_post;
debug "xml_post = $xml_post\n";
# open(my $t, '>', '/tmp/post.xml');
# if ($t) {
# print $t $xml_post;
# close($t);
# }
my $xml = XMLin($xml_post, ForceArray => [ 'note' ]);
if (! $xml) {
warn "can't prase $xml_post\n";
print $q->header(-type=>'text/xml'), qq{\n<return>\n<status value="error">\n</return>\n};
return undef;
};
$xml->{'time'} ||= $self->_fmt_utime(time());
debug "note: ",Dumper($xml);
if ($self->store_workspace($xml)) {
# return ok to JavaScript
print $q->header(-type=>'text/xml'), qq{\n<return>\n<status value="ok" update="$xml->{'time'}"/>\n</return>\n};
} else {
print $q->header(-type=>'text/xml'), qq{\n<return>\n<status value="error">\n</return>\n};
return undef;
}
return 1;
}
=head2 load
This function loads workspace.
my $wn->load('Workspace name');
=cut
sub load {
my $self = shift;
my $name = shift || return;
my $q = $self->{'cgi'} || die "need cgi";
print $q->header(
-charset => 'UTF-8',
);
my $ws = $self->load_workspace($name, $q->param('time'));
my $base_href = $q->url();
my $rel = $q->url(-relative=>1);
$base_href =~ s/$rel$//g;
$ws->{'time'} ||= $self->_fmt_utime(time());
$ws->{'nextnotenum'} ||= 1;
printf($webnote1,
$base_href,
($debug || 0),
$self->js_escape($name),
$ws->{'time'},
$ws->{'nextnotenum'}
);
print " baseURI = '", $q->url(), "';\n";
print " adminEmail = '", $self->{'adminEmail'}, "';\n";
print " numDates = 10;\n";
if ($ws) {
debug "loaded workspace: $name\n";
debug Dumper($ws);
foreach my $n (@{$ws->{'note'}}) {
my $c = $n->{'content'};
$c =~ s/[\n\r]+//g;
printf qq# workspace.createNote( { 'id':'%s', 'xPos':'%s', 'yPos':'%s', 'height':'%s', 'width':'%s', 'bgcolor':'%s', 'zIndex':'%s', 'text':unescape('%s') }, true );\n#,
$n->{'noteid'},
$n->{'xposition'},
$n->{'yposition'},
$n->{'height'},
$n->{'width'},
$n->{'bgcolor'},
$n->{'zindex'},
$self->js_escape($c);
}
if (my $newnote = $q->param('nn')) {
debug "newnote: $newnote";
my $via = $q->param('via');
$newnote .= qq{ <br/><span class="via">via:<a href="$via">$via</a></span>} if ($via);
$newnote = $self->js_escape($newnote);
print qq# workspace.createNote( { 'text':unescape('$newnote') } );\n#;
}
} else {
debug "new workspace: $name\n";
}
my $rss_url = $q->url().'/rss/'.uri_escape($name);
printf $webnote2,$rss_url,$name,$rss_url;
}
=head2 workspace_info
Get workspace by name (and time)
my $ws_info = $wn->workspace_info('Workspace name', 1111679331);
If no time is specified, it will return latest version of workspace.
=cut
sub workspace_info {
my $self = shift;
my $name = shift || return;
my $time = shift;
my $sql = qq{
select
wsid, wsname, nextNoteNum, time
from wn_workspaces
where wsname = ?
};
my @arg = ( $name );
if ($time) {
$sql .= qq{ and time = ? };
push @arg, $time;
} else {
$sql .= qq{ order by time desc limit 1 };
}
my $sth = $self->{'dbh'}->prepare($sql) || die $self->{'dbh'}->errstr();
$sth->execute(@arg) || die $sth->errstr();
my $ws_info = $sth->fetchrow_hashref();
debug "workspace_info($name,$time): ",Dumper($ws_info);
return $ws_info;
}
=head2 store_workspace
Save workspace data to database
$wn->store_workspace($workspace_hash);
C<$workspace_hash> has following structure:
'name' => 'foo',
'nextNoteNum' => '153',
'time' => 1111674868,
'note' => [
{
'noteid' => 'note146',
'content' => 'foobar%0A',
'bgcolor' => '#8facff'
'xposition' => '384',
'yposition' => '411',
'width' => '221',
'height' => '153',
'zindex' => '1',
},
# ...
]
=cut
sub store_workspace {
my $self = shift;
my $ws = shift || return;
return unless ($ws->{'name'} && $ws->{'time'});
$self->{'dbh'}->begin_work;
my $sth = $self->{'dbh'}->prepare(qq{
insert into wn_workspaces (wsname, nextNoteNum, time)
values (?, ?, ?)
}) || die $self->{'dbh'}->errstr();
$sth->execute(
map { $ws->{$_} } qw(name nextNoteNum time)
) || die $sth->errstr();
my $ws_info = $self->workspace_info($ws->{'name'}, $ws->{'time'}) || die "can't find newly inserted row!";
my $wsid = $ws_info->{'wsid'} || die "can't find wsid in workspace_info";
my @note_data = qw(noteid content bgcolor xposition yposition height width zindex wsid);
$sth = $self->{'dbh'}->prepare(
'insert into wn_notes (' .
join(",", @note_data) .
') values (?,?,?,?,?,?,?,?,?)') || die $self->{'dbh'}->errstr();
debug "using db_codepage: ".$self->{'db_codepage'};
my $ok = 1;
foreach my $n (@{$ws->{'note'}}) {
$n->{'wsid'} ||= $wsid;
my $c = $self->js_unescape($n->{'content'}) || '';
# encode content into database codepage
$c = encode($self->{db_codepage}, $c);
debug "store_workplace(".$ws->{'name'}.") - $wsid ".$n->{'noteid'}." ==> $c";
# save empty notes also
$n->{content} = $c;
unless ($sth->execute( map { $n->{$_} } @note_data ) ) {
$ok = 0;
$self->{'dbh'}->rollback;
last;
}
}
$self->{'dbh'}->commit if ($ok);
return $ok;
}
=head2 load_workspace
Load workspace from database.
$workspace_hash = $wn->load_workspace('Workspace name', 1111679331);
=cut
sub load_workspace {
my $self = shift;
my ($name, $time) = @_;
$time ||= ''; # fix warning
my $ws = $self->workspace_info($name, $time) || return;
my $sth = $self->{'dbh'}->prepare(qq{
select noteid,content,bgcolor,xposition,yposition,height,width,zindex from wn_notes where wsid = ? order by noteid desc
}) || die $self->{'dbh'}->errstr();
$sth->execute($ws->{'wsid'}) || die $sth->errstr();
while (my $n = $sth->fetchrow_hashref()) {
# decode content back from database encoding to UTF-8
from_to($n->{content}, $self->{'db_codepage'}, 'UTF-8');
push @{$ws->{'note'}}, $n;
}
debug "load_workspace($name,$time)",Dumper($ws);
return $ws;
}
=head2 getdates
Method to return formatted data for JavaScript call C</getdates> and
C</getrecent>.
print $wn->getdates('Workspace name', $offset, $limit);
=cut
sub getdates {
my $self = shift;
my ($name,$offset,$limit) = @_;
die "no name?" unless ($name);
$offset ||= 0;
$limit ||= 100;
my $sth = $self->{'dbh'}->prepare(qq{
select time
from wn_workspaces
where wsname=?
order by time desc
limit $limit offset $offset
}) || die $self->{'dbh'}->errstr();
my @times;
$sth->execute($name) || die $sth->errstr();
while (my ($t) = $sth->fetchrow_array()) {
push @times, $t;
}
my $ret = join("|",@times);
# default to unix time 1, for last update of new notes (never)
$ret ||= $self->_fmt_utime(1);
debug "getdates($name, $offset, $limit) = $ret";
print "Content-type: text/plain\r\n\r\n$ret";
}
=head2 rss
Create RSS 2.0 feed for notes
print $wn->rss("Workspace name");
=cut
sub rss {
my $self = shift;
my $name = shift || return;
$name = uri_unescape($name);
my $ws = $self->load_workspace($name);
my $q = $self->{'cgi'} || die "no cgi?";
my $url = $q->url()."?name=".uri_escape($name);
my $rss = new XML::RSS(
version => '2.0',
encoding => 'UTF-8',
);
$rss->channel(
title => $name,
link => $url,
description => "Webnote notes called $name",
);
foreach my $n (@{$ws->{'note'}}) {
my $desc = '<div class="webnote" style="background: ' .
$n->{'bgcolor'} . ';">' .
$n->{'content'} . '</div>';
my $title = $1 if ($n->{content} =~ m/^\s*([^\n\r]+)/s);
$rss->add_item(
title => $title || $n->{noteid},
permaLink => $url . '#' . $n->{'noteid'},
description => $desc,
);
}
print "Content-type: text/xml\n\n" . $rss->as_string;
}
=head2 stats
Return RSS 1.0 with some statistic about Webnote workspaces
print $wn->stats;
=cut
sub stats {
my $self = shift;
my $q = $self->{'cgi'} || die "no cgi?";
my $url = $q->url();
my $rss = new XML::RSS(
version => '1.0',
encoding => 'UTF-8',
);
$rss->channel(
title => "Webnote statistics",
link => $url,
description => "Webnote statistics",
);
my $sth = $self->{'dbh'}->prepare(qq{
select
wsname,
count(distinct(wn_notes.time)) as nr_saves,
max(wn_workspaces.time) as last_saved
from wn_workspaces, wn_notes
where wn_workspaces.wsid = wn_notes.wsid
group by wsname
order by last_saved desc
limit 10
}) || die $self->{'dbh'}->errstr();
$sth->execute() || die $sth->errstr();
while (my $row = $sth->fetchrow_hashref()) {
my $dc_date = $self->_fmt_dc_date( $row->{'last_saved'} || time() );
$rss->add_item(
title => $row->{'wsname'},
link => $url . "?name=".uri_escape($row->{'wsname'}),
description => "Saved ". $row->{'nr_saves'} . " times",
dc => {
creator => 'Webnote back-end',
date => $dc_date,
},
);
}
print "Content-type: text/xml\n\n" . $rss->as_string;
}
#
#
=head1 INTERNAL METHODS
You shouldn't need to call this directly.
=head2 _fmt_utime
Return time in ISO format
=cut
sub _fmt_utime {
my $self = shift;
my $t = shift || return;
return strftime('%Y-%m-%d %H:%M:%S', localtime($t));
}
=head2 _fmt_dc_date
Return time in ISO format for dc:date
=cut
sub _fmt_dc_date {
my $self = shift;
my $t = shift || time();
$t = str2time($t) unless ($t =~ m#^\d+$#);
return strftime('%Y-%m-%dT%H:%M:%SZ', gmtime($t));
}
=head2 js_unsescape
Convert string that JavaScript function C<escape> encoded.
print $wn->js_unescape('odr%u017Ean');
It will return string in UTF-8 encoding.
=cut
sub js_unescape {
my $self = shift;
my $m = shift || return;
sub _js_uxxxx {
my ($lo,$hi) = @_;
my $c = chr(hex($lo)). chr(hex($hi));
from_to($c, 'UTF-16BE', 'UTF-8');
return $c;
}
if ($m =~ s/%u([0-9A-Fa-f]{2})([0-9A-Fa-f]{2})/_js_uxxxx($1,$2)/eg) {
$m = decode('UTF-8', $m);
}
$m =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
debug "js_unescape: $m";
return $m;
}
=head2 js_escape
Convert string into for JavaScript funcition C<unescape>.
print $wn->js_escape("some text");
Input text is assumed to be in UTF-8 encoding.
=cut
sub js_escape {
my $self = shift;
my $t = shift || return;
# $t = decode('UTF-8', $t);
# $t = uri_escape($t, '\x00-\x1f\x7f-\xff');
$t =~ s#%0a#\\n#gis;
$t =~ s/'/\\'/gs;
$t =~ s/(\s)/'%'.unpack('H*',$1)/eg;
return $t;
}
1;
RSS Feed