diff --git a/Koha/File/Transport.pm b/Koha/File/Transport.pm index 188aaa1ec8e..6f57b6cd179 100644 --- a/Koha/File/Transport.pm +++ b/Koha/File/Transport.pm @@ -251,6 +251,19 @@ sub list_files { die "Subclass must implement list_files"; } +=head3 delete_file + + my $success = $transport->delete_file($filename); + +Method for deleting a file from the current file server + +=cut + +sub delete_file { + my ( $self, $remote_file ) = @_; + die "Subclass must implement delete_file"; +} + =head3 rename_file my $success = $transport->rename_file($old_name, $new_name); diff --git a/Koha/File/Transport/FTP.pm b/Koha/File/Transport/FTP.pm index f965ebd0ede..ba77f46e244 100644 --- a/Koha/File/Transport/FTP.pm +++ b/Koha/File/Transport/FTP.pm @@ -207,6 +207,34 @@ sub list_files { return \@file_list; } +=head3 delete_file + + my $success = $server->delete_file($filename); + +Deletes a file on the server connection. + +Returns true on success or undefined on failure. + +=cut + +sub delete_file { + my ( $self, $remote_file ) = @_; + my $operation = "delete"; + + $self->{connection}->delete($remote_file) + or return $self->_abort_operation($operation); + + $self->add_message( + { + message => $operation, + type => 'success', + payload => { remote_file => $remote_file } + } + ); + + return 1; +} + =head3 rename_file my $success = $server->rename_file($old_name, $new_name); diff --git a/Koha/File/Transport/Local.pm b/Koha/File/Transport/Local.pm index 729a7f4a13b..1d39bd69f77 100644 --- a/Koha/File/Transport/Local.pm +++ b/Koha/File/Transport/Local.pm @@ -340,6 +340,68 @@ sub list_files { return \@files; } +=head3 delete_file + + my $success = $server->delete_file($remote_file); + +Deletes a file in the current directory. + +Returns true on success or undefined on failure. + +=cut + +sub delete_file { + my ( $self, $remote_file ) = @_; + my $operation = 'delete'; + + my $base_directory = $self->{current_directory} + || $self->download_directory + || $self->upload_directory + || '.'; + + my $target_path = File::Spec->file_name_is_absolute($remote_file) + ? $remote_file + : File::Spec->catfile( $base_directory, $remote_file ); + + unless ( -f $target_path ) { + $self->add_message( + { + message => $operation, + type => 'error', + payload => { + error => "File not found: $target_path", + path => $target_path + } + } + ); + return; + } + + unless ( unlink $target_path ) { + $self->add_message( + { + message => $operation, + type => 'error', + payload => { + error => $!, + path => $target_path + } + } + ); + return; + } + + $self->add_message( + { + message => $operation, + type => 'success', + payload => { path => $target_path } + } + ); + + return 1; +} + =head3 rename_file my $success = $server->rename_file($old_name, $new_name); diff --git a/Koha/File/Transport/SFTP.pm b/Koha/File/Transport/SFTP.pm index d0abdd69d3a..9d93d2999ca 100644 --- a/Koha/File/Transport/SFTP.pm +++ b/Koha/File/Transport/SFTP.pm @@ -199,6 +199,39 @@ sub list_files { return $file_list; } +=head3 delete_file + + my $success = $transport->delete_file($filename); + +Deletes a file on the server connection. + +Returns true on success or undefined on failure. + +=cut + +sub delete_file { + my ( $self, $remote_file ) = @_; + my $operation = 'delete'; + + $self->{connection}->remove($remote_file) + or return $self->_abort_operation( $operation, $remote_file ); + + $self->add_message( + { + message => $operation, + type => 'success', + payload => { + status => $self->{connection}->status, + error => $self->{connection}->error, + path => $self->{connection}->cwd, + detail => $remote_file + } + } + ); + + return 1; +} + =head3 rename_file my $success = $server->rename_file($old_name, $new_name); diff --git a/ed -n 200,400p b/ed -n 200,400p new file mode 100644 index 00000000000..66a51857700 --- /dev/null +++ b/ed -n 200,400p @@ -0,0 +1,274 @@ +diff --git a/Koha/File/Transport.pm b/Koha/File/Transport.pm +index 188aaa1ec8..6f57b6cd17 100644 +--- a/Koha/File/Transport.pm ++++ b/Koha/File/Transport.pm +@@ -251,6 +251,19 @@ sub list_files { + die "Subclass must implement list_files"; + } +  ++=head3 delete_file ++ ++ my $success = $transport->delete_file($filename); ++ ++Method for deleting a file from the current file server ++ ++=cut ++ ++sub delete_file { ++ my ( $self, $remote_file ) = @_; ++ die "Subclass must implement delete_file"; ++} ++ + =head3 rename_file +  + my $success = $transport->rename_file($old_name, $new_name); +diff --git a/Koha/File/Transport/FTP.pm b/Koha/File/Transport/FTP.pm +index f965ebd0ed..ba77f46e24 100644 +--- a/Koha/File/Transport/FTP.pm ++++ b/Koha/File/Transport/FTP.pm +@@ -207,6 +207,34 @@ sub list_files { + return \@file_list; + } +  ++=head3 delete_file ++ ++ my $success = $server->delete_file($filename); ++ ++Deletes a file on the server connection. ++ ++Returns true on success or undefined on failure. ++ ++=cut ++ ++sub delete_file { ++ my ( $self, $remote_file ) = @_; ++ my $operation = "delete"; ++ ++ $self->{connection}->delete($remote_file) ++ or return $self->_abort_operation($operation); ++ ++ $self->add_message( ++ { ++ message => $operation, ++ type => 'success', ++ payload => { remote_file => $remote_file } ++ } ++ ); ++ ++ return 1; ++} ++ + =head3 rename_file +  + my $success = $server->rename_file($old_name, $new_name); +diff --git a/Koha/File/Transport/Local.pm b/Koha/File/Transport/Local.pm +index 729a7f4a13..1d39bd69f7 100644 +--- a/Koha/File/Transport/Local.pm ++++ b/Koha/File/Transport/Local.pm +@@ -340,6 +340,68 @@ sub list_files { + return \@files; + } +  ++=head3 delete_file ++ ++ my $success = $server->delete_file($remote_file); ++ ++Deletes a file in the current directory. ++ ++Returns true on success or undefined on failure. ++ ++=cut ++ ++sub delete_file { ++ my ( $self, $remote_file ) = @_; ++ my $operation = 'delete'; ++ ++ my $base_directory = $self->{current_directory} ++ || $self->download_directory ++ || $self->upload_directory ++ || '.'; ++ ++ my $target_path = File::Spec->file_name_is_absolute($remote_file) ++ ? $remote_file ++ : File::Spec->catfile( $base_directory, $remote_file ); ++ ++ unless ( -f $target_path ) { ++ $self->add_message( ++ { ++ message => $operation, ++ type => 'error', ++ payload => { ++ error => "File not found: $target_path", ++ path => $target_path ++ } ++ } ++ ); ++ return; ++ } ++ ++ unless ( unlink $target_path ) { ++ $self->add_message( ++ { ++ message => $operation, ++ type => 'error', ++ payload => { ++ error => $!, ++ path => $target_path ++ } ++ } ++ ); ++ return; ++ } ++ ++ $self->add_message( ++ { ++ message => $operation, ++ type => 'success', ++ payload => { path => $target_path } ++ } ++ ); ++ ++ return 1; ++} ++ + =head3 rename_file +  + my $success = $server->rename_file($old_name, $new_name); +diff --git a/Koha/File/Transport/SFTP.pm b/Koha/File/Transport/SFTP.pm +index d0abdd69d3..9d93d2999c 100644 +--- a/Koha/File/Transport/SFTP.pm ++++ b/Koha/File/Transport/SFTP.pm +@@ -199,6 +199,39 @@ sub list_files { + return $file_list; + } +  ++=head3 delete_file ++ ++ my $success = $transport->delete_file($filename); ++ ++Deletes a file on the server connection. ++ ++Returns true on success or undefined on failure. ++ ++=cut ++ ++sub delete_file { ++ my ( $self, $remote_file ) = @_; ++ my $operation = 'delete'; ++ ++ $self->{connection}->remove($remote_file) ++ or return $self->_abort_operation( $operation, $remote_file ); ++ ++ $self->add_message( ++ { ++ message => $operation, ++ type => 'success', ++ payload => { ++ status => $self->{connection}->status, ++ error => $self->{connection}->error, ++ path => $self->{connection}->cwd, ++ detail => $remote_file ++ } ++ } ++ ); ++ ++ return 1; ++} ++ + =head3 rename_file +  + my $success = $server->rename_file($old_name, $new_name); +diff --git a/t/db_dependent/Koha/File/Transports.t b/t/db_dependent/Koha/File/Transports.t +index 928c48423f..90c6c381eb 100755 +--- a/t/db_dependent/Koha/File/Transports.t ++++ b/t/db_dependent/Koha/File/Transports.t +@@ -17,8 +17,10 @@ +  + use Modern::Perl; +  +-use Test::More tests => 4; ++use Test::More tests => 5; + use Test::NoWarnings; ++use File::Temp qw( tempdir ); ++use File::Spec; +  + use Koha::Database; + use Koha::File::Transports; +@@ -50,7 +52,7 @@ subtest 'Polymorphic object creation' => sub { + 'SFTP transport should be polymorphic Koha::File::Transport::SFTP object' + ); +  +- can_ok( $sftp_transport, '_write_key_file' ); ++ can_ok( $sftp_transport, qw( _write_key_file delete_file ) ); +  + # Test FTP transport polymorphism + my $ftp_transport = $builder->build_object( +@@ -69,7 +71,7 @@ subtest 'Polymorphic object creation' => sub { + 'FTP transport should be polymorphic Koha::File::Transport::FTP object' + ); +  +- can_ok( $ftp_transport, 'connect' ); ++ can_ok( $ftp_transport, qw( connect delete_file ) ); +  + # Test Local transport polymorphism + my $local_transport = $builder->build_object( +@@ -88,7 +90,7 @@ subtest 'Polymorphic object creation' => sub { + 'Local transport should be polymorphic Koha::File::Transport::Local object' + ); +  +- can_ok( $local_transport, 'rename_file' ); ++ can_ok( $local_transport, qw( rename_file delete_file ) ); +  + $schema->storage->txn_rollback; + }; +@@ -137,6 +139,50 @@ subtest 'search() tests' => sub { + $schema->storage->txn_rollback; + }; +  ++subtest 'delete_file() local transport' => sub { ++ plan tests => 6; ++ ++ $schema->storage->txn_begin; ++ ++ my $dir = tempdir( CLEANUP => 1 ); ++ my $file_name = 'test_delete.txt'; ++ my $file_path = File::Spec->catfile( $dir, $file_name ); ++ ++ open my $fh, '>', $file_path or die "Failed to create test file: $!"; ++ print {$fh} "test\n"; ++ close $fh; ++ ++ my $local_transport = $builder->build_object( ++ { ++ class => 'Koha::File::Transports', ++ value => { ++ transport => 'local', ++ name => 'Test Local Delete', ++ download_directory => $dir, ++ upload_directory => $dir, ++ } ++ } ++ ); ++ ++ isa_ok( $local_transport, 'Koha::File::Transport::Local' ); ++ ++ my $result = $local_transport->delete_file($file_name); ++ ok( $result, 'delete_file returns true on success' ); ++ ok( !-e $file_path, 'File removed from filesystem' ); ++ ++ my @messages = @{ $local_transport->object_messages }; ++ my @success_messages = grep { $_->message eq 'delete' && $_->type eq 'success' } @messages; ++ is( scalar @success_messages, 1, 'Success message recorded' ); ++ ++ my $missing = $local_transport->delete_file('nonexistent.txt'); ++ ok( !defined $missing, 'delete_file returns undef for missing file' ); ++ ++ my @error_messages = grep { $_->message eq 'delete' && $_->type eq 'error' } @{ $local_transport->object_messages }; ++ ok( @error_messages, 'Error message recorded for missing file' ); ++ ++ $schema->storage->txn_rollback; ++}; ++ + subtest 'find() tests' => sub { + plan tests => 2; +  diff --git a/t/db_dependent/Koha/File/Transports.t b/t/db_dependent/Koha/File/Transports.t index 928c48423f0..90c6c381eb3 100755 --- a/t/db_dependent/Koha/File/Transports.t +++ b/t/db_dependent/Koha/File/Transports.t @@ -17,8 +17,10 @@ use Modern::Perl; -use Test::More tests => 4; +use Test::More tests => 5; use Test::NoWarnings; +use File::Temp qw( tempdir ); +use File::Spec; use Koha::Database; use Koha::File::Transports; @@ -50,7 +52,7 @@ subtest 'Polymorphic object creation' => sub { 'SFTP transport should be polymorphic Koha::File::Transport::SFTP object' ); - can_ok( $sftp_transport, '_write_key_file' ); + can_ok( $sftp_transport, qw( _write_key_file delete_file ) ); # Test FTP transport polymorphism my $ftp_transport = $builder->build_object( @@ -69,7 +71,7 @@ subtest 'Polymorphic object creation' => sub { 'FTP transport should be polymorphic Koha::File::Transport::FTP object' ); - can_ok( $ftp_transport, 'connect' ); + can_ok( $ftp_transport, qw( connect delete_file ) ); # Test Local transport polymorphism my $local_transport = $builder->build_object( @@ -88,7 +90,7 @@ subtest 'Polymorphic object creation' => sub { 'Local transport should be polymorphic Koha::File::Transport::Local object' ); - can_ok( $local_transport, 'rename_file' ); + can_ok( $local_transport, qw( rename_file delete_file ) ); $schema->storage->txn_rollback; }; @@ -137,6 +139,50 @@ subtest 'search() tests' => sub { $schema->storage->txn_rollback; }; +subtest 'delete_file() local transport' => sub { + plan tests => 6; + + $schema->storage->txn_begin; + + my $dir = tempdir( CLEANUP => 1 ); + my $file_name = 'test_delete.txt'; + my $file_path = File::Spec->catfile( $dir, $file_name ); + + open my $fh, '>', $file_path or die "Failed to create test file: $!"; + print {$fh} "test\n"; + close $fh; + + my $local_transport = $builder->build_object( + { + class => 'Koha::File::Transports', + value => { + transport => 'local', + name => 'Test Local Delete', + download_directory => $dir, + upload_directory => $dir, + } + } + ); + + isa_ok( $local_transport, 'Koha::File::Transport::Local' ); + + my $result = $local_transport->delete_file($file_name); + ok( $result, 'delete_file returns true on success' ); + ok( !-e $file_path, 'File removed from filesystem' ); + + my @messages = @{ $local_transport->object_messages }; + my @success_messages = grep { $_->message eq 'delete' && $_->type eq 'success' } @messages; + is( scalar @success_messages, 1, 'Success message recorded' ); + + my $missing = $local_transport->delete_file('nonexistent.txt'); + ok( !defined $missing, 'delete_file returns undef for missing file' ); + + my @error_messages = grep { $_->message eq 'delete' && $_->type eq 'error' } @{ $local_transport->object_messages }; + ok( @error_messages, 'Error message recorded for missing file' ); + + $schema->storage->txn_rollback; +}; + subtest 'find() tests' => sub { plan tests => 2;