| 1 | package Bookmarks::List; |
|---|
| 2 | |
|---|
| 3 | use Moose; |
|---|
| 4 | |
|---|
| 5 | use Encode; |
|---|
| 6 | use HTTP::Date qw{time2iso time2isoz}; |
|---|
| 7 | |
|---|
| 8 | has bookmarks => ( |
|---|
| 9 | is => 'ro', |
|---|
| 10 | isa => 'Bookmarks', |
|---|
| 11 | ); |
|---|
| 12 | has search => ( |
|---|
| 13 | is => 'ro', |
|---|
| 14 | isa => 'Bookmarks::Search', |
|---|
| 15 | handles => [qw{query tags limit offset results}], |
|---|
| 16 | ); |
|---|
| 17 | has title => ( |
|---|
| 18 | is => 'ro', |
|---|
| 19 | builder => '_build_title', |
|---|
| 20 | lazy => 1, |
|---|
| 21 | ); |
|---|
| 22 | |
|---|
| 23 | sub _get_list_links { |
|---|
| 24 | my $self = shift; |
|---|
| 25 | my ($self_type, $query) = @_; |
|---|
| 26 | |
|---|
| 27 | # remove extraneous blank ?q= parameters |
|---|
| 28 | delete $query->{q} if defined $query->{q} && $query->{q} eq ''; |
|---|
| 29 | |
|---|
| 30 | my @links = ( |
|---|
| 31 | { |
|---|
| 32 | text => 'JSON', |
|---|
| 33 | type => 'application/json', |
|---|
| 34 | path => 'list', |
|---|
| 35 | query => { |
|---|
| 36 | %$query, |
|---|
| 37 | format => 'json', |
|---|
| 38 | }, |
|---|
| 39 | }, |
|---|
| 40 | { |
|---|
| 41 | text => 'XBEL', |
|---|
| 42 | type => 'application/xml', |
|---|
| 43 | path => 'list', |
|---|
| 44 | query => { |
|---|
| 45 | %$query, |
|---|
| 46 | format => 'xbel', |
|---|
| 47 | }, |
|---|
| 48 | }, |
|---|
| 49 | { |
|---|
| 50 | text => 'Atom', |
|---|
| 51 | type => 'application/atom+xml', |
|---|
| 52 | path => 'feed', |
|---|
| 53 | query => { |
|---|
| 54 | %$query, |
|---|
| 55 | }, |
|---|
| 56 | }, |
|---|
| 57 | { |
|---|
| 58 | text => 'CSV', |
|---|
| 59 | type => 'text/csv', |
|---|
| 60 | path => 'list', |
|---|
| 61 | query => { |
|---|
| 62 | %$query, |
|---|
| 63 | format => 'csv', |
|---|
| 64 | }, |
|---|
| 65 | }, |
|---|
| 66 | { |
|---|
| 67 | text => 'URI List', |
|---|
| 68 | type => 'text/uri-list', |
|---|
| 69 | path => 'list', |
|---|
| 70 | query => { |
|---|
| 71 | %$query, |
|---|
| 72 | format => 'text', |
|---|
| 73 | }, |
|---|
| 74 | }, |
|---|
| 75 | { |
|---|
| 76 | text => 'HTML', |
|---|
| 77 | type => 'text/html', |
|---|
| 78 | path => 'list', |
|---|
| 79 | query => { |
|---|
| 80 | %$query, |
|---|
| 81 | }, |
|---|
| 82 | }, |
|---|
| 83 | ); |
|---|
| 84 | |
|---|
| 85 | for my $link (@links) { |
|---|
| 86 | $link->{rel} = $link->{type} eq $self_type ? 'self' : 'alternate'; |
|---|
| 87 | $link->{href} = URI->new_abs($link->{path} || '', $self->bookmarks->base_uri); |
|---|
| 88 | $link->{href}->query_form($link->{query}); |
|---|
| 89 | } |
|---|
| 90 | |
|---|
| 91 | return @links; |
|---|
| 92 | } |
|---|
| 93 | |
|---|
| 94 | sub _build_title { |
|---|
| 95 | my $self = shift; |
|---|
| 96 | return 'Bookmarks' . (@{ $self->tags } ? " tagged as " . join(' & ', @{ $self->tags }) : '') . ($self->query ? " matching '" . $self->query . "'" : ''); |
|---|
| 97 | } |
|---|
| 98 | |
|---|
| 99 | sub as_json { |
|---|
| 100 | my $self = shift; |
|---|
| 101 | require JSON; |
|---|
| 102 | my $json = decode_utf8( |
|---|
| 103 | JSON->new->utf8->convert_blessed->encode({ |
|---|
| 104 | bookmarks => [ map { $_->to_hashref } @{ $self->results } ], |
|---|
| 105 | }) |
|---|
| 106 | ); |
|---|
| 107 | return [200, ['Content-Type' => 'application/json; charset=UTF-8'], [$json]]; |
|---|
| 108 | } |
|---|
| 109 | |
|---|
| 110 | sub as_xbel { |
|---|
| 111 | my $self = shift; |
|---|
| 112 | |
|---|
| 113 | eval { require XML::XBEL; } or |
|---|
| 114 | return [406, ['Content-Type' => 'text/plain'], ['This server does not support XBEL lists']]; |
|---|
| 115 | |
|---|
| 116 | my $xbel = XML::XBEL->new; |
|---|
| 117 | |
|---|
| 118 | $xbel->new_document({ |
|---|
| 119 | title => $self->title, |
|---|
| 120 | }); |
|---|
| 121 | |
|---|
| 122 | for my $bookmark (@{ $self->results }) { |
|---|
| 123 | my $cdatetime = time2isoz $bookmark->ctime; |
|---|
| 124 | my $mdatetime = time2isoz $bookmark->mtime; |
|---|
| 125 | # make the timestamps W3C-correct |
|---|
| 126 | s/ /T/ foreach ($cdatetime, $mdatetime); |
|---|
| 127 | |
|---|
| 128 | $xbel->add_bookmark({ |
|---|
| 129 | href => $bookmark->uri, |
|---|
| 130 | title => $bookmark->title, |
|---|
| 131 | desc => 'Tags: ' . join(', ', @{ $bookmark->tags }), |
|---|
| 132 | added => $cdatetime, |
|---|
| 133 | #XXX: are we sure that modified is the mtime of the bookmark or the resource? |
|---|
| 134 | modified => $mdatetime, |
|---|
| 135 | }); |
|---|
| 136 | } |
|---|
| 137 | |
|---|
| 138 | return [200, ['Content-Type' => 'application/xml; charset=UTF-8'], [$xbel->toString]]; |
|---|
| 139 | } |
|---|
| 140 | |
|---|
| 141 | sub as_text { |
|---|
| 142 | my $self = shift; |
|---|
| 143 | my $text = join '', |
|---|
| 144 | map { |
|---|
| 145 | sprintf "# %s\n# Tags: %s\n%s\n", |
|---|
| 146 | $_->title, |
|---|
| 147 | join(', ', @{ $_->tags }), |
|---|
| 148 | $_->uri |
|---|
| 149 | } @{ $self->results }; |
|---|
| 150 | return [200, ['Content-Type' => 'text/uri-list; charset=UTF-8'], [$text]]; |
|---|
| 151 | } |
|---|
| 152 | |
|---|
| 153 | sub as_csv { |
|---|
| 154 | my $self = shift; |
|---|
| 155 | |
|---|
| 156 | eval { require Text::CSV::Encoded } or |
|---|
| 157 | return [406, ['Content-Type' => 'text/plain'], ['This server does not support CSV lists']]; |
|---|
| 158 | |
|---|
| 159 | my $csv = Text::CSV::Encoded->new({ encoding_out => 'utf8' }); |
|---|
| 160 | my $text = qq{id,uri,title,tags,ctime,mtime\n}; |
|---|
| 161 | for my $bookmark (@{ $self->results }) { |
|---|
| 162 | my $success = $csv->combine( |
|---|
| 163 | $bookmark->id, |
|---|
| 164 | $bookmark->uri, |
|---|
| 165 | $bookmark->title, |
|---|
| 166 | join(' ', @{ $bookmark->tags }), |
|---|
| 167 | $bookmark->ctime, |
|---|
| 168 | $bookmark->mtime, |
|---|
| 169 | ); |
|---|
| 170 | $text .= $csv->string . "\n" if $success; |
|---|
| 171 | } |
|---|
| 172 | |
|---|
| 173 | # include the local timestamp in the attchment filename |
|---|
| 174 | my $dt = time2iso; |
|---|
| 175 | $dt =~ s/[^\d]//g; |
|---|
| 176 | |
|---|
| 177 | my $filename = sprintf( |
|---|
| 178 | 'bookmarks-%s-%s.csv', |
|---|
| 179 | join('_', @{ $self->tags }), |
|---|
| 180 | $dt, |
|---|
| 181 | ); |
|---|
| 182 | |
|---|
| 183 | return [200, ['Content-Type' => 'text/csv; charset=UTF-8', 'Content-Disposition' => sprintf('attachement; filename="%s"', $filename)], [$text]]; |
|---|
| 184 | } |
|---|
| 185 | |
|---|
| 186 | sub as_html { |
|---|
| 187 | my $self = shift; |
|---|
| 188 | |
|---|
| 189 | require Template; |
|---|
| 190 | require File::Basename; |
|---|
| 191 | my $template = Template->new({ INCLUDE_PATH => File::Basename::dirname($INC{'Bookmarks/List.pm'}) }); |
|---|
| 192 | |
|---|
| 193 | $template->process( |
|---|
| 194 | 'html_list.tt', |
|---|
| 195 | { |
|---|
| 196 | base_url => $self->bookmarks->base_uri, |
|---|
| 197 | title => $self->title, |
|---|
| 198 | query => $self->query, |
|---|
| 199 | links => [ $self->_get_list_links('text/html', { q => $self->query, tag => $self->tags }) ], |
|---|
| 200 | resources => $self->results, |
|---|
| 201 | pages => $self->search->pages, |
|---|
| 202 | }, |
|---|
| 203 | \my $output, |
|---|
| 204 | ); |
|---|
| 205 | return [200, ['Content-Type' => 'text/html; charset=UTF-8'], [$output]]; |
|---|
| 206 | } |
|---|
| 207 | |
|---|
| 208 | sub as_atom { |
|---|
| 209 | my $self = shift; |
|---|
| 210 | |
|---|
| 211 | eval { require XML::Atom } or |
|---|
| 212 | return [406, ['Content-Type' => 'text/plain'], ['This server does not support Atom lists']]; |
|---|
| 213 | |
|---|
| 214 | $XML::Atom::DefaultVersion = "1.0"; |
|---|
| 215 | |
|---|
| 216 | require XML::Atom::Feed; |
|---|
| 217 | require XML::Atom::Entry; |
|---|
| 218 | require XML::Atom::Link; |
|---|
| 219 | require XML::Atom::Category; |
|---|
| 220 | |
|---|
| 221 | my $feed = XML::Atom::Feed->new; |
|---|
| 222 | $feed->title($self->title); |
|---|
| 223 | |
|---|
| 224 | for my $link ($self->_get_list_links('application/atom+xml', { q => $self->query, tag => $self->tags })) { |
|---|
| 225 | my $atom_link = XML::Atom::Link->new; |
|---|
| 226 | $atom_link->type($link->{type}); |
|---|
| 227 | $atom_link->rel($link->{rel}); |
|---|
| 228 | $atom_link->href($link->{href}->canonical); |
|---|
| 229 | $feed->add_link($atom_link); |
|---|
| 230 | } |
|---|
| 231 | |
|---|
| 232 | for my $bookmark (@{ $self->results }) { |
|---|
| 233 | my $entry = XML::Atom::Entry->new; |
|---|
| 234 | $entry->id($bookmark->bookmark_uri->canonical); |
|---|
| 235 | $entry->title($bookmark->title); |
|---|
| 236 | |
|---|
| 237 | my $link = XML::Atom::Link->new; |
|---|
| 238 | $link->href($bookmark->uri); |
|---|
| 239 | $entry->add_link($link); |
|---|
| 240 | |
|---|
| 241 | $entry->summary('Tags: ' . join(', ', @{ $bookmark->tags })); |
|---|
| 242 | |
|---|
| 243 | my $cdatetime = time2isoz $bookmark->ctime; |
|---|
| 244 | my $mdatetime = time2isoz $bookmark->mtime; |
|---|
| 245 | # make the timestamp W3C-correct |
|---|
| 246 | s/ /T/ foreach ($cdatetime, $mdatetime); |
|---|
| 247 | $entry->published($cdatetime); |
|---|
| 248 | $entry->updated($mdatetime); |
|---|
| 249 | |
|---|
| 250 | for my $tag (@{ $bookmark->tags }) { |
|---|
| 251 | my $category = XML::Atom::Category->new; |
|---|
| 252 | $category->term($tag); |
|---|
| 253 | $entry->add_category($category); |
|---|
| 254 | } |
|---|
| 255 | |
|---|
| 256 | $feed->add_entry($entry); |
|---|
| 257 | } |
|---|
| 258 | |
|---|
| 259 | return [200, ['Content-Type' => 'application/atom+xml; charset=UTF-8'], [$feed->as_xml]]; |
|---|
| 260 | } |
|---|
| 261 | |
|---|
| 262 | 1; |
|---|