[70] | 1 | package Bookmarks::List; |
---|
[68] | 2 | |
---|
| 3 | use Moose; |
---|
| 4 | |
---|
| 5 | use Encode; |
---|
| 6 | use HTTP::Date qw{time2iso time2isoz}; |
---|
| 7 | |
---|
[71] | 8 | has bookmarks => ( |
---|
[68] | 9 | is => 'ro', |
---|
[71] | 10 | isa => 'Bookmarks', |
---|
[68] | 11 | ); |
---|
[71] | 12 | has search => ( |
---|
| 13 | is => 'ro', |
---|
| 14 | isa => 'Bookmarks::Search', |
---|
[88] | 15 | handles => [qw{query tags limit offset results}], |
---|
[71] | 16 | ); |
---|
[68] | 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) = @_; |
---|
[69] | 26 | |
---|
| 27 | # remove extraneous blank ?q= parameters |
---|
| 28 | delete $query->{q} if defined $query->{q} && $query->{q} eq ''; |
---|
| 29 | |
---|
[68] | 30 | my @links = ( |
---|
| 31 | { |
---|
| 32 | text => 'JSON', |
---|
| 33 | type => 'application/json', |
---|
[112] | 34 | path => 'list', |
---|
[68] | 35 | query => { |
---|
| 36 | %$query, |
---|
| 37 | format => 'json', |
---|
| 38 | }, |
---|
| 39 | }, |
---|
| 40 | { |
---|
| 41 | text => 'XBEL', |
---|
| 42 | type => 'application/xml', |
---|
[112] | 43 | path => 'list', |
---|
[68] | 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', |
---|
[112] | 60 | path => 'list', |
---|
[68] | 61 | query => { |
---|
| 62 | %$query, |
---|
| 63 | format => 'csv', |
---|
| 64 | }, |
---|
| 65 | }, |
---|
| 66 | { |
---|
| 67 | text => 'URI List', |
---|
| 68 | type => 'text/uri-list', |
---|
[112] | 69 | path => 'list', |
---|
[68] | 70 | query => { |
---|
| 71 | %$query, |
---|
| 72 | format => 'text', |
---|
| 73 | }, |
---|
| 74 | }, |
---|
| 75 | { |
---|
| 76 | text => 'HTML', |
---|
| 77 | type => 'text/html', |
---|
[112] | 78 | path => 'list', |
---|
[68] | 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({ |
---|
[91] | 104 | bookmarks => [ map { $_->to_hashref } @{ $self->results } ], |
---|
[68] | 105 | }) |
---|
| 106 | ); |
---|
| 107 | return [200, ['Content-Type' => 'application/json; charset=UTF-8'], [$json]]; |
---|
| 108 | } |
---|
| 109 | |
---|
| 110 | sub as_xbel { |
---|
| 111 | my $self = shift; |
---|
| 112 | |
---|
[112] | 113 | eval { require XML::XBEL; } or |
---|
| 114 | return [406, ['Content-Type' => 'text/plain'], ['This server does not support XBEL lists']]; |
---|
| 115 | |
---|
[68] | 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; |
---|
[112] | 155 | |
---|
| 156 | eval { require Text::CSV::Encoded } or |
---|
| 157 | return [406, ['Content-Type' => 'text/plain'], ['This server does not support CSV lists']]; |
---|
| 158 | |
---|
[68] | 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 | |
---|
[113] | 183 | return [200, ['Content-Type' => 'text/csv; charset=UTF-8', 'Content-Disposition' => sprintf('attachment; filename="%s"', $filename) ], [$text]]; |
---|
[68] | 184 | } |
---|
| 185 | |
---|
| 186 | sub as_html { |
---|
| 187 | my $self = shift; |
---|
| 188 | |
---|
| 189 | require Template; |
---|
[95] | 190 | require File::Basename; |
---|
| 191 | my $template = Template->new({ INCLUDE_PATH => File::Basename::dirname($INC{'Bookmarks/List.pm'}) }); |
---|
[68] | 192 | |
---|
| 193 | $template->process( |
---|
[112] | 194 | 'html_list.tt', |
---|
[68] | 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, |
---|
[106] | 201 | pages => $self->search->pages, |
---|
[68] | 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 | |
---|
[112] | 211 | eval { require XML::Atom } or |
---|
| 212 | return [406, ['Content-Type' => 'text/plain'], ['This server does not support Atom lists']]; |
---|
| 213 | |
---|
[68] | 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; |
---|