Bug 17501: Additional polishing (POD, unit tests)
[koha.git] / Koha / UploadedFile.pm
1 package Koha::UploadedFile;
2
3 # Copyright Rijksmuseum 2016
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 3 of the License, or (at your option) any later
10 # version.
11 #
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20 use Modern::Perl;
21 use File::Spec;
22
23 use parent qw(Koha::Object);
24
25 =head1 NAME
26
27 Koha::UploadedFile - Koha::Object class for single uploaded file
28
29 =head1 SYNOPSIS
30
31     use Koha::UploadedFile;
32
33     # store record in uploaded_files
34     my $upload = Koha::UploadedFile->new({ [columns and values] });
35
36     # get a file handle on an uploaded_file
37     my $fh = $upload->file_handle;
38
39     # get full path
40     my $path = $upload->full_path;
41
42     # delete uploaded file
43     $upload->delete;
44
45 =head1 DESCRIPTION
46
47 Allows regular CRUD operations on uploaded_files via Koha::Object / DBIx.
48
49 The delete method also takes care of deleting files. The full_path method
50 returns a fully qualified path for an upload.
51
52 Additional methods include: file_handle, httpheaders.
53
54 =head1 METHODS
55
56 =head2 INSTANCE METHODS
57
58 =head3 delete
59
60 Delete uploaded file.
61 It deletes not only the record, but also the actual file (unless you pass
62 the keep_file parameter).
63
64 Returns filename on successful delete or undef.
65
66 =cut
67
68 sub delete {
69     my ( $self, $params ) = @_;
70
71     my $name = $self->filename;
72     my $file = $self->full_path;
73
74     if( $params->{keep_file} ) {
75         return $name if $self->SUPER::delete;
76     } elsif( !-e $file ) { # we will just delete the record
77         warn "Removing record for $name within category ".
78             $self->uploadcategorycode. ", but file was missing.";
79         return $name if $self->SUPER::delete;
80     } elsif( unlink($file) ) {
81         return $name if $self->SUPER::delete;
82     } else {
83         warn "Problem while deleting: $file";
84     }
85     return; # something went wrong
86 }
87
88 =head3 full_path
89
90 Returns the fully qualified path name for an uploaded file.
91
92 =cut
93
94 sub full_path {
95     my ( $self ) = @_;
96     my $path = File::Spec->catfile(
97         $self->permanent?
98             $self->permanent_directory: $self->temporary_directory,
99         $self->dir,
100         $self->hashvalue. '_'. $self->filename,
101     );
102     return $path;
103 }
104
105 =head3 file_handle
106
107 Returns a file handle for an uploaded file.
108
109 =cut
110
111 sub file_handle {
112     my ( $self ) = @_;
113     $self->{_file_handle} = IO::File->new( $self->full_path, "r" );
114     return if !$self->{_file_handle};
115     $self->{_file_handle}->binmode;
116     return $self->{_file_handle};
117 }
118
119 =head3 httpheaders
120
121 httpheaders returns http headers for a retrievable upload.
122
123 Will be extended by report 14282
124
125 =cut
126
127 sub httpheaders {
128     my ( $self ) = @_;
129     return (
130         '-type'       => 'application/octet-stream',
131         '-attachment' => $self->filename,
132     );
133 }
134
135 =head2 CLASS METHODS
136
137 =head3 permanent_directory
138
139 Returns root directory for permanent storage
140
141 =cut
142
143 sub permanent_directory {
144     my ( $class ) = @_;
145     return C4::Context->config('upload_path');
146 }
147
148 =head3 tmp_directory
149
150 Returns root directory for temporary storage
151
152 =cut
153
154 sub temporary_directory {
155     my ( $class ) = @_;
156     return File::Spec->tmpdir;
157 }
158
159 =head3 getCategories
160
161 getCategories returns a list of upload category codes and names
162
163 =cut
164
165 sub getCategories {
166     my ( $class ) = @_;
167     my $cats = C4::Koha::GetAuthorisedValues('UPLOAD');
168     [ map {{ code => $_->{authorised_value}, name => $_->{lib} }} @$cats ];
169 }
170
171 =head3 _type
172
173 Returns name of corresponding DBIC resultset
174
175 =cut
176
177 sub _type {
178     return 'UploadedFile';
179 }
180
181 =head1 AUTHOR
182
183 Marcel de Rooy (Rijksmuseum)
184
185 Koha Development Team
186
187 =cut
188
189 1;