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;