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