From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

BRTASTIC / Plack-App-Storage-Abstract-0.002 / lib / Plack / App / Storage / Abstract.pm 

            

              
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

              
package Plack::App::Storage::Abstract;
$Plack::App::Storage::Abstract::VERSION = '0.002';
use v5.14;
use warnings;
use Storage::Abstract;
use Plack::MIME;
use HTTP::Date;
use Try::Tiny;
use Scalar::Util qw(blessed);
use parent 'Plack::Component';
use Plack::Util::Accessor qw(encoding storage storage_config);
sub new
{
        my ($class, @args) = @_;
        my $self = $class->SUPER::new(@args);
        $self->storage(Storage::Abstract->new(%{$self->storage_config}))
                unless $self->storage;
        $self->encoding($self->encoding // 'utf-8');
        return $self;
}
sub call
{
        my ($self, $env) = @_;
        my $path = $env->{PATH_INFO};
        my $fh;
        my %info;
        my $e;
        try {
                $fh = $self->storage->retrieve($path, \%info);
        }
        catch {
                $e = $_;
        };
        if ($e) {
                if (blessed $e && $e->isa('Storage::Abstract::X::NotFound')) {
                        return $self->_error_code(404);
                }
                elsif (blessed $e && $e->isa('Storage::Abstract::X::PathError')) {
                        return $self->_error_code(403);
                }
                else {
                        # StorageError or HandleError or unblessed error
                        $env->{'psgi.errors'}->print("$e");
                        return $self->_error_code(500);
                }
        }
        my $content_type = Plack::MIME->mime_type($path) || 'text/plain';
        if ($content_type =~ m{^text/}) {
                $content_type .= "; charset=" . $self->encoding;
        }
        return [
                200,
                [
                        'Content-Type' => $content_type,
                        'Content-Length' => $info{size},
                        'Last-Modified' => HTTP::Date::time2str($info{mtime}),
                ],
                $fh
        ];
}
sub _error_code
{
        my ($self, $code) = @_;
        my %text = (
                400 => 'Bad Request',
                403 => 'Forbidden',
                404 => 'Not Found',
        );
        return [
                $code,
                [
                        'Content-Type' => 'text/plain',
                        'Content-Length' => length $text{$code}
                ],
                [$text{$code}]
        ];
}
1;
__END__
=head1 NAME
Plack::App::Storage::Abstract - Serve files with Storage::Abstract
=head1 SYNOPSIS
        use Plack::App::Storage::Abstract;
        my $app1 = Plack::App::Storage::Abstract->new(
                storage_config => {
                        driver => 'directory',
                        directory => '/some/dir',
                },
        )->to_app;
=head1 DESCRIPTION
This plack application serves files through L<Storage::Abstract>. It is similar
to L<Plack::App::File>, but gives better control over file storage.
=head1 CONFIGURATION
=head2 storage
The constructed C<Storage::Abstract> object. If not present, will be
constructed from L</storage_config>.
=head2 storage_config
A hash reference with keys to be passed to L<Storage::Abstract/new>. Required,
but may be skipped if L</storage> is passed instead.
=head2 encoding
Encoding used for text MIME types. Default C<utf-8>.
=head1 CAVEATS
=head2 Handling errors
On error producing a C<500> page, stringified exception will be written to PSGI error stream.
=head1 SEE ALSO
L<Plack::App::File>
L<Storage::Abstract>
=head1 AUTHOR
Bartosz Jarzyna E<lt>bbrtj.pro@gmail.comE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2024 by Bartosz Jarzyna
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.