From: pcanterino <> Date: Wed, 5 Jan 2011 18:37:06 +0000 (+0000) Subject: - Added some more archive types X-Git-Tag: version_3_2~12 X-Git-Url: https://git.p6c8.net/devedit.git/commitdiff_plain/77fef5e4b082959ff9154a3622c1f5406dea6d3b - Added some more archive types - Show the error returned by Archive::Extract (oh God, I hate this solution...) --- diff --git a/errors.conf b/errors.conf index 7da9eca..291f926 100644 --- a/errors.conf +++ b/errors.conf @@ -49,7 +49,7 @@ remove_root = You are not allowed to remove the root directory. rename_failed = Could not move/rename '{FILE}' to '{NEW_FILE}'. rename_root = You are not allowed to move/rename the root directory. text_to_binary = You are not allowed to write text data into a binary file. -unpack_failed = Unpacking of archive file '{FILE}' failed. +unpack_failed = Unpacking of archive file '{FILE}' failed.

Archive::Extract returned the following error:
{AE_ERROR} unpack_no_dir = You cannot unpack archive file '{FILE}' to an ordinary file or a symbolic ('{NEW_FILE}' is not a directory). # End of configuration file \ No newline at end of file diff --git a/modules/Command.pm b/modules/Command.pm index 2a8ceb9..7a1e9b7 100644 --- a/modules/Command.pm +++ b/modules/Command.pm @@ -6,7 +6,7 @@ package Command; # Execute Dev-Editor's commands # # Author: Patrick Canterino -# Last modified: 2010-12-31 +# Last modified: 2011-01-05 # # Copyright (C) 1999-2000 Roland Bluethgen, Frank Schoenmann # Copyright (C) 2003-2009 Patrick Canterino @@ -672,7 +672,7 @@ sub exec_unpack($$) my $return_unpack = archive_unpack($physical,$new_physical); - return error($config->{'errors'}->{'unpack_failed'},$dir,{FILE => encode_html($virtual), AE_ERROR => ''}) unless($return_unpack); + return error($config->{'errors'}->{'unpack_failed'},$dir,{FILE => encode_html($virtual), AE_ERROR => encode_html($File::Access::archive_extract_error)}) unless($return_unpack); return devedit_reload({command => 'show', file => $new_virtual}); } diff --git a/modules/File/Access.pm b/modules/File/Access.pm index 5e5cca1..c6b1d60 100644 --- a/modules/File/Access.pm +++ b/modules/File/Access.pm @@ -7,7 +7,7 @@ package File::Access; # using only one command # # Author: Patrick Canterino -# Last modified: 2010-12-27 +# Last modified: 2011-01-05 # # Copyright (C) 1999-2000 Roland Bluethgen, Frank Schoenmann # Copyright (C) 2003-2009 Patrick Canterino @@ -22,7 +22,8 @@ use strict; use vars qw(@EXPORT $has_flock - $has_archive_extract); + $has_archive_extract + $archive_extract_error); use Fcntl qw(:DEFAULT :flock); @@ -84,11 +85,27 @@ sub archive_unpack($;$) if($path) { - return $ae->extract(to => $path); + if($ae->extract(to => $path)) + { + return 1; + } + else + { + $archive_extract_error = $ae->error; + return; + } } else { - return $ae->extract; + if($ae->extract) + { + return 1; + } + else + { + $archive_extract_error = $ae->error; + return; + } } } diff --git a/modules/Tool.pm b/modules/Tool.pm index 4dc6fa2..49f255b 100644 --- a/modules/Tool.pm +++ b/modules/Tool.pm @@ -6,7 +6,7 @@ package Tool; # Some shared sub routines # # Author: Patrick Canterino -# Last modified: 2010-12-23 +# Last modified: 2011-01-05 # # Copyright (C) 1999-2000 Roland Bluethgen, Frank Schoenmann # Copyright (C) 2003-2009 Patrick Canterino @@ -48,7 +48,10 @@ use base qw(Exporter); multi_string upper_path); -my @archive_exts = ('.zip', 'tar.gz', 'tar.bz2'); +my @archive_exts = ('.zip', '.tar', '.gz', + '.tar.gz', '.tgz', '.bz2', + '.tar.bz2', '.tbz', '.tbz2', + '.Z'); # check_path() #