Attachment #59350 for bug #17501

View | Details | Raw Unified | Return to bug 17501
Collapse All | Expand All




use Modern::Perl;
use File::Spec;

#use Koha::Database;

use parent qw(Koha::Object);

=head1 NAME


=head1 SYNOPSIS

    use Koha::UploadedFile;

    # store record in uploaded_files
    my $upload = Koha::UploadedFile->new({ [columns and values] });

    # get a file handle on an uploaded_file
    my $fh = $upload->file_handle;

    # get full path
    my $path = $upload->full_path;

    # delete uploaded file
    $upload->delete;

=head1 DESCRIPTION

Allows regular CRUD operations on uploaded_files via Koha::Object / DBIx.

The delete method also takes care of deleting files. The full_path method
returns a fully qualified path for an upload.

Additional methods include: file_handle, httpheaders.

=head1 METHODS



=head3 httpheaders

httpheaders returns http headers for a retrievable upload.

Will be extended by report 14282

=cut



=head3 permanent_directory

Returns root directory for permanent storage

=cut

sub permanent_directory {


=head3 tmp_directory

Returns root directory for temporary storage

=cut

sub temporary_directory {


=head3 getCategories

getCategories returns a list of upload category codes and names

=cut






use Modern::Perl;

#use Koha::Database;
use Koha::UploadedFile;

use parent qw(Koha::Objects);


=head1 SYNOPSIS

    use Koha::UploadedFiles;

    # get one upload
    my $upload01 = Koha::UploadedFiles->find( $id );

    # get some uploads
    my @uploads = Koha::UploadedFiles->search_term({ term => '.mrc' });

    # delete all uploads
    Koha::UploadedFiles->new->delete;

=head1 DESCRIPTION

Allows regular CRUD operations on uploaded_files via Koha::Objects / DBIx.

The delete method also takes care of deleting files. The search_term method
provides a wrapper around search to look for a term in multiple columns.

=head1 METHODS






use Modern::Perl;
use File::Temp qw/ tempdir /;
use Test::More tests => 10;
use Test::Warn;

use Test::MockModule;
use t::lib::Mocks;


my $schema  = Koha::Database->new->schema;
$schema->storage->txn_begin;
my $builder = t::lib::TestBuilder->new;

our $current_upload = 0;
our $uploads = [

$cgimod->mock( 'new' => \&newCGI );

# Start testing
subtest 'Make a fresh start' => sub {
    plan tests => 1;
    test01();
};
subtest 'Test02' => sub {
    plan tests => 5;
    test02();
};
subtest 'Test03' => sub {
    plan tests => 2;
    test03();
};
subtest 'Test04' => sub {
    plan tests => 3;
    test04();
};
subtest 'Test05' => sub {
    plan tests => 6;
    test05();
};
subtest 'Test06' => sub {
    plan tests => 3;
    test06();
};
subtest 'Test07' => sub {
    plan tests => 2;
    test07();
};
subtest 'Test08: allows_add_by' => sub {
    plan tests => 4;
    test08();
};
$schema->storage->txn_rollback;

sub test01 {
    # Delete existing records (for later tests)
    # Passing keep_file suppresses warnings (and does not delete files)
    # Note that your files are not in danger, since we redirected
    # all files to a new empty temp folder
    Koha::UploadedFiles->new->delete({ keep_file => 1 });
    is( Koha::UploadedFiles->count, 0, 'No records left' );
};

subtest 'permanent_directory and temporary_directory' => sub {
    plan tests => 2;

    # Check mocked directories
    is( Koha::UploadedFile->permanent_directory, $tempdir,
        'Check permanent directory' );
    is( Koha::UploadedFile->temporary_directory, $tempdir,
        'Check temporary directory' );
};

subtest 'Add two uploads in category A' => sub {
    plan tests => 9;

    my $upl = Koha::Uploader->new({
        category => $uploads->[$current_upload]->[0]->{cat},

    is( $rec->filename, 'file2', 'Check file name 2' );
    is( $rec->filesize, 8000, 'Check size of file2' );
    is( $rec->public, undef, 'Check public undefined' );
};

subtest 'Add another upload, check file_handle' => sub {
    plan tests => 5;

sub test02 {
    my $upl = Koha::Uploader->new({
        category => $uploads->[$current_upload]->[0]->{cat},
        public => 1,

    $rec->filename( 'doesprobablynotexist' )->store;
    is( $rec->file_handle, undef, 'Sabotage with file handle' );
    $rec->filename( $orgname )->store;
};

subtest 'Add temporary upload' => sub {
    plan tests => 2;

sub test03 {
    my $upl = Koha::Uploader->new({ tmp => 1 }); #temporary
    my $cgi= $upl->cgi;
    is( $upl->count, 1, 'Upload 3 includes one temporary file' );
    my $rec = Koha::UploadedFiles->find( $upl->result );
    is( $rec->uploadcategorycode =~ /_upload$/, 1, 'Check category temp file' );
};

subtest 'Add same file in same category' => sub {
    plan tests => 3;

sub test04 { # Fail on a file already there
    my $upl = Koha::Uploader->new({
        category => $uploads->[$current_upload]->[0]->{cat},
    });

    is( $upl->result, undef, 'Result is undefined' );
    my $e = $upl->err;
    is( $e->{file2}, 1, "Errcode 1 [already exists] reported" );
};

subtest 'Test delete via UploadedFile as well as UploadedFiles' => sub {
    plan tests => 8;

    # add temporary file with same name and contents (file4)
    my $upl = Koha::Uploader->new({ tmp => 1 });
    my $cgi= $upl->cgi;
    is( $upl->count, 1, 'Add duplicate temporary file (file4)' );
    my $id = $upl->result;
    my $path = Koha::UploadedFiles->find( $id )->full_path;


    $delete = $kohaobj->delete;
    is( $delete, $name, 'Delete successful' );
    isnt( -e $path, 1, 'File no longer found after delete' );
}

    # add another record with TestBuilder, so file does not exist
    # catch warning
    my $upload01 = $builder->build({ source => 'UploadedFile' });
    warning_like { Koha::UploadedFiles->find( $upload01->{id} )->delete; }
        qr/file was missing/,
        'delete warns when file is missing';
    is( Koha::UploadedFiles->count, 4, 'Back to four uploads now' );
};

subtest 'Call search_term with[out] private flag' => sub {
    plan tests => 3;

    my @recs = Koha::UploadedFiles->search_term({ term => 'file' });
    is( @recs, 1, 'Returns only one public result' );
    is( $recs[0]->filename, 'file3', 'Should be file3' );

    is( Koha::UploadedFiles->search_term({
        term => 'file', include_private => 1,
    })->count, 4, 'Returns now four results' );
};

subtest 'Simple tests for httpheaders and getCategories' => sub {
    plan tests => 2;

sub test07 { #simple test for httpheaders and getCategories
    my $rec = Koha::UploadedFiles->search_term({ term => 'file' })->next;
    my @hdrs = $rec->httpheaders;
    is( @hdrs == 4 && $hdrs[1] =~ /application\/octet-stream/, 1, 'Simple test for httpheaders');
    my $builder = t::lib::TestBuilder->new;
    $builder->build({ source => 'AuthorisedValue', value => { category => 'UPLOAD', authorised_value => 'HAVE_AT_LEAST_ONE', lib => 'Hi there' } });
    my $cat = Koha::UploadedFile->getCategories;
    is( @$cat >= 1, 1, 'getCategories returned at least one category' );
};

subtest 'Testing allows_add_by' => sub {
    plan tests => 4;

sub test08 { # allows_add_by
    my $builder = t::lib::TestBuilder->new;
    my $patron = $builder->build({
        source => 'Borrower',
        value  => { flags => 0 }, #no permissions

    });
    is( Koha::Uploader->allows_add_by( $patron->{userid} ),
        1, 'Patron is still allowed to add uploaded files' );
}

# Additional tests for Koha::UploadedFiles
# TODO Rearrange the tests after this migration
subtest 'Some basic CRUD testing' => sub {
    plan tests => 2;

    # Test find and attribute id, delete and search
    my $builder = t::lib::TestBuilder->new;
    my $upload01 = $builder->build({ source => 'UploadedFile' });
    my $found = Koha::UploadedFiles->find( $upload01->{id} );
    is( $found->id, $upload01->{id}, 'Koha::Object returns id' );
    $found->delete({ keep_file => 1 }); #note that it does not exist
    $found = Koha::UploadedFiles->search(
        { id => $upload01->{id} },
    );
    is( $found->count, 0, 'Delete seems successful' );
};

# The end
$schema->storage->txn_rollback;

# Helper routine
sub newCGI {
    my ( $class, $hook ) = @_;
    my $read = 0;
- 

Return to bug 17501

Lines 20-27 package Koha::UploadedFile; Link Here

(-)a/Koha/UploadedFile.pm (-7 / +27 lines)
20	use Modern::Perl;	20	use Modern::Perl;
21	use File::Spec;	21	use File::Spec;
22		22
23	#use Koha::Database;
24
25	use parent qw(Koha::Object);	23	use parent qw(Koha::Object);
26		24
27	=head1 NAME	25	=head1 NAME
Lines 30-40 Koha::UploadedFile - Koha::Object class for single uploaded file Link Here
30		28
31	=head1 SYNOPSIS	29	=head1 SYNOPSIS
32		30
33	use Koha::UploadedFile;	31	use Koha::UploadedFile;
		32
		33	# store record in uploaded_files
		34	my $upload = Koha::UploadedFile->new({ [columns and values] });
		35
		36	# get a file handle on an uploaded_file
		37	my $fh = $upload->file_handle;
		38
		39	# get full path
		40	my $path = $upload->full_path;
		41
		42	# delete uploaded file
		43	$upload->delete;
34		44
35	=head1 DESCRIPTION	45	=head1 DESCRIPTION
36		46
37	Description	47	Allows regular CRUD operations on uploaded_files via Koha::Object / DBIx.
		48
		49	The delete method also takes care of deleting files. The full_path method
		50	returns a fully qualified path for an upload.
		51
		52	Additional methods include: file_handle, httpheaders.
38		53
39	=head1 METHODS	54	=head1 METHODS
40		55
Lines 103-110 sub file_handle { Link Here
103		118
104	=head3 httpheaders	119	=head3 httpheaders
105		120
106	httpheaders returns http headers for a retrievable upload	121	httpheaders returns http headers for a retrievable upload.
107	Will be extended by report 14282	122
		123	Will be extended by report 14282
108		124
109	=cut	125	=cut
110		126
Lines 120-125 sub httpheaders { Link Here
120		136
121	=head3 permanent_directory	137	=head3 permanent_directory
122		138
		139	Returns root directory for permanent storage
		140
123	=cut	141	=cut
124		142
125	sub permanent_directory {	143	sub permanent_directory {
Lines 129-134 sub permanent_directory { Link Here
129		147
130	=head3 tmp_directory	148	=head3 tmp_directory
131		149
		150	Returns root directory for temporary storage
		151
132	=cut	152	=cut
133		153
134	sub temporary_directory {	154	sub temporary_directory {
Lines 138-144 sub temporary_directory { Link Here
138		158
139	=head3 getCategories	159	=head3 getCategories
140		160
141	getCategories returns a list of upload category codes and names	161	getCategories returns a list of upload category codes and names
142		162
143	=cut	163	=cut
144		164

Lines 19-25 package Koha::UploadedFiles; Link Here

(-)a/Koha/UploadedFiles.pm (-3 / +14 lines)
19		19
20	use Modern::Perl;	20	use Modern::Perl;
21		21
22	#use Koha::Database;
23	use Koha::UploadedFile;	22	use Koha::UploadedFile;
24		23
25	use parent qw(Koha::Objects);	24	use parent qw(Koha::Objects);
Lines 30-40 Koha::UploadedFiles - Koha::Objects class for uploaded files Link Here
30		29
31	=head1 SYNOPSIS	30	=head1 SYNOPSIS
32		31
33	use Koha::UploadedFiles;	32	use Koha::UploadedFiles;
		33
		34	# get one upload
		35	my $upload01 = Koha::UploadedFiles->find( $id );
		36
		37	# get some uploads
		38	my @uploads = Koha::UploadedFiles->search_term({ term => '.mrc' });
		39
		40	# delete all uploads
		41	Koha::UploadedFiles->new->delete;
34		42
35	=head1 DESCRIPTION	43	=head1 DESCRIPTION
36		44
37	Description	45	Allows regular CRUD operations on uploaded_files via Koha::Objects / DBIx.
		46
		47	The delete method also takes care of deleting files. The search_term method
		48	provides a wrapper around search to look for a term in multiple columns.
38		49
39	=head1 METHODS	50	=head1 METHODS
40		51

Lines 2-8 Link Here

(-)a/t/db_dependent/Upload.t (-71 / +59 lines)
2		2
3	use Modern::Perl;	3	use Modern::Perl;
4	use File::Temp qw/ tempdir /;	4	use File::Temp qw/ tempdir /;
5	use Test::More tests => 9;	5	use Test::More tests => 10;
		6	use Test::Warn;
6		7
7	use Test::MockModule;	8	use Test::MockModule;
8	use t::lib::Mocks;	9	use t::lib::Mocks;
Lines 16-21 use Koha::Uploader; Link Here
16		17
17	my $schema = Koha::Database->new->schema;	18	my $schema = Koha::Database->new->schema;
18	$schema->storage->txn_begin;	19	$schema->storage->txn_begin;
		20	my $builder = t::lib::TestBuilder->new;
19		21
20	our $current_upload = 0;	22	our $current_upload = 0;
21	our $uploads = [	23	our $uploads = [
Lines 50-99 my $cgimod = Test::MockModule->new( 'CGI' ); Link Here
50	$cgimod->mock( 'new' => \&newCGI );	52	$cgimod->mock( 'new' => \&newCGI );
51		53
52	# Start testing	54	# Start testing
53	subtest 'Test01' => sub {	55	subtest 'Make a fresh start' => sub {
54	plan tests => 11;	56	plan tests => 1;
55	test01();
56	};
57	subtest 'Test02' => sub {
58	plan tests => 5;
59	test02();
60	};
61	subtest 'Test03' => sub {
62	plan tests => 2;
63	test03();
64	};
65	subtest 'Test04' => sub {
66	plan tests => 3;
67	test04();
68	};
69	subtest 'Test05' => sub {
70	plan tests => 6;
71	test05();
72	};
73	subtest 'Test06' => sub {
74	plan tests => 3;
75	test06();
76	};
77	subtest 'Test07' => sub {
78	plan tests => 2;
79	test07();
80	};
81	subtest 'Test08: allows_add_by' => sub {
82	plan tests => 4;
83	test08();
84	};
85	$schema->storage->txn_rollback;
86		57
87	sub test01 {
88	# Delete existing records (for later tests)	58	# Delete existing records (for later tests)
89	# Passing keep_file suppresses warnings	59	# Passing keep_file suppresses warnings (and does not delete files)
		60	# Note that your files are not in danger, since we redirected
		61	# all files to a new empty temp folder
90	Koha::UploadedFiles->new->delete({ keep_file => 1 });	62	Koha::UploadedFiles->new->delete({ keep_file => 1 });
		63	is( Koha::UploadedFiles->count, 0, 'No records left' );
		64	};
		65
		66	subtest 'permanent_directory and temporary_directory' => sub {
		67	plan tests => 2;
91		68
92	# Check mocked directories	69	# Check mocked directories
93	is( Koha::UploadedFile->permanent_directory, $tempdir,	70	is( Koha::UploadedFile->permanent_directory, $tempdir,
94	'Check permanent directory' );	71	'Check permanent directory' );
95	is( Koha::UploadedFile->temporary_directory, $tempdir,	72	is( Koha::UploadedFile->temporary_directory, $tempdir,
96	'Check temporary directory' );	73	'Check temporary directory' );
		74	};
		75
		76	subtest 'Add two uploads in category A' => sub {
		77	plan tests => 9;
97		78
98	my $upl = Koha::Uploader->new({	79	my $upl = Koha::Uploader->new({
99	category => $uploads->[$current_upload]->[0]->{cat},	80	category => $uploads->[$current_upload]->[0]->{cat},
Lines 115-123 sub test01 { Link Here
115	is( $rec->filename, 'file2', 'Check file name 2' );	96	is( $rec->filename, 'file2', 'Check file name 2' );
116	is( $rec->filesize, 8000, 'Check size of file2' );	97	is( $rec->filesize, 8000, 'Check size of file2' );
117	is( $rec->public, undef, 'Check public undefined' );	98	is( $rec->public, undef, 'Check public undefined' );
118	}	99	};
		100
		101	subtest 'Add another upload, check file_handle' => sub {
		102	plan tests => 5;
119		103
120	sub test02 {
121	my $upl = Koha::Uploader->new({	104	my $upl = Koha::Uploader->new({
122	category => $uploads->[$current_upload]->[0]->{cat},	105	category => $uploads->[$current_upload]->[0]->{cat},
123	public => 1,	106	public => 1,
Lines 135-151 sub test02 { Link Here
135	$rec->filename( 'doesprobablynotexist' )->store;	118	$rec->filename( 'doesprobablynotexist' )->store;
136	is( $rec->file_handle, undef, 'Sabotage with file handle' );	119	is( $rec->file_handle, undef, 'Sabotage with file handle' );
137	$rec->filename( $orgname )->store;	120	$rec->filename( $orgname )->store;
138	}	121	};
		122
		123	subtest 'Add temporary upload' => sub {
		124	plan tests => 2;
139		125
140	sub test03 {
141	my $upl = Koha::Uploader->new({ tmp => 1 }); #temporary	126	my $upl = Koha::Uploader->new({ tmp => 1 }); #temporary
142	my $cgi= $upl->cgi;	127	my $cgi= $upl->cgi;
143	is( $upl->count, 1, 'Upload 3 includes one temporary file' );	128	is( $upl->count, 1, 'Upload 3 includes one temporary file' );
144	my $rec = Koha::UploadedFiles->find( $upl->result );	129	my $rec = Koha::UploadedFiles->find( $upl->result );
145	is( $rec->uploadcategorycode =~ /_upload$/, 1, 'Check category temp file' );	130	is( $rec->uploadcategorycode =~ /_upload$/, 1, 'Check category temp file' );
146	}	131	};
		132
		133	subtest 'Add same file in same category' => sub {
		134	plan tests => 3;
147		135
148	sub test04 { # Fail on a file already there
149	my $upl = Koha::Uploader->new({	136	my $upl = Koha::Uploader->new({
150	category => $uploads->[$current_upload]->[0]->{cat},	137	category => $uploads->[$current_upload]->[0]->{cat},
151	});	138	});
Lines 154-165 sub test04 { # Fail on a file already there Link Here
154	is( $upl->result, undef, 'Result is undefined' );	141	is( $upl->result, undef, 'Result is undefined' );
155	my $e = $upl->err;	142	my $e = $upl->err;
156	is( $e->{file2}, 1, "Errcode 1 [already exists] reported" );	143	is( $e->{file2}, 1, "Errcode 1 [already exists] reported" );
157	}	144	};
		145
		146	subtest 'Test delete via UploadedFile as well as UploadedFiles' => sub {
		147	plan tests => 8;
158		148
159	sub test05 { # add temporary file with same name and contents, delete it	149	# add temporary file with same name and contents (file4)
160	my $upl = Koha::Uploader->new({ tmp => 1 });	150	my $upl = Koha::Uploader->new({ tmp => 1 });
161	my $cgi= $upl->cgi;	151	my $cgi= $upl->cgi;
162	is( $upl->count, 1, 'Upload 5 adds duplicate temporary file' );	152	is( $upl->count, 1, 'Add duplicate temporary file (file4)' );
163	my $id = $upl->result;	153	my $id = $upl->result;
164	my $path = Koha::UploadedFiles->find( $id )->full_path;	154	my $path = Koha::UploadedFiles->find( $id )->full_path;
165		155
Lines 179-187 sub test05 { # add temporary file with same name and contents, delete it Link Here
179	$delete = $kohaobj->delete;	169	$delete = $kohaobj->delete;
180	is( $delete, $name, 'Delete successful' );	170	is( $delete, $name, 'Delete successful' );
181	isnt( -e $path, 1, 'File no longer found after delete' );	171	isnt( -e $path, 1, 'File no longer found after delete' );
182	}
183		172
184	sub test06 { #search_term with[out] private flag	173	# add another record with TestBuilder, so file does not exist
		174	# catch warning
		175	my $upload01 = $builder->build({ source => 'UploadedFile' });
		176	warning_like { Koha::UploadedFiles->find( $upload01->{id} )->delete; }
		177	qr/file was missing/,
		178	'delete warns when file is missing';
		179	is( Koha::UploadedFiles->count, 4, 'Back to four uploads now' );
		180	};
		181
		182	subtest 'Call search_term with[out] private flag' => sub {
		183	plan tests => 3;
		184
185	my @recs = Koha::UploadedFiles->search_term({ term => 'file' });	185	my @recs = Koha::UploadedFiles->search_term({ term => 'file' });
186	is( @recs, 1, 'Returns only one public result' );	186	is( @recs, 1, 'Returns only one public result' );
187	is( $recs[0]->filename, 'file3', 'Should be file3' );	187	is( $recs[0]->filename, 'file3', 'Should be file3' );
Lines 189-208 sub test06 { #search_term with[out] private flag Link Here
189	is( Koha::UploadedFiles->search_term({	189	is( Koha::UploadedFiles->search_term({
190	term => 'file', include_private => 1,	190	term => 'file', include_private => 1,
191	})->count, 4, 'Returns now four results' );	191	})->count, 4, 'Returns now four results' );
192	}	192	};
		193
		194	subtest 'Simple tests for httpheaders and getCategories' => sub {
		195	plan tests => 2;
193		196
194	sub test07 { #simple test for httpheaders and getCategories
195	my $rec = Koha::UploadedFiles->search_term({ term => 'file' })->next;	197	my $rec = Koha::UploadedFiles->search_term({ term => 'file' })->next;
196	my @hdrs = $rec->httpheaders;	198	my @hdrs = $rec->httpheaders;
197	is( @hdrs == 4 && $hdrs[1] =~ /application\/octet-stream/, 1, 'Simple test for httpheaders');	199	is( @hdrs == 4 && $hdrs[1] =~ /application\/octet-stream/, 1, 'Simple test for httpheaders');
198	my $builder = t::lib::TestBuilder->new;
199	$builder->build({ source => 'AuthorisedValue', value => { category => 'UPLOAD', authorised_value => 'HAVE_AT_LEAST_ONE', lib => 'Hi there' } });	200	$builder->build({ source => 'AuthorisedValue', value => { category => 'UPLOAD', authorised_value => 'HAVE_AT_LEAST_ONE', lib => 'Hi there' } });
200	my $cat = Koha::UploadedFile->getCategories;	201	my $cat = Koha::UploadedFile->getCategories;
201	is( @$cat >= 1, 1, 'getCategories returned at least one category' );	202	is( @$cat >= 1, 1, 'getCategories returned at least one category' );
202	}	203	};
		204
		205	subtest 'Testing allows_add_by' => sub {
		206	plan tests => 4;
203		207
204	sub test08 { # allows_add_by
205	my $builder = t::lib::TestBuilder->new;
206	my $patron = $builder->build({	208	my $patron = $builder->build({
207	source => 'Borrower',	209	source => 'Borrower',
208	value => { flags => 0 }, #no permissions	210	value => { flags => 0 }, #no permissions
Lines 236-260 sub test08 { # allows_add_by Link Here
236	});	238	});
237	is( Koha::Uploader->allows_add_by( $patron->{userid} ),	239	is( Koha::Uploader->allows_add_by( $patron->{userid} ),
238	1, 'Patron is still allowed to add uploaded files' );	240	1, 'Patron is still allowed to add uploaded files' );
239	}
240
241	# Additional tests for Koha::UploadedFiles
242	# TODO Rearrange the tests after this migration
243	subtest 'Some basic CRUD testing' => sub {
244	plan tests => 2;
245
246	# Test find and attribute id, delete and search
247	my $builder = t::lib::TestBuilder->new;
248	my $upload01 = $builder->build({ source => 'UploadedFile' });
249	my $found = Koha::UploadedFiles->find( $upload01->{id} );
250	is( $found->id, $upload01->{id}, 'Koha::Object returns id' );
251	$found->delete({ keep_file => 1 }); #note that it does not exist
252	$found = Koha::UploadedFiles->search(
253	{ id => $upload01->{id} },
254	);
255	is( $found->count, 0, 'Delete seems successful' );
256	};	241	};
257		242
		243	# The end
		244	$schema->storage->txn_rollback;
		245
		246	# Helper routine
258	sub newCGI {	247	sub newCGI {
259	my ( $class, $hook ) = @_;	248	my ( $class, $hook ) = @_;
260	my $read = 0;	249	my $read = 0;
261	-