use App::Class; # Import::Into
class Model::DPW;
use File::Copy;
use Data::Printer;
use Log::Any qw($log);
use File::Spec::Functions; # catfile
field $dbix :reader :param;
field $docs_path; # defined in set_docs_path(), :writer not yet supported
my $table = 'dpw';
my @cols = qw(id description category comment filename date retained); # excl. time
# timestamp is GMT, needs to be converted to local timezone:
my $fields = join ',', @cols, q!DATETIME(time, 'localtime') as time!;
# this can be deleted when Feature::Compat::Class supports :writer
method set_docs_path ($path) { $docs_path = $path }
method save_document ($params, $data_file) { # p $params;
if ( $data_file ) {
# capture filename, replace spaces with underscores, non-destructive
my $filename = $data_file->filename =~ s{\s}{_}gr; # p $filename;
# for test scripts (filename is full path):
$filename = $1 if $filename =~ m!/t/src/(.*)!;# p $filename;
# add filename to params:
$params->{filename} = $filename; # p $params;
# check file doesn't already exist & create destination folder if needed:
try {
#captures upload dir and adds to params for file-save in route
$self->_check_and_set_filepath($params); # sets $! if file already exists
}
catch ($e) { return { error => $e } }; # returns from method, not try/catch
} # only get this far if try/catch did not set $e
# before potential update, determine if file needs moving to new location
# initialises param '_category' & returns true if filename supplied and
# category changed:
# TODO: this may not be possible if data_file supplied, maybe make an else block ?
my $requires_file_move = $self->_requires_file_move($params); # say $requires_file_move;
my $cols = join ',', @cols; # global $fields includes DATETIME(time ...)
my $sql = qq!INSERT INTO $table($cols) VALUES (?,?,?,?,?,?,?) ON CONFLICT(id)
DO UPDATE SET description = ?, category = ?, comment = ?, filename = ?,
date = ?, retained = ?!; # p $sql;
my @bind = ( @{$params}{@cols}, @{$params}{ @cols[1 .. $#cols] }); # omit 'id'
# p @bind;
try {
# die on db error since user probably cannot do anything about it:
$dbix->query( $sql, @bind ) or die $dbix->error;
# maybe move file to new location:
if ( $requires_file_move ) { # return true, or set $! & returns 0:
$self->_move_file($params); # dies on error, caught in catch block
}
# record id = $params->{id} from record edit, or get last insert:
my $id = $params->{id} || $dbix->last_insert_id(); # p $id;
return { id => $id }; # returns from method, not try/catch
}
catch ($e) { # $e either dbix->error or _move_file() error
return { error => $e }; # returns from method, not try/catch
};
}
=begin
method get_categories { my $o = $dbix->select( 'categories', 'description' );
# p $o; $o->column } # column() doesn't work, cannot find method in ::Result
=cut
method get_categories { $dbix->select( 'categories', 'description' )->flat }
method get_all_documents ($category) { # p $category;
my %h;
$h{category} = $category if $category;
$dbix->select( $table, $fields, \%h, { -asc => 'date' } )->hashes;
}
method get_document ($id) {
my $rec = $dbix->select( $table, $fields, { id => $id } )->hash; # p $rec;
return $rec; # returns AoH for template
}
method find_documents ($str) { $log->debug("searching for '$str'"); # Log::Any example
# sqlite3 regexp is case-sensitive, force all fields to lower-case search:
my @conditions = map { +( qq!LOWER($_)! => { -regexp => lc $str } ) }
qw(description category filename comment); # p @conditions;
my %h = ( -or => \@conditions ); # p %where;
my $res = $dbix->select( $table, $fields, \%h, { -asc => 'date' } )->hashes; # p $res;
return $res;
}
# private methods -------------------------------------------------------------
method _requires_file_move ($params) {
# require both 'id' & 'filename' params:
return 0 if grep ! $params->{$_}, qw/id filename/;
my $id = $params->{id};
$dbix->select($table, 'category', { id => $id })->into(my $old_category);
# return 0 if category hasn't changed:
return 0 if $params->{category} eq $old_category;
# add old category to params for file move function:
$params->{_category} = $old_category;
return 1; # signifying requirement fior file move
}
method _move_file ($params) { # p $params;
# param '_category' set in _requires_file_move() if category changed:
my $src_file = catfile( $docs_path, @{$params}{ qw/_category filename/ } ); # p $src_file;
try {
$self->_check_and_set_filepath($params); # p $new_dir;
}
catch ($e) { # warn "_move_file() caught: $e";
die $e; # rethrow error from _check_and_set_filepath()
};
# only get here if try/catch did not set $e
my $res = move( $src_file, $params->{_upload_dir} ); # p $res; # File::Copy method
return $res; # 1 on success, 0 on failure, and sets $!
}
# generates destination directory from docs_path & category, checks if file
# already exists (if so, issues die), otherwise adds '_upload_dir' to params:
method _check_and_set_filepath ($params) {# p $params;
my $filename = $params->{filename};
my $category = $params->{category};
my $directory = catfile($docs_path, $category); # p $directory;
# create new directory if not already exist:
mkdir $directory unless ( -d $directory );
# generate full path to file from docs_path, category & filename:
my $file = catfile($directory, $filename); # p $file;
# check if file already exists and bail if it does:
if ( -e $file ) {
die qq!file "$filename" already exists in "$directory"\n!;
}
# add upload dir to params for file save & move functions:
$params->{_upload_dir} = $directory;
}
1;