| 1 | package BookmarkApp; | 
|---|
| 2 | use strict; | 
|---|
| 3 | use warnings; | 
|---|
| 4 | use base qw{CGI::Application}; | 
|---|
| 5 |  | 
|---|
| 6 | use CGI::Application::Plugin::TT; | 
|---|
| 7 |  | 
|---|
| 8 | use Encode; | 
|---|
| 9 | use HTTP::Date qw{time2isoz}; | 
|---|
| 10 | use JSON; | 
|---|
| 11 | use Bookmarks; | 
|---|
| 12 |  | 
|---|
| 13 | use URI; | 
|---|
| 14 | my $base_uri = URI->new; | 
|---|
| 15 | $base_uri->scheme('http'); | 
|---|
| 16 | $base_uri->host($ENV{HTTP_X_FORWARDED_HOST} || $ENV{SERVER_NAME}); | 
|---|
| 17 | $base_uri->port($ENV{SERVER_PORT}); | 
|---|
| 18 | $base_uri->path($ENV{SCRIPT_NAME} . '/'); | 
|---|
| 19 |  | 
|---|
| 20 | my $dbname = 'fk.db'; | 
|---|
| 21 | my $bookmarks = Bookmarks->new({ | 
|---|
| 22 |     dbname   => $dbname, | 
|---|
| 23 |     base_uri => $base_uri, | 
|---|
| 24 | }); | 
|---|
| 25 |  | 
|---|
| 26 | sub setup { | 
|---|
| 27 |     my $self = shift; | 
|---|
| 28 |     $self->mode_param(path_info => 1); | 
|---|
| 29 |     $self->run_modes([qw{ | 
|---|
| 30 |         list | 
|---|
| 31 |         feed | 
|---|
| 32 |         view | 
|---|
| 33 |         view_field | 
|---|
| 34 |         edit | 
|---|
| 35 |     }]); | 
|---|
| 36 | } | 
|---|
| 37 |  | 
|---|
| 38 | sub list { | 
|---|
| 39 |     my $self = shift; | 
|---|
| 40 |     my $q = $self->query; | 
|---|
| 41 |  | 
|---|
| 42 |     # check for a uri param, and if there is one present, | 
|---|
| 43 |     # see if a bookmark for that URI already exists | 
|---|
| 44 |     if (defined(my $uri = $q->param('uri'))) { | 
|---|
| 45 |         my $bookmark = $bookmarks->get_bookmark({ uri => $uri }); | 
|---|
| 46 |         if ($bookmark) { | 
|---|
| 47 |             # redirect to the view of the existing bookmark | 
|---|
| 48 |             $self->header_type('redirect'); | 
|---|
| 49 |             $self->header_props( | 
|---|
| 50 |                 -uri => $q->url . '/' . $bookmark->{id}, | 
|---|
| 51 |             ); | 
|---|
| 52 |             return; | 
|---|
| 53 |         } else { | 
|---|
| 54 |             # bookmark was not found; show the form to create a new bookmark | 
|---|
| 55 |             $bookmark->{uri} = $uri; | 
|---|
| 56 |             $bookmark->{title} = $q->param('title'); | 
|---|
| 57 |             $self->header_props( | 
|---|
| 58 |                 -type    => 'text/html', | 
|---|
| 59 |                 -charset => 'UTF-8', | 
|---|
| 60 |                 -status  => 404, | 
|---|
| 61 |             ); | 
|---|
| 62 |             return $self->tt_process( | 
|---|
| 63 |                 'bookmark.tt', | 
|---|
| 64 |                 $bookmark, | 
|---|
| 65 |             ); | 
|---|
| 66 |         } | 
|---|
| 67 |     } | 
|---|
| 68 |  | 
|---|
| 69 |     # list all the bookmarks  | 
|---|
| 70 |     my $format = $q->param('format') || 'html'; | 
|---|
| 71 |     my $tag = $q->param('tag'); | 
|---|
| 72 |     my @tags = $q->param('tag'); | 
|---|
| 73 |     # special case: handle the empty tag | 
|---|
| 74 |     if (@tags == 1 && $tags[0] eq '') { | 
|---|
| 75 |         @tags = (); | 
|---|
| 76 |     } | 
|---|
| 77 |     my $limit = $q->param('limit'); | 
|---|
| 78 |     my $offset = $q->param('offset'); | 
|---|
| 79 |     my @resources = $bookmarks->get_bookmarks({ | 
|---|
| 80 |         tag    => \@tags, | 
|---|
| 81 |         limit  => $limit, | 
|---|
| 82 |         offset => $offset, | 
|---|
| 83 |     }); | 
|---|
| 84 |     my @all_tags = $bookmarks->get_tags({ selected => $tag }); | 
|---|
| 85 |     my @cotags = $bookmarks->get_cotags({ tag => \@tags }); | 
|---|
| 86 |  | 
|---|
| 87 |     if ($format eq 'json') { | 
|---|
| 88 |         $self->header_props( | 
|---|
| 89 |             -type    => 'application/json', | 
|---|
| 90 |             -charset => 'UTF-8', | 
|---|
| 91 |         ); | 
|---|
| 92 |         return decode_utf8( | 
|---|
| 93 |             JSON->new->utf8->convert_blessed->encode({ | 
|---|
| 94 |                 bookmarks => \@resources, | 
|---|
| 95 |             }) | 
|---|
| 96 |         ); | 
|---|
| 97 |     } elsif ($format eq 'xbel') { | 
|---|
| 98 |         require XML::XBEL; | 
|---|
| 99 |         #TODO: conditional support; if XML::XBEL is not present, return a 5xx response | 
|---|
| 100 |  | 
|---|
| 101 |         my $xbel = XML::XBEL->new; | 
|---|
| 102 |  | 
|---|
| 103 |         $xbel->new_document({ | 
|---|
| 104 |             title => 'Bookmarks' . ($tag ? " tagged as $tag" : ''), | 
|---|
| 105 |         }); | 
|---|
| 106 |  | 
|---|
| 107 |         for my $bookmark (@resources) { | 
|---|
| 108 |             my $cdatetime = time2isoz $bookmark->{ctime}; | 
|---|
| 109 |             my $mdatetime = time2isoz $bookmark->{mtime}; | 
|---|
| 110 |             # make the timestamps W3C-correct | 
|---|
| 111 |             s/ /T/ foreach ($cdatetime, $mdatetime); | 
|---|
| 112 |  | 
|---|
| 113 |             $xbel->add_bookmark({ | 
|---|
| 114 |                 href     => $bookmark->{uri}, | 
|---|
| 115 |                 title    => $bookmark->{title}, | 
|---|
| 116 |                 desc     => 'Tags: ' . join(', ', @{ $bookmark->{tags} }), | 
|---|
| 117 |                 added    => $cdatetime, | 
|---|
| 118 |                 #XXX: are we sure that modified is the mtime of the bookmark or the resource? | 
|---|
| 119 |                 modified => $mdatetime, | 
|---|
| 120 |             }); | 
|---|
| 121 |         } | 
|---|
| 122 |  | 
|---|
| 123 |         $self->header_props( | 
|---|
| 124 |             -type    => 'application/xml', | 
|---|
| 125 |             -charset => 'UTF-8', | 
|---|
| 126 |         ); | 
|---|
| 127 |  | 
|---|
| 128 |         return $xbel->toString; | 
|---|
| 129 |     } else { | 
|---|
| 130 |         $self->header_props( | 
|---|
| 131 |             -type    => 'text/html', | 
|---|
| 132 |             -charset => 'UTF-8', | 
|---|
| 133 |         ); | 
|---|
| 134 |  | 
|---|
| 135 |         # set the base URL, adding a trailing slash if needed | 
|---|
| 136 |         my $base_url = $q->url; | 
|---|
| 137 |         $base_url .= '/' if $base_url =~ m{/bookmarks$}; | 
|---|
| 138 |  | 
|---|
| 139 |         my @links = ( | 
|---|
| 140 |             { | 
|---|
| 141 |                 text => 'Link', | 
|---|
| 142 |                 type => 'text/html', | 
|---|
| 143 |                 rel  => 'self', | 
|---|
| 144 |                 query => { | 
|---|
| 145 |                     tag => \@tags, | 
|---|
| 146 |                 }, | 
|---|
| 147 |             }, | 
|---|
| 148 |             { | 
|---|
| 149 |                 text => 'JSON', | 
|---|
| 150 |                 type => 'application/json', | 
|---|
| 151 |                 rel  => 'alternate', | 
|---|
| 152 |                 query => { | 
|---|
| 153 |                     tag => \@tags, | 
|---|
| 154 |                     format => 'json', | 
|---|
| 155 |                 }, | 
|---|
| 156 |             }, | 
|---|
| 157 |             { | 
|---|
| 158 |                 text => 'XBEL', | 
|---|
| 159 |                 type => 'application/xml', | 
|---|
| 160 |                 rel  => 'alternate', | 
|---|
| 161 |                 query => { | 
|---|
| 162 |                     tag => \@tags, | 
|---|
| 163 |                     format => 'xbel', | 
|---|
| 164 |                 }, | 
|---|
| 165 |             }, | 
|---|
| 166 |             { | 
|---|
| 167 |                 text => 'Atom', | 
|---|
| 168 |                 type => 'application/atom+xml', | 
|---|
| 169 |                 rel  => 'alternate', | 
|---|
| 170 |                 path => 'feed', | 
|---|
| 171 |                 query => { | 
|---|
| 172 |                     tag => \@tags, | 
|---|
| 173 |                 }, | 
|---|
| 174 |             }, | 
|---|
| 175 |         ); | 
|---|
| 176 |         for my $link (@links) { | 
|---|
| 177 |             $link->{href} = URI->new_abs($link->{path} || '', $base_uri); | 
|---|
| 178 |             $link->{href}->query_form($link->{query}); | 
|---|
| 179 |         } | 
|---|
| 180 |          | 
|---|
| 181 |         return $self->tt_process( | 
|---|
| 182 |             'list.tt', | 
|---|
| 183 |             { | 
|---|
| 184 |                 base_url     => $base_url, | 
|---|
| 185 |                 selected_tag => $tag, | 
|---|
| 186 |                 search_tags  => \@tags, | 
|---|
| 187 |                 links        => \@links, | 
|---|
| 188 |                 all_tags     => \@all_tags, | 
|---|
| 189 |                 cotags       => \@cotags, | 
|---|
| 190 |                 resources    => \@resources, | 
|---|
| 191 |             }, | 
|---|
| 192 |         ); | 
|---|
| 193 |     } | 
|---|
| 194 | } | 
|---|
| 195 |  | 
|---|
| 196 | sub feed { | 
|---|
| 197 |     my $self = shift; | 
|---|
| 198 |     my $q = $self->query; | 
|---|
| 199 |  | 
|---|
| 200 |     my $tag = $q->param('tag'); | 
|---|
| 201 |  | 
|---|
| 202 |     require XML::Atom::Feed; | 
|---|
| 203 |     require XML::Atom::Entry; | 
|---|
| 204 |     require XML::Atom::Link; | 
|---|
| 205 |  | 
|---|
| 206 |     my $feed = XML::Atom::Feed->new; | 
|---|
| 207 |     $feed->title('Bookmarks' . ($tag ? " tagged as $tag" : '')); | 
|---|
| 208 |     $feed->id($base_uri->canonical . 'feed'); | 
|---|
| 209 |  | 
|---|
| 210 |     # construct a feed from the most recent 12 bookmarks | 
|---|
| 211 |     for my $bookmark ($bookmarks->get_bookmarks({ tag => $tag, limit => 12 })) { | 
|---|
| 212 |         my $entry = XML::Atom::Entry->new; | 
|---|
| 213 |         $entry->id($bookmark->{bookmark_uri}); | 
|---|
| 214 |         $entry->title($bookmark->{title}); | 
|---|
| 215 |         my $link = XML::Atom::Link->new; | 
|---|
| 216 |         $link->href($bookmark->{uri}); | 
|---|
| 217 |         $entry->add_link($link); | 
|---|
| 218 |         $entry->summary('Tags: ' . join(', ', @{ $bookmark->{tags} })); | 
|---|
| 219 |         $feed->add_entry($entry); | 
|---|
| 220 |     } | 
|---|
| 221 |  | 
|---|
| 222 |     $self->header_props( | 
|---|
| 223 |         -type => 'application/atom+xml', | 
|---|
| 224 |         -charset => 'UTF-8', | 
|---|
| 225 |     ); | 
|---|
| 226 |     return $feed->as_xml; | 
|---|
| 227 | } | 
|---|
| 228 |  | 
|---|
| 229 | sub view { | 
|---|
| 230 |     my $self = shift; | 
|---|
| 231 |     my $id = $self->param('id'); | 
|---|
| 232 |     my $format = $self->query->param('format') || 'html'; | 
|---|
| 233 |  | 
|---|
| 234 |     my $bookmark = $bookmarks->get_bookmark({ id => $id }); | 
|---|
| 235 |     if ($bookmark) { | 
|---|
| 236 |         if ($format eq 'json') { | 
|---|
| 237 |             $self->header_props( | 
|---|
| 238 |                 -type    => 'application/json', | 
|---|
| 239 |                 -charset => 'UTF-8', | 
|---|
| 240 |             ); | 
|---|
| 241 |             return decode_utf8(JSON->new->utf8->convert_blessed->encode($bookmark)); | 
|---|
| 242 |         } else { | 
|---|
| 243 |             # display the bookmark form for this bookmark | 
|---|
| 244 |             $bookmark->{exists} = 1; | 
|---|
| 245 |             $bookmark->{created} = "Created " . localtime($bookmark->ctime); | 
|---|
| 246 |             $bookmark->{created} .= '; Updated ' . localtime($bookmark->mtime) unless $bookmark->ctime == $bookmark->mtime; | 
|---|
| 247 |             $self->header_props( | 
|---|
| 248 |                 -type    => 'text/html', | 
|---|
| 249 |                 -charset => 'UTF-8', | 
|---|
| 250 |             ); | 
|---|
| 251 |             return $self->tt_process( | 
|---|
| 252 |                 'bookmark.tt', | 
|---|
| 253 |                 $bookmark, | 
|---|
| 254 |             ); | 
|---|
| 255 |         } | 
|---|
| 256 |     } else { | 
|---|
| 257 |         $self->header_props( | 
|---|
| 258 |             -type    => 'text/html', | 
|---|
| 259 |             -charset => 'UTF-8', | 
|---|
| 260 |             -status  => 404, | 
|---|
| 261 |         ); | 
|---|
| 262 |         return "Bookmark $id Not Found"; | 
|---|
| 263 |     } | 
|---|
| 264 | } | 
|---|
| 265 |  | 
|---|
| 266 | sub view_field { | 
|---|
| 267 |     my $self = shift; | 
|---|
| 268 |     my $id = $self->param('id'); | 
|---|
| 269 |     my $field = $self->param('field'); | 
|---|
| 270 |  | 
|---|
| 271 |     my $bookmark = $bookmarks->get_bookmark({ id => $id }); | 
|---|
| 272 |     if ($bookmark) { | 
|---|
| 273 |         # respond with just the requested field as plain text | 
|---|
| 274 |         my $value = eval { $bookmark->$field }; | 
|---|
| 275 |         if ($@) { | 
|---|
| 276 |             if ($@ =~ /Can't locate object method/) { | 
|---|
| 277 |                 $self->header_props( | 
|---|
| 278 |                     -type    => 'text/plain', | 
|---|
| 279 |                     -charset => 'UTF-8', | 
|---|
| 280 |                     -status  => 404, | 
|---|
| 281 |                 ); | 
|---|
| 282 |                 return qq{"$field" is not a valid bookmark data field}; | 
|---|
| 283 |             } else { | 
|---|
| 284 |                 die $@; | 
|---|
| 285 |             } | 
|---|
| 286 |         } | 
|---|
| 287 |         $self->header_props( | 
|---|
| 288 |             -type    => 'text/plain', | 
|---|
| 289 |             -charset => 'UTF-8', | 
|---|
| 290 |         ); | 
|---|
| 291 |         return ref $value eq 'ARRAY' ? join(',', @{ $value }) : $value; | 
|---|
| 292 |     } else { | 
|---|
| 293 |         $self->header_props( | 
|---|
| 294 |             -type    => 'text/html', | 
|---|
| 295 |             -charset => 'UTF-8', | 
|---|
| 296 |             -status  => 404, | 
|---|
| 297 |         ); | 
|---|
| 298 |         return "Bookmark $id Not Found"; | 
|---|
| 299 |     } | 
|---|
| 300 | } | 
|---|
| 301 |  | 
|---|
| 302 | #TODO: split this into edit and create methods | 
|---|
| 303 | sub edit { | 
|---|
| 304 |     my $self = shift; | 
|---|
| 305 |     my $q = $self->query; | 
|---|
| 306 |     #TODO: get the bookmark based on the id and edit it directly? | 
|---|
| 307 |     #TODO: deal with changing URIs | 
|---|
| 308 |     my $uri = $q->param('uri'); | 
|---|
| 309 |     my $title = $q->param('title'); | 
|---|
| 310 |     my @tags = split ' ', $q->param('tags'); | 
|---|
| 311 |     $bookmarks->add({ | 
|---|
| 312 |         uri   => $uri, | 
|---|
| 313 |         title => $title, | 
|---|
| 314 |         tags  => \@tags, | 
|---|
| 315 |     }); | 
|---|
| 316 |  | 
|---|
| 317 | =begin | 
|---|
| 318 |  | 
|---|
| 319 |     my $location = URI->new($q->url); | 
|---|
| 320 |     $location->query_form(uri => $uri) if defined $q->url_param('uri'); | 
|---|
| 321 |     $location->fragment('updated'); | 
|---|
| 322 |  | 
|---|
| 323 | =cut | 
|---|
| 324 |  | 
|---|
| 325 |     # return to the form | 
|---|
| 326 |     $self->header_type('redirect'); | 
|---|
| 327 |     $self->header_props( | 
|---|
| 328 |         -uri => $ENV{REQUEST_URI}, | 
|---|
| 329 |         -status => 303, | 
|---|
| 330 |     ); | 
|---|
| 331 | } | 
|---|
| 332 |  | 
|---|
| 333 | 1; | 
|---|