File: Attachment.pm

package info (click to toggle)
libmojomojo-perl 1.01%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 4,272 kB
  • ctags: 879
  • sloc: perl: 14,055; sh: 145; xml: 120; ruby: 6; makefile: 2
file content (293 lines) | stat: -rw-r--r-- 7,411 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
package MojoMojo::Controller::Attachment;

use strict;
use parent 'Catalyst::Controller';

use IO::File;
use URI::Escape ();

=head1 NAME

MojoMojo::Controller::Attachment - Attachment controller

=head1 DESCRIPTION

MojoMojo supports attaching files to nodes. This controller handles
administration and serving of these assets.


=head1 ACTIONS

=head2 auth

Return whether the current user has attachment manipulation rights (upload/delete).

=cut

sub auth : Private {
    my ( $self, $c ) = @_;

    my $perms =
        $c->check_permissions( $c->stash->{'path'},
        ( $c->user_exists ? $c->user->obj : undef ) );
    return $perms->{'attachment'}
}

=head2 unauthorized

Private action to return a 403 with an explanatory template.

=cut

sub unauthorized : Private {
    my ( $self, $c, $operation ) = @_;
    $c->stash->{template} = 'message.tt';
    $c->stash->{message}  = $c->loc('You do not have permissions to x attachments for this page', $operation);
    $c->response->status(403);  # 403 Forbidden
}

=head2 default

Private action to return a 404 not found page.

=cut

sub default : Private {
    my ( $self, $c ) = @_;
    $c->stash->{template} = 'message.tt';
    $c->stash->{message}  = $c->loc("Attachment not found.");
    return ( $c->res->status(404) );
}

=head2 attachments

Main attachment screen.  Handles uploading of new attachments.

=cut

sub attachments : Global {
    my ( $self, $c ) = @_;

    $c->detach('unauthorized', ['view']) if not $c->check_view_permission;

    $c->stash->{template} = 'page/attachments.tt';
}

=head2 list

Display the list of attachments if the user has view permissions.

B<template>: F<attachments/list.tt>

=cut

sub list : Local {
    my ( $self, $c ) = @_;

    $c->detach('unauthorized', ['view']) if not $c->check_view_permission;

    $c->stash->{template}='attachments/list.tt';
}

=head2 plain_upload

Upload feature that uses the traditional upload technique.

=cut

sub plain_upload : Global {
    my ( $self, $c ) = @_;
    $c->detach('unauthorized', ['upload']) if not $c->forward('auth');
    $c->forward('check_file');
}

=head2 check_file

Check if the file(s) uploaded could be added to the Attachment table.

=cut
sub check_file : Private  {
    my ($self,$c)=@_;
    my $page = $c->stash->{page};
    if ( my $file = $c->req->params->{file} ) {
        my $upload = $c->request->upload('file');
        my (@att) =  # an array is returned if a ZIP upload was unpacked
            $c->model("DBIC::Attachment")
            ->create_from_file( $page, $file, $upload->tempname );
        if ( !@att ) {
            $c->stash->{template} = 'message.tt';
            $c->stash->{message}  = $c->loc("Could not create attachment from x", $file);
        }

        my $redirect_uri = $c->uri_for('attachments', {plain => $c->req->params->{plain}});
        $c->res->redirect($redirect_uri)  # TODO weird condition. This should be an else to the 'if' above
            unless defined $c->stash->{template} && $c->stash->{template} eq 'message.tt';
    }
}

=head2 flash_upload

Upload feature that uses flash

=cut

sub flash_upload : Local {
    my ( $self, $c ) = @_;

    my $user = $c->model('DBIC::Person')->find( $c->req->params->{id} );

    $c->detach('/default')
        unless (
        $user->hashed( $c->pref('entropy') ) eq $c->req->params->{verify} );

    $c->forward('check_file');

    if ( $c->res->redirect ) {
        $c->res->redirect( undef, 200 );
        return $c->res->body('1');
    }

    $c->res->body('0');
}

=head2 attachment

Find and stash an attachment.

=cut

sub attachment : Chained CaptureArgs(1) {
    my ( $self, $c, $att ) = @_;
    $c->stash->{att} = $c->model("DBIC::Attachment")->find($att)
        or $c->detach('default');
}

=head2 defaultaction

Set the default action for an attachment which is forwarding to a view.

=cut

sub defaultaction : PathPart('') Chained('attachment') Args(0) {
    my ( $self, $c ) = @_;
    $c->forward('view');
}

=head2 view

Render the attachment in the browser (C<Content-Disposition: inline>), with
caching for 1 day.

=cut

sub view : Chained('attachment') Args(0) {
    my ( $self, $c ) = @_;
    my $att = $c->stash->{att};
    $c->detach('unauthorized', ['view']) if not $c->check_view_permission;

    # avoid broken binary files
    my $io_file = IO::File->new( $att->filename )
        or $c->detach('default');
    $io_file->binmode;

    $c->res->output( $io_file );
    $c->res->header( 'content-type', $att->contenttype );
    $c->res->header(
        "Content-Disposition" => "inline; filename=" . URI::Escape::uri_escape_utf8( $att->name ) );
    $c->res->header( 'Cache-Control', 'max-age=86400, must-revalidate' );
}

=head2 download

Forwards to L</view> then forces the attachment to be downloaded
(C<Content-Disposition: attachment>) and disables caching.

=cut

sub download : Chained('attachment') Args(0) {
    my ( $self, $c ) = @_;
    $c->forward('view');
    $c->res->header( "Content-Disposition" => "attachment; filename=" . URI::Escape::uri_escape_utf8( $c->stash->{att}->name ) );
    $c->res->header( 'Cache-Control', 'no-cache' );

}

=head2 thumb

Thumb action for attachments. Makes 100x100px thumbnails.

=cut

sub thumb : Chained('attachment') Args(0) {
    my ( $self, $c ) = @_;
    $c->detach('unauthorized', ['view']) if not $c->check_view_permission;
    my $att = $c->stash->{att};
    my $photo;
    unless ( $photo = $att->photo ) {
        return $c->res->body($c->loc('Can only make thumbnails of photos'));
    }
    $photo->make_thumb() unless -f $att->thumb_filename;
    my $io_file = IO::File->new( $att->thumb_filename )
        or $c->detach('default');
    $io_file->binmode;

    $c->res->output( $io_file );
    $c->res->header( 'content-type', $att->contenttype );
    $c->res->header( "Content-Disposition" => "inline; filename=" . URI::Escape::uri_escape_utf8( $att->name ) );
    $c->res->header( 'Cache-Control', 'max-age=86400, must-revalidate' );

}

=head2 inline

Show 800x600 inline versions of photo attachments.

=cut

sub inline : Chained('attachment') Args(0) {
    my ( $self, $c ) = @_;
    $c->detach('unauthorized', ['view']) if not $c->check_view_permission;
    my $att = $c->stash->{att};
    my $photo;
    unless ( $photo = $att->photo ) {
        return $c->res->body($c->loc('Can only make inline version of photos'));
    }
    $photo->make_inline unless -f $att->inline_filename;
    my $io_file = IO::File->new( $att->inline_filename )
        or $c->detach('default');
    $io_file->binmode;

    $c->res->output( $io_file );
    $c->res->header( 'content-type', $c->stash->{att}->contenttype );
    $c->res->header(
        "Content-Disposition" => "inline; filename=" . URI::Escape::uri_escape_utf8( $c->stash->{att}->name ) );
    $c->res->header( 'Cache-Control', 'max-age=86400, must-revalidate' );

}

=head2 delete

Delete the attachment from this node. Will leave the original file on the
file system but delete its thumbnail and inline versions.

=cut

sub delete : Chained('attachment') Args(0) {
    my ( $self, $c ) = @_;
    $c->detach('unauthorized', ['delete']) if not $c->forward('auth');
    $c->stash->{att}->delete();
    $c->forward('attachments');
}

=head1 AUTHOR

Marcus Ramberg C<marcus@nordaaker.com>

=head1 LICENSE

This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;