RSS Git Download  Clone
Raw Blame History
use App::Class; # Import::Into

class Model::DPW;

use File::Copy;
use Data::Printer;
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 $data; # return;
    if ( $data_file ) {
        # capture filename, replace spaces with underscores, non-destructive
        my $filename = $data_file->filename =~ s{\s}{_}gr;
        # category to file document under:
        my $category = $params->{category};
		# upload folder name:
		my $directory = catfile($docs_path, $category); # p $directory;
		# create new dir if not exist:
		mkdir($directory) unless(-d $directory);
        # generate $filepath from docs_path & filename:
        my $filepath = catfile($directory, $filename); # p $filepath;
        # check if it exists and bail if it does:
        if ( -e $filepath ) {
            return { error => qq!file "$filename" already exists! }
        }
        # add filename to params:
        $params->{filename} = $filename;
    } # p $params;

	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;
	# before potential update, determine if file needs moving to new location
	# initialises param '_category' & returns true if filename supplied and 
	# category changed:
	my $requires_file_move = $self->_requires_file_move($params);

    my $result = do { # choice is to capture error, or just die with db error
        try {         #  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) or die $!;
			}
	    	# record id = $params->{id} from record edit, or get last insert:
			my $id = $params->{id} || $dbix->last_insert_id(); # p $id;
            return { id => $id };
        }
        catch ($e) { # dsl->warning $e; # can't do it
            return { error => $e };
        }
    };
	return $result;
}

method get_categories { $dbix->select( 'categories', 'description' )->flat }

method get_all_documents ($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 } )->hashes; # p $rec;
	return $rec; # returns AoH for template
}

method find_documents ($str) {
    # 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;
	my $new_dir  = catfile( $docs_path, $params->{category} ); # p $new_dir;
	# create new dir if not exist:
	mkdir($new_dir) unless(-d $new_dir);
	my $res = move( $src_file, $new_dir ); # p $res; # File::Copy method
	return $res; # 1 on success, 0 on failure, and sets $!
}

1;