root/lang/perl/Catalyst-Controller-Atompub/trunk/samples/MyBlog/lib/MyBlog/Controller/MediaCollection.pm @ 8062

Revision 8062, 5.9 kB (checked in by takemaru, 5 years ago)

lang/perl/Catalyst-Controller-Atompub: 0.4.0 rc1. major refactoring etc., see Changes in details

Line 
1package # hide from PAUSE
2    MyBlog::Controller::MediaCollection;
3
4use strict;
5use warnings;
6
7use Atompub::DateTime qw(datetime);
8use Atompub::MediaType qw(media_type);
9use MIME::Base64;
10use HTTP::Status;
11use POSIX qw(strftime);
12use String::CamelCase qw(camelize);
13use Time::HiRes qw(gettimeofday);
14
15use base qw(Catalyst::Controller::Atompub::Collection);
16
17my $ENTRIES_PER_PAGE = 10;
18my $TABLE_NAME       = 'medias';
19
20my $MODEL = join '::', 'DBIC', camelize($TABLE_NAME);
21
22sub get_feed :Atompub(list) {
23    my($self, $c) = @_;
24
25    ## URI without parameters
26    my $uri = $self->collection_resource->uri;
27
28    my $feed = $self->collection_resource->body;
29
30    my $page = $c->req->param('page') || 1;
31
32    my $attr = {
33        offset   => ($page - 1) * $ENTRIES_PER_PAGE,
34        rows     => $ENTRIES_PER_PAGE,
35        order_by => 'edited desc',
36    };
37
38    my $rs = $c->model($MODEL)->search({}, $attr);
39
40    while (my $resource = $rs->next) {
41        my $entry = XML::Atom::Entry->new(\$resource->entry_body);
42        $feed->add_entry($entry);
43    }
44
45    $feed->alternate_link($c->req->base.'html');
46    $feed->first_link($uri);
47    $feed->previous_link("$uri?page=".($page-1)) if $page > 1;
48    $feed->next_link("$uri?page=".($page+1)) if $rs->count >= $ENTRIES_PER_PAGE;
49
50    1;
51}
52
53sub create_resource :Atompub(create) {
54    my($self, $c) = @_;
55
56    # URIs were determined by C::C::Atompub
57    my $entry_uri = $self->media_link_entry->uri;
58    my $media_uri = $self->media_resource->uri;
59
60    return $self->error($c, RC_CONFLICT, "Resource name is used (change Slug): $entry_uri")
61        if $c->model($MODEL)->search({ entry_uri => $entry_uri })->count;
62
63    # Edit $entry and $media if needed ...
64
65    my $vals = {
66        edited     => $self->edited->epoch,
67        entry_uri  => $entry_uri,
68        entry_etag => $self->calculate_new_etag($c, $entry_uri),
69        entry_body => $self->media_link_entry->body->as_xml,
70        media_uri  => $media_uri,
71        media_etag => $self->calculate_new_etag($c, $media_uri),
72        media_body => MIME::Base64::encode($self->media_resource->body),
73        media_type => $self->media_resource->type,
74    };
75
76    $c->model($MODEL)->create($vals)
77        or return $self->error($c, RC_INTERNAL_SERVER_ERROR,
78                               'Cannot create new media resource');
79
80    1;
81}
82
83sub get_resource :Atompub(read) {
84    my($self, $c) = @_;
85
86    my $uri = $c->req->uri;
87
88    my $cond = {
89        '-or' => [
90            { entry_uri => $uri },
91            { media_uri => $uri },
92        ],
93    };
94
95    my $rs = $c->model($MODEL)->search($cond)->first
96        or return $self->error($c, RC_NOT_FOUND);
97
98    if ($rs->entry_uri eq $uri) {
99        $self->media_link_entry->body( XML::Atom::Entry->new(\$rs->entry_body) );
100        $self->media_resource->type(media_type('entry'));
101    }
102    else {
103        $self->media_resource->body( MIME::Base64::decode($rs->media_body) );
104        $self->media_resource->type($rs->media_type);
105    }
106
107    1;
108}
109
110sub update_resource :Atompub(update) {
111    my($self, $c) = @_;
112
113    my $uri = $c->req->uri;
114
115    my $cond = {
116        '-or' => [
117            { entry_uri => $uri },
118            { media_uri => $uri },
119        ],
120    };
121
122    my $rs = $c->model($MODEL)->search($cond)->first
123        or return $self->error($c, RC_NOT_FOUND);
124
125    my $vals = { edited => $self->edited->epoch };
126
127    my($media_link_entry, $media_type);
128    if ($rs->entry_uri eq $uri) {
129        $media_link_entry = $self->media_link_entry->body;
130        $media_type = $rs->media_type;
131
132        # Don't update the Last-Modified value of the corresponding
133        # Media Resource if you use it
134    }
135    else {
136        $media_link_entry = XML::Atom::Entry->new(\$rs->entry_body)
137            or return $self->error($c);
138
139        $vals->{media_etag} = $self->calculate_new_etag($c, $rs->media_uri);
140        $vals->{media_body} = MIME::Base64::encode($self->media_resource->body);
141        $vals->{media_type} = $media_type = $self->media_resource->type;
142
143        # Do update the Last-Modified value of the Media Resource if you use it
144    }
145
146    # app:edited and atom:content in Media Link Entry MUST be updated
147    $media_link_entry->edited($self->edited->w3c);
148    my $content = XML::Atom::Content->new;
149    $content->src($rs->media_uri);
150    $content->type($media_type);
151    $media_link_entry->content($content);
152
153    $vals->{entry_body} = $media_link_entry->as_xml;
154    $vals->{entry_etag} = $self->calculate_new_etag($c, $rs->entry_uri);
155
156    $rs->update($vals)
157        or return $self->error($c, RC_INTERNAL_SERVER_ERROR, "Cannot update resource: $uri");
158
159    1;
160}
161
162sub delete_resource :Atompub(delete) {
163    my($self, $c) = @_;
164
165    my $uri = $c->req->uri;
166
167    my $cond = {
168        '-or' => [
169            { entry_uri => $uri },
170            { media_uri => $uri },
171        ],
172    };
173
174    my $rs = $c->model($MODEL)->search($cond)->first
175        or return $self->error($c, RC_NOT_FOUND);
176
177    # delete entry and media resources at once
178    $rs->delete
179        or return $self->error($c, RC_INTERNAL_SERVER_ERROR, "Cannot delete resource: $uri");
180
181    1;
182}
183
184sub make_edit_uri {
185    my($self, $c, @args) = @_;
186
187    my @uris = $self->SUPER::make_edit_uri($c, @args);
188
189    my $cond = {
190        '-or' => [
191            { entry_uri => $uris[0] },
192            { media_uri => $uris[0] },
193        ],
194    };
195
196    # return, if $uris[0] is not used
197    return wantarray ? @uris : $uris[0]
198        unless $c->model($MODEL)->search($cond)->count;
199
200    my($sec, $usec) = gettimeofday;
201    my $dt = strftime '%Y%m%d-%H%M%S', localtime($sec);
202    $usec  = sprintf '%06d', $usec;
203
204    # insert $dt-$usec before extension
205    $_ =~ s{(\.[^./?]+)$}{-$dt-$usec$1} for @uris;
206
207    @uris;
208}
209
210sub find_version {
211    my($self, $c, $uri) = @_;
212
213    my $cond = {
214        '-or' => [
215            { entry_uri => $uri },
216            { media_uri => $uri },
217        ],
218    };
219
220    my $rs = $c->model($MODEL)->search($cond)->first or return;
221
222    if ($rs->entry_uri eq $uri) {
223        return (etag => $rs->entry_etag);
224    }
225    else {
226        return (etag => $rs->media_etag);
227    }
228}
229
230sub calculate_new_etag {
231    my($self, $c, $uri) = @_;
232    my($sec, $usec) = gettimeofday;
233    my $dt = join '-', strftime('%Y%m%d-%H%M%S', localtime($sec)), sprintf('%06d', $usec);
234    join '/', $uri, $dt;
235}
236
2371;
Note: See TracBrowser for help on using the browser.