Koha/Misc/Files.pm

   1 package Koha::Misc::Files;
   2
   3 # This file is part of Koha.
   4 #
   5 # Copyright 2012 Kyle M Hall
   6 # Copyright 2014 Jacek Ablewicz
   7 # Based on Koha/Borrower/Files.pm by Kyle M Hall
   8 #
   9 # Koha is free software; you can redistribute it and/or modify it
  10 # under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation; either version 3 of the License, or
  12 # (at your option) any later version.
  13 #
  14 # Koha is distributed in the hope that it will be useful, but
  15 # WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  21
  22 use Modern::Perl;
  23 use vars qw($VERSION);
  24 $VERSION = '0.25';
  25
  26 use C4::Context;
  27 use C4::Output;
  28 use C4::Dates;
  29
  30 =head1 NAME
  31
  32 Koha::Misc::Files - module for managing miscellaneous files associated
  33 with records from arbitrary tables
  34
  35 =head1 SYNOPSIS
  36
  37 use Koha::Misc::Files;
  38
  39 my $mf = Koha::Misc::Files->new( tabletag => $tablename,
  40     recordid => $recordnumber );
  41
  42 =head1 FUNCTIONS
  43
  44 =over
  45
  46 =item new()
  47
  48 my $mf = Koha::Misc::Files->new( tabletag => $tablename,
  49     recordid => $recordnumber );
  50
  51 Creates new Koha::Misc::Files object. Such object is essentially
  52 a pair: in typical usage scenario, 'tabletag' parameter will be
  53 a database table name, and 'recordid' an unique record ID number
  54 from this table. However, this method does accept an arbitrary
  55 string as 'tabletag', and an arbitrary integer as 'recordid'.
  56
  57 Particular Koha::Misc::Files object can have one or more file records
  58 (actuall file contents + various file metadata) associated with it.
  59
  60 In case of an error (wrong parameter format) it returns undef.
  61
  62 =cut
  63
  64 sub new {
  65     my ( $class, %args ) = @_;
  66
  67     my $recid = $args{'recordid'};
  68     my $tag   = $args{'tabletag'};
  69     ( defined($tag) && $tag ne '' && defined($recid) && $recid =~ /^\d+$/ )
  70       || return ();
  71
  72     my $self = bless( {}, $class );
  73
  74     $self->{'table_tag'} = $tag;
  75     $self->{'record_id'} = '' . ( 0 + $recid );
  76
  77     return $self;
  78 }
  79
  80 =item GetFilesInfo()
  81
  82 my $files_descriptions = $mf->GetFilesInfo();
  83
  84 This method returns a reference to an array of hashes
  85 containing files metadata (file_id, file_name, file_type,
  86 file_description, file_size, date_uploaded) for all file records
  87 associated with given $mf object, or an empty arrayref if there are
  88 no such records yet.
  89
  90 In case of an error it returns undef.
  91
  92 =cut
  93
  94 sub GetFilesInfo {
  95     my $self = shift;
  96
  97     my $dbh   = C4::Context->dbh;
  98     my $query = '
  99         SELECT
 100             file_id,
 101             file_name,
 102             file_type,
 103             file_description,
 104             date_uploaded,
 105             LENGTH(file_content) AS file_size
 106         FROM misc_files
 107         WHERE table_tag = ? AND record_id = ?
 108         ORDER BY file_name, date_uploaded
 109     ';
 110     my $sth = $dbh->prepare($query);
 111     $sth->execute( $self->{'table_tag'}, $self->{'record_id'} );
 112     return $sth->fetchall_arrayref( {} );
 113 }
 114
 115 =item AddFile()
 116
 117 $mf->AddFile( name => $filename, type => $mimetype,
 118     description => $description, content => $content );
 119
 120 Adds a new file (we want to store for / associate with a given
 121 object) to the database. Parameters 'name' and 'content' are mandatory.
 122 Note: this method would (silently) fail if there is no 'name' given
 123 or if the 'content' provided is empty.
 124
 125 =cut
 126
 127 sub AddFile {
 128     my ( $self, %args ) = @_;
 129
 130     my $name        = $args{'name'};
 131     my $type        = $args{'type'} // '';
 132     my $description = $args{'description'};
 133     my $content     = $args{'content'};
 134
 135     return unless ( defined($name) && $name ne '' && defined($content) && $content ne '' );
 136
 137     my $dbh   = C4::Context->dbh;
 138     my $query = '
 139         INSERT INTO misc_files ( table_tag, record_id, file_name, file_type, file_description, file_content )
 140         VALUES ( ?,?,?,?,?,? )
 141     ';
 142     my $sth = $dbh->prepare($query);
 143     $sth->execute( $self->{'table_tag'}, $self->{'record_id'}, $name, $type,
 144         $description, $content );
 145 }
 146
 147 =item GetFile()
 148
 149 my $file = $mf->GetFile( id => $file_id );
 150
 151 For an individual, specific file ID this method returns a hashref
 152 containing all metadata (file_id, table_tag, record_id, file_name,
 153 file_type, file_description, file_content, date_uploaded), plus
 154 an actuall contents of a file (in 'file_content'). In typical usage
 155 scenarios, for a given $mf object, specific file IDs have to be
 156 obtained first by GetFilesInfo() call.
 157
 158 Returns undef in case when file ID specified as 'id' parameter was not
 159 found in the database.
 160
 161 =cut
 162
 163 sub GetFile {
 164     my ( $self, %args ) = @_;
 165
 166     my $file_id = $args{'id'};
 167
 168     my $dbh   = C4::Context->dbh;
 169     my $query = '
 170         SELECT * FROM misc_files WHERE file_id = ? AND table_tag = ? AND record_id = ?
 171     ';
 172     my $sth = $dbh->prepare($query);
 173     $sth->execute( $file_id, $self->{'table_tag'}, $self->{'record_id'} );
 174     return $sth->fetchrow_hashref();
 175 }
 176
 177 =item DelFile()
 178
 179 $mf->DelFile( id => $file_id );
 180
 181 Deletes specific, individual file record (file contents and metadata)
 182 from the database.
 183
 184 =cut
 185
 186 sub DelFile {
 187     my ( $self, %args ) = @_;
 188
 189     my $file_id = $args{'id'};
 190
 191     my $dbh   = C4::Context->dbh;
 192     my $query = '
 193         DELETE FROM misc_files WHERE file_id = ? AND table_tag = ? AND record_id = ?
 194     ';
 195     my $sth = $dbh->prepare($query);
 196     $sth->execute( $file_id, $self->{'table_tag'}, $self->{'record_id'} );
 197 }
 198
 199 =item DelAllFiles()
 200
 201 $mf->DelAllFiles();
 202
 203 Deletes all file records associated with (stored for) a given $mf object.
 204
 205 =cut
 206
 207 sub DelAllFiles {
 208     my ($self) = @_;
 209
 210     my $dbh   = C4::Context->dbh;
 211     my $query = '
 212         DELETE FROM misc_files WHERE table_tag = ? AND record_id = ?
 213     ';
 214     my $sth = $dbh->prepare($query);
 215     $sth->execute( $self->{'table_tag'}, $self->{'record_id'} );
 216 }
 217
 218 =item MergeFileRecIds()
 219
 220 $mf->MergeFileRecIds(@ids_to_be_merged);
 221
 222 This method re-associates all individuall file records associated with
 223 some "parent" records IDs (provided in @ids_to_be_merged) with the given
 224 single $mf object (which would be treated as a "parent" destination).
 225
 226 This a helper method; typically it needs to be called only in cases when
 227 some "parent" records are being merged in the (external) 'tablename'
 228 table.
 229
 230 =cut
 231
 232 sub MergeFileRecIds {
 233     my ( $self, @ids_to_merge ) = @_;
 234
 235     my $dst_recid = $self->{'record_id'};
 236     @ids_to_merge = map { ( $dst_recid == $_ ) ? () : ($_); } @ids_to_merge;
 237     @ids_to_merge > 0 || return ();
 238
 239     my $dbh   = C4::Context->dbh;
 240     my $query = '
 241         UPDATE misc_files SET record_id = ?
 242         WHERE table_tag = ? AND record_id = ?
 243     ';
 244     my $sth = $dbh->prepare($query);
 245
 246     for my $src_recid (@ids_to_merge) {
 247         $sth->execute( $dst_recid, $self->{'table_tag'}, $src_recid );
 248     }
 249 }
 250
 251 1;
 252
 253 __END__
 254
 255 =back
 256
 257 =head1 SEE ALSO
 258
 259 Koha::Borrower::Files
 260
 261 =head1 AUTHOR
 262
 263 Kyle M Hall E<lt>kyle.m.hall@gmail.comE<gt>,
 264 Jacek Ablewicz E<lt>ablewicz@gmail.comE<gt>
 265
 266 =cut