Line # Revision Author
1 76 dpavlin #!/usr/bin/perl -w
2
3 =head1 NAME
4
5 Webnote - an online tool for taking notes
6
7 =head1 DESCRIPTION
8
9 This is based on great webnote from
10 L<http://www.aypwip.org/webnote/>
11
12 =head1 METHODS
13
14 =cut
15
16 package Webnote;
17 use strict;
18
19 BEGIN {
20 use Exporter ();
21 use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
22 $VERSION = 0.1;
23 @ISA = qw (Exporter);
24 #Give a hoot don't pollute, do not export more than needed by default
25 @EXPORT = qw ();
26 @EXPORT_OK = qw ();
27 %EXPORT_TAGS = ();
28
29 }
30
31 use CGI qw(:standard);
32 79 dpavlin use CGI::Carp qw(fatalsToBrowser);
33 76 dpavlin use XML::Simple;
34 use DBI;
35 79 dpavlin use POSIX qw(strftime);
36 82 dpavlin use Date::Parse;
37 83 dpavlin use URI::Escape;
38 139 dpavlin use Encode qw/decode from_to encode/;
39 87 dpavlin use XML::RSS;
40 76 dpavlin
41 use Data::Dumper;
42
43 79 dpavlin my $debug = 1;
44
45 76 dpavlin my $webnote1 = <<EOF1;
46 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
47 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
48 <html>
49 <head>
50 80 dpavlin <base href="%s">
51 137 dpavlin <script type="text/javascript" src="objects.js"></script>
52 76 dpavlin <script type="text/javascript" src="webnote.js"></script>
53 <script type="text/javascript">
54 <!--
55 function loadinit()
56 {
57 79 dpavlin debugOn = %d;
58 76 dpavlin workspace.setName(unescape('%s'));
59 79 dpavlin workspace.loadedTime = '%s';
60 76 dpavlin init();
61
62 79 dpavlin workspace.nextNoteNum = %d;
63 76 dpavlin EOF1
64
65 my $webnote2 = <<EOF2;
66 workspace.changed = false;
67
68 }
69 // -->
70 </script>
71 <link rel="stylesheet" href="style.css" type="text/css" />
72 102 dpavlin <link rel="alternate" type="application/rss+xml" title="RSS" href="%s" />
73 76 dpavlin
74 <title>%s</title>
75 </head>
76 <body onload='loadinit();' style='background-color: #f0f0f0;'>
77 137 dpavlin <div id='content'>
78 <div id='toolbar'>
79 76 dpavlin <div class='controls'>
80 <img src='images/new.gif' class='controls' onclick="workspace.createNote()" title="new note" alt='new note' />
81 <img src='images/save.gif' class='controlsDisabled' onclick="workspace.save()" title="save workspace" id="saveImg" alt='save workspace' />
82 <img src='images/reload.gif' class='controls' onclick="workspace.loadlist()" title="load previous version" alt='load previous version' />
83 <img src='images/undo.gif' class='controlsDisabled' onclick="workspace.history.undo()" title="nothing to undo" id="undoImg" alt='undo icon' />
84 <img src='images/redo.gif' class='controlsDisabled' onclick="workspace.history.redo()" title="nothing to redo" id="redoImg" alt='redo icon' />
85 </div>
86 137 dpavlin <div id='filters'>
87 76 dpavlin <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;'/>
88 <!-- this button is strictly for looks -->
89 <input class='filters' style='width: 50px;' type='button' value='filter' />
90 </div>
91 <div id='mini' title='you have no notes'>
92 </div>
93 <div id='links'>
94 102 dpavlin <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>
95 76 dpavlin </div>
96 <div id='wsname'>
97 </div>
98 </div>
99 <div id='db'></div>
100 <div style='display: none;'><img src='images/close.gif' alt='red X' /></div>
101 137 dpavlin </div>
102 76 dpavlin </body>
103 </html>
104 EOF2
105
106 78 dpavlin sub debug {
107 87 dpavlin return unless ($debug);
108 78 dpavlin return unless (@_);
109 93 dpavlin print STDERR '[' . localtime() . '] ' . Carp::shortmess(@_);
110 78 dpavlin }
111
112 76 dpavlin =head2 new
113
114 Create new Webnote object
115
116 my $wn = new Webnote(
117 dsn => 'dbi:Pg:dbname=webnote',
118 77 dpavlin db_user => 'foobar',
119 db_passwd => 'secret',
120 93 dpavlin db_codepage => 'ISO-8859-2',
121 97 dpavlin adminEmail => 'dpavlin(at)rot13(dot)org',
122 debug => 1,
123 76 dpavlin );
124
125 93 dpavlin If C<db_codepage> isn't specified, ISO-8859-1 will be used.
126
127 76 dpavlin =cut
128
129 sub new {
130 my $class = shift;
131 my $self = {@_};
132 bless($self, $class);
133
134 die "need dsn" unless ($self->{'dsn'});
135
136 77 dpavlin $self->{'dbh'} = DBI->connect($self->{'dsn'}, $self->{'db_user'}, $self->{'db_passwd'}) || die $DBI::errstr;
137 76 dpavlin $self->{'cgi'} = new CGI || die "can't make CGI object";
138
139 87 dpavlin $debug = $self->{'debug'};
140
141 93 dpavlin # default database codepage
142 $self->{'db_codepage'} ||= 'ISO-8859-1';
143
144 76 dpavlin $self ? return $self : return undef;
145 }
146
147 98 dpavlin =head2 run
148
149 Main loop of Webnote.
150
151 $wn->run( default => sub {
152 my $self = shift;
153 # do something if no action is handled
154 # (by default, it's form to enter workspace name)
155 } );
156
157 This is main loop of Webnote back-end which will handle following methods
158 (invoked via URL):
159
160 =over 12
161
162 =item /save
163
164 Save workplace to database
165
166 =item /getdates
167
168 Get all modifications of workplace
169
170 =item /getrecent
171
172 Get last modification of workplace
173
174 =item /load
175
176 Load workplace
177
178 =item /rss
179
180 Generate RSS for all notes in workplace
181
182 =item /stats
183
184 Generate RSS for statistics of all workplaces
185
186 =back
187
188 If there isn't any method specified in URL, it will by default produce form
189 to enter workspace name. This can be overridden with C<default> parametar
190 and coderef.
191
192 99 dpavlin C<default> coderef should emit it's own headers and return true.
193
194 98 dpavlin =cut
195
196 sub run {
197 my $self = shift;
198 my $arg = {@_};
199
200 my $q = $self->{'cgi'} || die "no CGI?";
201
202 my $method = $q->path_info();
203
204 debug "method: $method ",$q->query_string()," [",($q->content_type() || 'unknown'),"]";
205
206 if ( ( $q->content_type() && $q->content_type() eq 'text/xml' ) || $method eq '/save') {
207 $self->save();
208 } elsif (my $name = $q->param('name')) {
209 if ($method eq '/getdates') {
210 my $offset = $q->param('offset') || 0;
211 $self->getdates($name, $offset, 100);
212 } elsif ($method eq '/getrecent') {
213 $self->getdates($name,0,1);
214 } else {
215 # handle /load too
216 $self->load($name);
217 }
218 } elsif ($method =~ m#^/rss/(.+)$#) {
219 $self->rss($1);
220 } elsif ($method eq '/stats') {
221 $self->stats();
222 } elsif ($method) {
223 print $q->header,
224 "unknown method: $method";
225 } elsif (ref $arg->{'default'}) {
226 99 dpavlin no strict 'refs';
227 $arg->{'default'}->($self) || die "default method didn't return true";
228 98 dpavlin } else {
229 print $q->header,
230 $q->start_html(
231 -title=>'webnote - with perl back-end',
232 -style=>{'src'=>'style.css'},
233 ),
234 $q->start_form,
235 "load or create workspace ",$q->textfield('name'),
236 $q->submit(-name=>'Go'),
237 $q->end_form;
238 }
239 }
240
241 97 dpavlin =head2 save
242 76 dpavlin
243 Save note to database. This action is called when there is C<text/xml>
244 content from POST request.
245
246 $wn->save() || die "can't save";
247
248 =cut
249
250 sub save {
251 my $self = shift;
252
253 my $q = $self->{'cgi'} || return;
254
255 86 dpavlin my $xml_post;
256 76 dpavlin
257 86 dpavlin if ($q->content_type() && $q->content_type() eq 'text/xml') {
258 # this is ugly cludge!
259 $xml_post = $q->{'POSTDATA'}->[0];
260 } elsif ($q->path_info() eq '/save') {
261 94 dpavlin my $post = $q->query_string() || return;
262 # fix microsoft smart quotes
263 $post =~ s/%E2%80%9[CD]/"/gi;
264 $post =~ s/%E2%80%9[89]/'/gi;
265 $xml_post = uri_unescape( $post );
266 86 dpavlin } else {
267 return;
268 }
269 76 dpavlin
270 86 dpavlin return unless ($xml_post);
271
272 94 dpavlin $xml_post =~ s/%u201[cd]/"/gi;
273 $xml_post =~ s/%u201[89]/'/gi;
274
275 135 dpavlin $xml_post =~ s/^POSTDATA=//;
276
277 # $xml_post = decode('UTF-8',$xml_post);
278 # $xml_post = '<xml version="1.0" encoding="UTF-8"?>' . $xml_post;
279
280 78 dpavlin debug "xml_post = $xml_post\n";
281 76 dpavlin
282 135 dpavlin # open(my $t, '>', '/tmp/post.xml');
283 # if ($t) {
284 # print $t $xml_post;
285 # close($t);
286 # }
287
288 76 dpavlin my $xml = XMLin($xml_post, ForceArray => [ 'note' ]);
289
290 135 dpavlin if (! $xml) {
291 warn "can't prase $xml_post\n";
292 137 dpavlin print $q->header(-type=>'text/xml'), qq{\n<return>\n<status value="error">\n</return>\n};
293 135 dpavlin return undef;
294 };
295
296 82 dpavlin $xml->{'time'} ||= $self->_fmt_utime(time());
297 76 dpavlin
298 78 dpavlin debug "note: ",Dumper($xml);
299 76 dpavlin
300 77 dpavlin if ($self->store_workspace($xml)) {
301 # return ok to JavaScript
302 137 dpavlin print $q->header(-type=>'text/xml'), qq{\n<return>\n<status value="ok" update="$xml->{'time'}"/>\n</return>\n};
303 77 dpavlin } else {
304 137 dpavlin print $q->header(-type=>'text/xml'), qq{\n<return>\n<status value="error">\n</return>\n};
305 77 dpavlin return undef;
306 }
307
308 return 1;
309 76 dpavlin }
310
311 =head2 load
312
313 This function loads workspace.
314
315 my $wn->load('Workspace name');
316
317 =cut
318
319 sub load {
320 my $self = shift;
321
322 my $name = shift || return;
323
324 81 dpavlin my $q = $self->{'cgi'} || die "need cgi";
325 76 dpavlin
326 83 dpavlin print $q->header(
327 -charset => 'UTF-8',
328 );
329 81 dpavlin
330 82 dpavlin my $ws = $self->load_workspace($name, $q->param('time'));
331 76 dpavlin
332 81 dpavlin my $base_href = $q->url();
333 my $rel = $q->url(-relative=>1);
334 80 dpavlin $base_href =~ s/$rel$//g;
335
336 86 dpavlin $ws->{'time'} ||= $self->_fmt_utime(time());
337 $ws->{'nextnotenum'} ||= 1;
338
339 79 dpavlin printf($webnote1,
340 80 dpavlin $base_href,
341 79 dpavlin ($debug || 0),
342 93 dpavlin $self->js_escape($name),
343 82 dpavlin $ws->{'time'},
344 86 dpavlin $ws->{'nextnotenum'}
345 79 dpavlin );
346 137 dpavlin print " baseURI = '", $q->url(), "';\n";
347 print " adminEmail = '", $self->{'adminEmail'}, "';\n";
348 print " numDates = 10;\n";
349 79 dpavlin
350 82 dpavlin if ($ws) {
351 debug "loaded workspace: $name\n";
352 76 dpavlin
353 82 dpavlin debug Dumper($ws);
354 76 dpavlin
355 82 dpavlin foreach my $n (@{$ws->{'note'}}) {
356 76 dpavlin
357 my $c = $n->{'content'};
358 $c =~ s/[\n\r]+//g;
359 135 dpavlin
360 137 dpavlin printf qq# workspace.createNote( { 'id':'%s', 'xPos':'%s', 'yPos':'%s', 'height':'%s', 'width':'%s', 'bgcolor':'%s', 'zIndex':'%s', 'text':unescape('%s') }, true );\n#,
361 76 dpavlin $n->{'noteid'},
362 $n->{'xposition'},
363 $n->{'yposition'},
364 $n->{'height'},
365 $n->{'width'},
366 $n->{'bgcolor'},
367 $n->{'zindex'},
368 93 dpavlin $self->js_escape($c);
369 76 dpavlin }
370
371 81 dpavlin if (my $newnote = $q->param('nn')) {
372 83 dpavlin debug "newnote: $newnote";
373 81 dpavlin my $via = $q->param('via');
374 $newnote .= qq{ <br/><span class="via">via:<a href="$via">$via</a></span>} if ($via);
375 94 dpavlin $newnote = $self->js_escape($newnote);
376 print qq# workspace.createNote( { 'text':unescape('$newnote') } );\n#;
377 81 dpavlin }
378
379 76 dpavlin } else {
380 82 dpavlin debug "new workspace: $name\n";
381 76 dpavlin
382 }
383
384 102 dpavlin my $rss_url = $q->url().'/rss/'.uri_escape($name);
385 printf $webnote2,$rss_url,$name,$rss_url;
386 87 dpavlin
387 76 dpavlin }
388
389 77 dpavlin =head2 workspace_info
390
391 Get workspace by name (and time)
392
393 my $ws_info = $wn->workspace_info('Workspace name', 1111679331);
394
395 If no time is specified, it will return latest version of workspace.
396
397 =cut
398
399 sub workspace_info {
400 my $self = shift;
401
402 my $name = shift || return;
403 my $time = shift;
404
405 my $sql = qq{
406 select
407 wsid, wsname, nextNoteNum, time
408 from wn_workspaces
409 where wsname = ?
410 };
411 my @arg = ( $name );
412
413 if ($time) {
414 $sql .= qq{ and time = ? };
415 push @arg, $time;
416 } else {
417 $sql .= qq{ order by time desc limit 1 };
418 }
419
420 my $sth = $self->{'dbh'}->prepare($sql) || die $self->{'dbh'}->errstr();
421
422 $sth->execute(@arg) || die $sth->errstr();
423
424 my $ws_info = $sth->fetchrow_hashref();
425
426 78 dpavlin debug "workspace_info($name,$time): ",Dumper($ws_info);
427
428 77 dpavlin return $ws_info;
429 }
430
431
432 =head2 store_workspace
433
434 Save workspace data to database
435
436 $wn->store_workspace($workspace_hash);
437
438 C<$workspace_hash> has following structure:
439
440 'name' => 'foo',
441 'nextNoteNum' => '153',
442 'time' => 1111674868,
443 'note' => [
444 {
445 'noteid' => 'note146',
446 'content' => 'foobar%0A',
447 'bgcolor' => '#8facff'
448 'xposition' => '384',
449 'yposition' => '411',
450 'width' => '221',
451 'height' => '153',
452 'zindex' => '1',
453 },
454 # ...
455 ]
456
457 =cut
458
459 sub store_workspace {
460 my $self = shift;
461
462 my $ws = shift || return;
463
464 93 dpavlin return unless ($ws->{'name'} && $ws->{'time'});
465
466 95 dpavlin $self->{'dbh'}->begin_work;
467
468 77 dpavlin my $sth = $self->{'dbh'}->prepare(qq{
469 insert into wn_workspaces (wsname, nextNoteNum, time)
470 values (?, ?, ?)
471 }) || die $self->{'dbh'}->errstr();
472
473 $sth->execute(
474 map { $ws->{$_} } qw(name nextNoteNum time)
475 ) || die $sth->errstr();
476
477 my $ws_info = $self->workspace_info($ws->{'name'}, $ws->{'time'}) || die "can't find newly inserted row!";
478 my $wsid = $ws_info->{'wsid'} || die "can't find wsid in workspace_info";
479
480 my @note_data = qw(noteid content bgcolor xposition yposition height width zindex wsid);
481 $sth = $self->{'dbh'}->prepare(
482 'insert into wn_notes (' .
483 join(",", @note_data) .
484 ') values (?,?,?,?,?,?,?,?,?)') || die $self->{'dbh'}->errstr();
485
486 93 dpavlin debug "using db_codepage: ".$self->{'db_codepage'};
487
488 95 dpavlin my $ok = 1;
489
490 77 dpavlin foreach my $n (@{$ws->{'note'}}) {
491 $n->{'wsid'} ||= $wsid;
492 139 dpavlin
493 95 dpavlin my $c = $self->js_unescape($n->{'content'}) || '';
494 93 dpavlin # encode content into database codepage
495 139 dpavlin $c = encode($self->{db_codepage}, $c);
496
497 95 dpavlin debug "store_workplace(".$ws->{'name'}.") - $wsid ".$n->{'noteid'}." ==> $c";
498 139 dpavlin
499 135 dpavlin # save empty notes also
500 139 dpavlin $n->{content} = $c;
501 95 dpavlin unless ($sth->execute( map { $n->{$_} } @note_data ) ) {
502 $ok = 0;
503 $self->{'dbh'}->rollback;
504 last;
505 }
506 77 dpavlin }
507
508 95 dpavlin $self->{'dbh'}->commit if ($ok);
509 77 dpavlin
510 95 dpavlin return $ok;
511
512 77 dpavlin }
513
514 =head2 load_workspace
515
516 Load workspace from database.
517
518 78 dpavlin $workspace_hash = $wn->load_workspace('Workspace name', 1111679331);
519 77 dpavlin
520 =cut
521 78 dpavlin
522 sub load_workspace {
523 my $self = shift;
524
525 my ($name, $time) = @_;
526
527 102 dpavlin $time ||= ''; # fix warning
528
529 78 dpavlin my $ws = $self->workspace_info($name, $time) || return;
530
531 my $sth = $self->{'dbh'}->prepare(qq{
532 88 dpavlin select noteid,content,bgcolor,xposition,yposition,height,width,zindex from wn_notes where wsid = ? order by noteid desc
533 78 dpavlin }) || die $self->{'dbh'}->errstr();
534
535 80 dpavlin $sth->execute($ws->{'wsid'}) || die $sth->errstr();
536 78 dpavlin while (my $n = $sth->fetchrow_hashref()) {
537 93 dpavlin # decode content back from database encoding to UTF-8
538 135 dpavlin from_to($n->{content}, $self->{'db_codepage'}, 'UTF-8');
539 78 dpavlin push @{$ws->{'note'}}, $n;
540 }
541
542 debug "load_workspace($name,$time)",Dumper($ws);
543
544 return $ws;
545 }
546 80 dpavlin
547 =head2 getdates
548
549 87 dpavlin Method to return formatted data for JavaScript call C</getdates> and
550 C</getrecent>.
551 80 dpavlin
552 85 dpavlin print $wn->getdates('Workspace name', $offset, $limit);
553 80 dpavlin
554 =cut
555
556 sub getdates {
557 my $self = shift;
558
559 85 dpavlin my ($name,$offset,$limit) = @_;
560 80 dpavlin die "no name?" unless ($name);
561 85 dpavlin $offset ||= 0;
562 $limit ||= 100;
563 80 dpavlin
564 my $sth = $self->{'dbh'}->prepare(qq{