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

(-)a/C4/UploadedFiles.pm (-2 / +30 lines)
Lines 55-60 use Modern::Perl; Link Here
55
use Digest::SHA;
55
use Digest::SHA;
56
use Fcntl;
56
use Fcntl;
57
use Encode;
57
use Encode;
58
use File::Basename;
58
59
59
use C4::Context;
60
use C4::Context;
60
61
Lines 192-198 sub UploadFile { Link Here
192
Determine if a entry is dangling.
193
Determine if a entry is dangling.
193
194
194
Returns: 2 == no db entry
195
Returns: 2 == no db entry
195
         1 == no file
196
         1 == no plain file
196
         0 == both a file and db entry.
197
         0 == both a file and db entry.
197
        -1 == N/A (undef id / non-file-upload URL)
198
        -1 == N/A (undef id / non-file-upload URL)
198
199
Lines 250-256 sub DelUploadedFile { Link Here
250
            my $file_path = $file->{filepath};
251
            my $file_path = $file->{filepath};
251
            my $file_deleted = 0;
252
            my $file_deleted = 0;
252
            unless( -f $file_path ) {
253
            unless( -f $file_path ) {
253
                warn "Id $file->{id} is in database but not in filesystem, removing id from database";
254
                warn "Id $file->{id} is in database but no plain file found, removing id from database";
254
                $file_deleted = 1;
255
                $file_deleted = 1;
255
            } else {
256
            } else {
256
                if(unlink $file_path) {
257
                if(unlink $file_path) {
Lines 290-295 sub DelUploadedFile { Link Here
290
    return $retval;
291
    return $retval;
291
}
292
}
292
293
294
=head2 finddirs
295
296
    finddirs looks for writable dirs in the upload path
297
    Build a hierarchy of directories
298
299
=cut
300
301
sub finddirs {
302
    my ( $base ) = @_;
303
    my $found = 0;
304
    my @dirs;
305
    my @files = glob("$base/*");
306
    foreach( @files ) {
307
        if( -d $_ && -w $_ ) {
308
            my $dirname =  $_;
309
            $dirname =~ s/^$base//g;
310
            push @dirs, {
311
                value => $dirname,
312
                name => basename($dirname),
313
                dirs => finddirs($_),
314
            };
315
            $found = 1;
316
        };
317
    }
318
    return \@dirs;
319
}
320
293
=head2 httpheaders
321
=head2 httpheaders
294
322
295
    httpheaders returns http headers for a retrievable upload
323
    httpheaders returns http headers for a retrievable upload
(-)a/cataloguing/value_builder/upload.pl (-60 / +20 lines)
Lines 1-5 Link Here
1
#!/usr/bin/perl
1
#!/usr/bin/perl
2
2
3
# Converted to new plugin style (Bug 6874/See also 13437)
4
3
# This file is part of Koha.
5
# This file is part of Koha.
4
#
6
#
5
# Copyright (C) 2011-2012 BibLibre
7
# Copyright (C) 2011-2012 BibLibre
Lines 19-50 Link Here
19
21
20
use Modern::Perl;
22
use Modern::Perl;
21
use CGI qw/-utf8/;
23
use CGI qw/-utf8/;
22
use File::Basename;
23
24
24
use C4::Auth;
25
use C4::Auth;
25
use C4::Context;
26
use C4::Context;
26
use C4::Output;
27
use C4::Output;
27
use C4::UploadedFiles;
28
use C4::UploadedFiles;
28
29
29
sub plugin_parameters {
30
my $builder = sub {
30
    my ( $dbh, $record, $tagslib, $i, $tabloop ) = @_;
31
    my ( $params ) = @_;
31
    return "";
32
    my $function_name = $params->{id};
32
}
33
34
sub plugin_javascript {
35
    my ( $dbh, $record, $tagslib, $field_number, $tabloop ) = @_;
36
    my $function_name = $field_number;
37
    my $res           = "
33
    my $res           = "
38
    <script type=\"text/javascript\">
34
    <script type=\"text/javascript\">
39
        function Focus$function_name(subfield_managed) {
35
        function Click$function_name(event) {
40
            return 1;
36
            var index = event.data.id;
41
        }
42
43
        function Blur$function_name(subfield_managed) {
44
            return 1;
45
        }
46
47
        function Clic$function_name(index) {
48
            var id = document.getElementById(index).value;
37
            var id = document.getElementById(index).value;
49
            var IsFileUploadUrl=0;
38
            var IsFileUploadUrl=0;
50
            if (id.match(/opac-retrieve-file/)) {
39
            if (id.match(/opac-retrieve-file/)) {
Lines 55-70 sub plugin_javascript { Link Here
55
            }
44
            }
56
            var newin=window.open(\"../cataloguing/plugin_launcher.pl?plugin_name=upload.pl&index=\"+index+\"&id=\"+id+\"&from_popup=0\"+\"&IsFileUploadUrl=\"+IsFileUploadUrl, 'upload', 'width=600,height=400,toolbar=false,scrollbars=no');
45
            var newin=window.open(\"../cataloguing/plugin_launcher.pl?plugin_name=upload.pl&index=\"+index+\"&id=\"+id+\"&from_popup=0\"+\"&IsFileUploadUrl=\"+IsFileUploadUrl, 'upload', 'width=600,height=400,toolbar=false,scrollbars=no');
57
            newin.focus();
46
            newin.focus();
58
59
        }
47
        }
60
    </script>
48
    </script>
61
";
49
";
50
    return $res;
51
};
62
52
63
    return ( $function_name, $res );
53
my $launcher = sub {
64
}
54
    my ( $params ) = @_;
65
55
    my $input = $params->{cgi};
66
sub plugin {
67
    my ($input) = @_;
68
    my $index = $input->param('index');
56
    my $index = $input->param('index');
69
    my $id = $input->param('id');
57
    my $id = $input->param('id');
70
    my $delete = $input->param('delete');
58
    my $delete = $input->param('delete');
Lines 136-147 sub plugin { Link Here
136
            my $dirs_tree = [ {
124
            my $dirs_tree = [ {
137
                name => '/',
125
                name => '/',
138
                value => '/',
126
                value => '/',
139
                dirs => finddirs($upload_path)
127
                dirs => C4::UploadedFiles::finddirs( $upload_path ),
140
            } ];
128
            } ];
141
129
142
            $template->param(
130
            $template->param(
143
                dirs_tree => $dirs_tree,
131
                dirs_tree => $dirs_tree,
144
                filefield => $filefield
132
                filefield => $filefield,
145
            );
133
            );
146
        } else {
134
        } else {
147
            $template->param( error_upload_path_not_configured => 1 );
135
            $template->param( error_upload_path_not_configured => 1 );
Lines 165-211 sub plugin { Link Here
165
    );
153
    );
166
154
167
    output_html_with_http_headers $input, $cookie, $template->output;
155
    output_html_with_http_headers $input, $cookie, $template->output;
168
}
156
};
169
170
# Build a hierarchy of directories
171
sub finddirs {
172
    my $base = shift;
173
    my $upload_path = C4::Context->config('upload_path');
174
    my $found = 0;
175
    my @dirs;
176
    my @files = glob("$base/*");
177
    foreach (@files) {
178
        if (-d $_ and -w $_) {
179
            my $lastdirname = basename($_);
180
            my $dirname =  $_;
181
            $dirname =~ s/^$upload_path//g;
182
            push @dirs, {
183
                value => $dirname,
184
                name => $lastdirname,
185
                dirs => finddirs($_)
186
            };
187
            $found = 1;
188
        };
189
    }
190
    return \@dirs;
191
}
192
157
193
1;
158
return { builder => $builder, launcher => $launcher };
194
159
160
1;
195
161
196
__END__
162
__END__
197
163
198
=head1 upload.pl
164
=head1 upload.pl
199
165
200
This plugin allow to upload files on the server and reference it in a marc
166
This plugin allows to upload files on the server and reference it in a marc
201
field.
167
field.
202
168
203
Two system preference are used:
169
It uses config variable upload_path and pref OPACBaseURL.
204
205
=over 4
206
207
=item * upload_path: the real absolute path where files will be stored
208
209
=item * OPACBaseURL: for building URLs to be stored in MARC
210
170
211
=back
171
=cut
(-)a/t/db_dependent/UploadedFiles.t (-3 / +13 lines)
Lines 1-9 Link Here
1
#!/usr/bin/perl
1
#!/usr/bin/perl
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::CGI::Multipart;
5
use Test::CGI::Multipart;
6
use Test::More tests => 18;
6
use Test::More tests => 20;
7
use Test::Warn;
7
use Test::Warn;
8
8
9
use t::lib::Mocks;
9
use t::lib::Mocks;
Lines 59-61 is(C4::UploadedFiles::GetUploadedFile(), undef, 'GetUploadedFile without paramet Link Here
59
#trivial test for httpheaders
59
#trivial test for httpheaders
60
my @hdrs = C4::UploadedFiles::httpheaders('does_not_matter_yet');
60
my @hdrs = C4::UploadedFiles::httpheaders('does_not_matter_yet');
61
is( @hdrs == 4 && $hdrs[1] =~ /application\/octet-stream/, 1, 'Simple test for httpheaders'); #TODO Will be extended on report 14282
61
is( @hdrs == 4 && $hdrs[1] =~ /application\/octet-stream/, 1, 'Simple test for httpheaders'); #TODO Will be extended on report 14282
62
- 
62
63
#some tests for finddirs
64
my $temp2 = tempdir(CLEANUP => 1);
65
mkdir $temp2.'/A';
66
mkdir $temp2.'/B', oct(400);
67
my $a= C4::UploadedFiles::finddirs( $temp2 );
68
is( @$a == 1, 1, 'Finddir returns correct number of directories' );
69
mkdir $temp2.'/A/AA';
70
mkdir $temp2.'/A/BB';
71
$a= C4::UploadedFiles::finddirs( $temp2 );
72
is( @{$a->[0]->{dirs}} == 2, 1, 'Finddir returns subdirectories' );

Return to bug 6874