From 0b76d16d484371a4c256051ef8c546bc2d0c72be Mon Sep 17 00:00:00 2001 From: Martin Renvoize Date: Tue, 23 Sep 2025 17:26:23 +0100 Subject: [PATCH] Bug 38489: Add rename_file method to transport system and Local transport class This patch enhances the file transport system with file renaming capabilities and adds a Local transport class for development/testing. Changes: - Add rename_file() method to base Transport class and SFTP/FTP subclasses - Create Koha::File::Transport::Local for local directory operations - Add 'local' transport type to polymorphic mapping - Update transport instantiation to handle Local transport - Add Local transport tests to verify polymorphic behavior - Enhanced connect() method for Local transport validates directories The rename_file functionality is needed for EDI file processing workflow where files are renamed after download to mark them as processed. Sponsored-by: ByWater Solutions Signed-off-by: Hannah Dunne-Howrie --- Koha/File/Transport.pm | 20 +- Koha/File/Transport/FTP.pm | 26 ++ Koha/File/Transport/Local.pm | 382 ++++++++++++++++++++++++++ Koha/File/Transport/SFTP.pm | 33 +++ Koha/File/Transports.pm | 6 +- t/db_dependent/Koha/File/Transports.t | 21 +- 6 files changed, 484 insertions(+), 4 deletions(-) create mode 100644 Koha/File/Transport/Local.pm diff --git a/Koha/File/Transport.pm b/Koha/File/Transport.pm index 5493556943d..3e9e847b809 100644 --- a/Koha/File/Transport.pm +++ b/Koha/File/Transport.pm @@ -73,7 +73,12 @@ sub store { $self->SUPER::store; # Subclass triggers - my $subclass = $self->transport eq 'sftp' ? 'Koha::File::Transport::SFTP' : 'Koha::File::Transport::FTP'; + my $subclass_map = { + 'sftp' => 'Koha::File::Transport::SFTP', + 'ftp' => 'Koha::File::Transport::FTP', + 'local' => 'Koha::File::Transport::Local', + }; + my $subclass = $subclass_map->{ $self->transport } || 'Koha::File::Transport'; $self = $subclass->_new_from_dbic( $self->_result ); $self->_post_store_trigger; @@ -246,6 +251,19 @@ sub list_files { die "Subclass must implement list_files"; } +=head3 rename_file + + my $success = $transport->rename_file($old_name, $new_name); + +Method for renaming a file on the current file server + +=cut + +sub rename_file { + my ( $self, $old_name, $new_name ) = @_; + die "Subclass must implement rename_file"; +} + =head3 _post_store_trigger $server->_post_store_trigger; diff --git a/Koha/File/Transport/FTP.pm b/Koha/File/Transport/FTP.pm index c2a44399b3a..0bc23eee278 100644 --- a/Koha/File/Transport/FTP.pm +++ b/Koha/File/Transport/FTP.pm @@ -162,6 +162,32 @@ sub list_files { return $file_list; } +=head3 rename_file + + my $success = $server->rename_file($old_name, $new_name); + +Renames a file on the server connection. + +Returns true on success or undefined on failure. + +=cut + +sub rename_file { + my ( $self, $old_name, $new_name ) = @_; + + $self->{connection}->rename( $old_name, $new_name ) or return $self->_abort_operation(); + + $self->add_message( + { + message => "File rename succeeded", + type => 'success', + payload => { detail => "$old_name -> $new_name" } + } + ); + + return 1; +} + sub _abort_operation { my ( $self, $message ) = @_; diff --git a/Koha/File/Transport/Local.pm b/Koha/File/Transport/Local.pm new file mode 100644 index 00000000000..058980f3db8 --- /dev/null +++ b/Koha/File/Transport/Local.pm @@ -0,0 +1,382 @@ +package Koha::File::Transport::Local; + +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . + +use Modern::Perl; +use File::Copy qw( copy move ); +use File::Spec; +use IO::Dir; + +use base qw(Koha::File::Transport); + +=head1 NAME + +Koha::File::Transport::Local - Local file system implementation of file transport + +=head2 Class methods + +=head3 connect + + my $success = $self->connect; + +Validates that the configured directories exist and have appropriate permissions. + +=cut + +sub connect { + my ($self) = @_; + my $operation = "connection"; + + # Check download directory if configured + if ( my $download_dir = $self->download_directory ) { + unless ( -d $download_dir ) { + $self->add_message( + { + message => $operation, + type => 'error', + payload => { + error => "Download directory does not exist: $download_dir", + path => $download_dir + } + } + ); + return; + } + + unless ( -r $download_dir ) { + $self->add_message( + { + message => $operation, + type => 'error', + payload => { + error => "Download directory is not readable: $download_dir", + path => $download_dir + } + } + ); + return; + } + } + + # Check upload directory if configured + if ( my $upload_dir = $self->upload_directory ) { + unless ( -d $upload_dir ) { + $self->add_message( + { + message => $operation, + type => 'error', + payload => { + error => "Upload directory does not exist: $upload_dir", + path => $upload_dir + } + } + ); + return; + } + + unless ( -w $upload_dir ) { + $self->add_message( + { + message => $operation, + type => 'error', + payload => { + error => "Upload directory is not writable: $upload_dir", + path => $upload_dir + } + } + ); + return; + } + } + + $self->add_message( + { + message => $operation, + type => 'success', + payload => { + status => 'connected', + download_directory => $self->download_directory, + upload_directory => $self->upload_directory + } + } + ); + + return 1; +} + +=head3 upload_file + + my $success = $transport->upload_file($local_file, $remote_file); + +Copies a local file to the upload directory. + +Returns true on success or undefined on failure. + +=cut + +sub upload_file { + my ( $self, $local_file, $remote_file ) = @_; + my $operation = "upload"; + + my $upload_dir = $self->upload_directory || $self->{current_directory} || '.'; + my $destination = File::Spec->catfile( $upload_dir, $remote_file ); + + unless ( copy( $local_file, $destination ) ) { + $self->add_message( + { + message => $operation, + type => 'error', + payload => { + error => $!, + path => $destination + } + } + ); + return; + } + + $self->add_message( + { + message => $operation, + type => 'success', + payload => { path => $destination } + } + ); + + return 1; +} + +=head3 download_file + + my $success = $transport->download_file($remote_file, $local_file); + +Copies a file from the download directory to a local file. + +Returns true on success or undefined on failure. + +=cut + +sub download_file { + my ( $self, $remote_file, $local_file ) = @_; + my $operation = 'download'; + + my $download_dir = $self->download_directory || $self->{current_directory} || '.'; + my $source = File::Spec->catfile( $download_dir, $remote_file ); + + unless ( -f $source ) { + $self->add_message( + { + message => $operation, + type => 'error', + payload => { + error => "File not found: $source", + path => $source + } + } + ); + return; + } + + unless ( copy( $source, $local_file ) ) { + $self->add_message( + { + message => $operation, + type => 'error', + payload => { + error => $!, + path => $source + } + } + ); + return; + } + + $self->add_message( + { + message => $operation, + type => 'success', + payload => { path => $source } + } + ); + + return 1; +} + +=head3 change_directory + + my $success = $server->change_directory($directory); + +Sets the current working directory for file operations. + +Returns true on success or undefined on failure. + +=cut + +sub change_directory { + my ( $self, $remote_directory ) = @_; + my $operation = 'change_directory'; + + # For local file transport, we just track the current directory + if ( $remote_directory && !-d $remote_directory ) { + $self->add_message( + { + message => $operation, + type => 'error', + payload => { + error => "Directory not found: $remote_directory", + path => $remote_directory + } + } + ); + return; + } + + $self->{current_directory} = $remote_directory; + + $self->add_message( + { + message => $operation, + type => 'success', + payload => { path => $remote_directory } + } + ); + + return 1; +} + +=head3 list_files + + my @files = $server->list_files; + +Returns an array of filenames found in the current directory. + +=cut + +sub list_files { + my ($self) = @_; + my $operation = "list"; + + my $directory = $self->download_directory || $self->{current_directory} || '.'; + + unless ( -d $directory ) { + $self->add_message( + { + message => $operation, + type => 'error', + payload => { + error => "Directory not found: $directory", + path => $directory + } + } + ); + return; + } + + my $dir_handle = IO::Dir->new($directory); + unless ($dir_handle) { + $self->add_message( + { + message => $operation, + type => 'error', + payload => { + error => "Cannot open directory: $!", + path => $directory + } + } + ); + return; + } + + my @files; + while ( defined( my $file = $dir_handle->read ) ) { + next if $file =~ /^\.\.?$/; # Skip . and .. + next unless -f File::Spec->catfile( $directory, $file ); # Only files + push @files, $file; + } + $dir_handle->close; + + $self->add_message( + { + message => $operation, + type => 'success', + payload => { + path => $directory, + count => scalar @files + } + } + ); + + return \@files; +} + +=head3 rename_file + + my $success = $server->rename_file($old_name, $new_name); + +Renames a file in the current directory. + +Returns true on success or undefined on failure. + +=cut + +sub rename_file { + my ( $self, $old_name, $new_name ) = @_; + my $operation = "rename"; + + my $directory = $self->download_directory || $self->{current_directory} || '.'; + my $old_path = File::Spec->catfile( $directory, $old_name ); + my $new_path = File::Spec->catfile( $directory, $new_name ); + + unless ( -f $old_path ) { + $self->add_message( + { + message => $operation, + type => 'error', + payload => { + error => "File not found: $old_path", + path => $old_path + } + } + ); + return; + } + + unless ( move( $old_path, $new_path ) ) { + $self->add_message( + { + message => $operation, + type => 'error', + payload => { + error => $!, + path => "$old_path -> $new_path" + } + } + ); + return; + } + + $self->add_message( + { + message => $operation, + type => 'success', + payload => { path => "$old_path -> $new_path" } + } + ); + + return 1; +} + +1; diff --git a/Koha/File/Transport/SFTP.pm b/Koha/File/Transport/SFTP.pm index 2fb8ed569d5..f7ffe19577e 100644 --- a/Koha/File/Transport/SFTP.pm +++ b/Koha/File/Transport/SFTP.pm @@ -198,6 +198,39 @@ sub list_files { return $file_list; } +=head3 rename_file + + my $success = $server->rename_file($old_name, $new_name); + +Renames a file on the server connection. + +Returns true on success or undefined on failure. + +=cut + +sub rename_file { + my ( $self, $old_name, $new_name ) = @_; + my $operation = "rename"; + + $self->{connection}->rename( $old_name, $new_name ) + or return $self->_abort_operation( $operation, "$old_name -> $new_name" ); + + $self->add_message( + { + message => $operation, + type => 'success', + payload => { + status => $self->{connection}->status, + error => $self->{connection}->error, + path => $self->{connection}->cwd, + detail => "$old_name -> $new_name" + } + } + ); + + return 1; +} + =head2 Internal methods =head3 _post_store_trigger diff --git a/Koha/File/Transports.pm b/Koha/File/Transports.pm index 2c6475bdc35..0e710bdc74a 100644 --- a/Koha/File/Transports.pm +++ b/Koha/File/Transports.pm @@ -22,6 +22,7 @@ use Koha::Exceptions; use Koha::File::Transport::SFTP; use Koha::File::Transport::FTP; +use Koha::File::Transport::Local; use base qw(Koha::Objects); @@ -61,8 +62,9 @@ Return the mapping for field value to class name for the polymorphic class sub _polymorphic_map { return { - sftp => 'Koha::File::Transport::SFTP', - ftp => 'Koha::File::Transport::FTP', + sftp => 'Koha::File::Transport::SFTP', + ftp => 'Koha::File::Transport::FTP', + local => 'Koha::File::Transport::Local', }; } diff --git a/t/db_dependent/Koha/File/Transports.t b/t/db_dependent/Koha/File/Transports.t index a42dcd8df8e..928c48423f0 100755 --- a/t/db_dependent/Koha/File/Transports.t +++ b/t/db_dependent/Koha/File/Transports.t @@ -29,7 +29,7 @@ my $schema = Koha::Database->new->schema; my $builder = t::lib::TestBuilder->new; subtest 'Polymorphic object creation' => sub { - plan tests => 4; + plan tests => 6; $schema->storage->txn_begin; @@ -71,6 +71,25 @@ subtest 'Polymorphic object creation' => sub { can_ok( $ftp_transport, 'connect' ); + # Test Local transport polymorphism + my $local_transport = $builder->build_object( + { + class => 'Koha::File::Transports', + value => { + transport => 'local', + name => 'Test Local', + host => 'localhost', + } + } + ); + + is( + ref($local_transport), 'Koha::File::Transport::Local', + 'Local transport should be polymorphic Koha::File::Transport::Local object' + ); + + can_ok( $local_transport, 'rename_file' ); + $schema->storage->txn_rollback; }; -- 2.51.0