|
Lines 20-28
use Modern::Perl;
Link Here
|
| 20 |
|
20 |
|
| 21 |
use Archive::Extract; |
21 |
use Archive::Extract; |
| 22 |
use CGI qw ( -utf8 ); |
22 |
use CGI qw ( -utf8 ); |
| 23 |
use Mojo::UserAgent; |
|
|
| 24 |
use File::Copy; |
23 |
use File::Copy; |
|
|
24 |
use File::Find::Rule; |
| 25 |
use File::Temp; |
25 |
use File::Temp; |
|
|
26 |
use Mojo::UserAgent; |
| 26 |
|
27 |
|
| 27 |
use C4::Context; |
28 |
use C4::Context; |
| 28 |
use C4::Auth; |
29 |
use C4::Auth; |
|
Lines 59-66
if ($plugins_enabled) {
Link Here
|
| 59 |
my $plugins_dir = C4::Context->config("pluginsdir"); |
60 |
my $plugins_dir = C4::Context->config("pluginsdir"); |
| 60 |
$plugins_dir = ref($plugins_dir) eq 'ARRAY' ? $plugins_dir->[0] : $plugins_dir; |
61 |
$plugins_dir = ref($plugins_dir) eq 'ARRAY' ? $plugins_dir->[0] : $plugins_dir; |
| 61 |
|
62 |
|
| 62 |
my $dirname = File::Temp::tempdir( CLEANUP => 1 ); |
63 |
my $temp_dir = File::Temp::tempdir( CLEANUP => 1 ); |
| 63 |
$debug and warn "dirname = $dirname"; |
64 |
$debug and warn "temp_dir = $temp_dir"; |
| 64 |
|
65 |
|
| 65 |
my $filesuffix; |
66 |
my $filesuffix; |
| 66 |
$filesuffix = $1 if $uploadfilename =~ m/(\..+)$/i; |
67 |
$filesuffix = $1 if $uploadfilename =~ m/(\..+)$/i; |
|
Lines 69-75
if ($plugins_enabled) {
Link Here
|
| 69 |
$debug and warn "tempfile = $tempfile"; |
70 |
$debug and warn "tempfile = $tempfile"; |
| 70 |
|
71 |
|
| 71 |
$errors{'NOTKPZ'} = 1 if ( $uploadfilename !~ /\.kpz$/i ); |
72 |
$errors{'NOTKPZ'} = 1 if ( $uploadfilename !~ /\.kpz$/i ); |
| 72 |
$errors{'NOWRITETEMP'} = 1 unless ( -w $dirname ); |
73 |
$errors{'NOWRITETEMP'} = 1 unless ( -w $temp_dir ); |
| 73 |
$errors{'NOWRITEPLUGINS'} = 1 unless ( -w $plugins_dir ); |
74 |
$errors{'NOWRITEPLUGINS'} = 1 unless ( -w $plugins_dir ); |
| 74 |
|
75 |
|
| 75 |
if ( $uploadlocation ) { |
76 |
if ( $uploadlocation ) { |
|
Lines 91-99
if ($plugins_enabled) {
Link Here
|
| 91 |
} |
92 |
} |
| 92 |
|
93 |
|
| 93 |
my $ae = Archive::Extract->new( archive => $tempfile, type => 'zip' ); |
94 |
my $ae = Archive::Extract->new( archive => $tempfile, type => 'zip' ); |
| 94 |
unless ( $ae->extract( to => $plugins_dir ) ) { |
95 |
if ( $ae->extract( to => $temp_dir ) ) { |
| 95 |
warn "ERROR: " . $ae->error; |
96 |
my ( $module ) = sort File::Find::Rule->file()->name( '*.pm' )->in( $temp_dir ); |
|
|
97 |
$module =~ s|^$temp_dir||; # Strip out the temp dir from the start of the path |
| 98 |
$module =~ s|^/||; # Remove the leading slash |
| 99 |
$module =~ s|/|-|g; # Convert the path slashes to dashes |
| 100 |
$module =~ s|\.pm$||; # Remove the file suffix |
| 101 |
$module = lc( $module ); # Convert to all lower case |
| 102 |
$module =~ s|^koha-plugin-||; # Remove the leading 'koha-plugin-', we already know this is a koha plugin ;) |
| 103 |
|
| 104 |
my $module_dir = "$plugins_dir/$module"; |
| 105 |
mkdir( $module_dir ); |
| 106 |
|
| 107 |
unless ( $ae->extract( to => $module_dir ) ) { |
| 108 |
$errors{'UZIPFAIL'} = $uploadfilename; |
| 109 |
} |
| 110 |
} |
| 111 |
else { |
| 96 |
$errors{'UZIPFAIL'} = $uploadfilename; |
112 |
$errors{'UZIPFAIL'} = $uploadfilename; |
|
|
113 |
} |
| 114 |
|
| 115 |
if ( keys %errors ) { |
| 97 |
$template->param( ERRORS => [ \%errors ] ); |
116 |
$template->param( ERRORS => [ \%errors ] ); |
| 98 |
output_html_with_http_headers $input, $cookie, $template->output; |
117 |
output_html_with_http_headers $input, $cookie, $template->output; |
| 99 |
exit; |
118 |
exit; |
| 100 |
- |
|
|