From 8ad672c3c8828a367013ff2f84b89a82cb7533b5 Mon Sep 17 00:00:00 2001 From: pcanterino <> Date: Mon, 27 Dec 2010 21:08:50 +0000 Subject: [PATCH 1/1] Added rudimentary support for unpacking archive files using Archive::Extract. It works but needs a lot of fine tuning. --- modules/Command.pm | 47 +++++++++++++++++++++++++++++++++++++- modules/File/Access.pm | 45 +++++++++++++++++++++++++++++++++--- modules/Tool.pm | 24 +++++++++++++++++++ templates.conf | 1 + templates/dirlist_file.htm | 2 +- templates/unpack.htm | 33 ++++++++++++++++++++++++++ 6 files changed, 147 insertions(+), 5 deletions(-) create mode 100644 templates/unpack.htm diff --git a/modules/Command.pm b/modules/Command.pm index 5d0e653..0880c8c 100644 --- a/modules/Command.pm +++ b/modules/Command.pm @@ -46,6 +46,7 @@ my %dispatch = ('show' => \&exec_show, 'mkdir' => \&exec_mkdir, 'mkfile' => \&exec_mkfile, 'upload' => \&exec_upload, + 'unpack' => \&exec_unpack, 'copy' => \&exec_copy, 'rename' => \&exec_rename, 'remove' => \&exec_remove, @@ -212,6 +213,8 @@ sub exec_show($$) $ftpl->parse_if_block('users',$users && -o $phys_path); + $ftpl->parse_if_block('archive',$File::Access::has_archive_extract && is_archive($file)); + $ftpl->parse_if_block('even',($count % 2) == 0); $dirlist .= $ftpl->get_template; @@ -493,7 +496,7 @@ sub exec_mkfile($$) return error($config->{'errors'}->{'file_exists'},$dir,{FILE => $new_virtual}) if(-e $new_physical); file_create($new_physical) or return error($config->{'errors'}->{'mkfile_failed'},$dir,{FILE => $new_virtual}); - + if($data->{'cgi'}->param('edit')) { return devedit_reload({command => 'beginedit', file => $new_virtual}); @@ -630,6 +633,48 @@ sub exec_upload($$) } } +# exec_unpack() +# +# Unpack an archive +# +# Params: 1. Reference to user input hash +# 2. Reference to config hash +# +# Return: Output of the command (Scalar Reference) + +sub exec_unpack($$) +{ + my ($data,$config) = @_; + my $physical = $data->{'physical'}; + my $virtual = $data->{'virtual'}; + my $dir = upper_path($virtual); + my $new_physical = $data->{'new_physical'}; + my $new_virtual = $data->{'new_virtual'}; + my $cgi = $data->{'cgi'}; + + if($new_physical) + { + archive_unpack($physical,$new_physical); + return devedit_reload({command => 'show', file => $new_virtual}); + } + else + { + my $tpl = new Template; + $tpl->read_file($config->{'templates'}->{'unpack'}); + + $tpl->fillin('FILE',encode_html($virtual)); + $tpl->fillin('DIR',encode_html($dir)); + $tpl->fillin('DIR_URL',escape($dir)); + $tpl->fillin('URL',encode_html(equal_url($config->{'httproot'},$virtual))); + $tpl->fillin('SCRIPT',$script); + + my $output = header(-type => 'text/html'); + $output .= $tpl->get_template; + + return \$output; + } +} + # exec_copy() # # Copy a file and return to directory view diff --git a/modules/File/Access.pm b/modules/File/Access.pm index a96dd09..5e5cca1 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: 2005-08-01 +# Last modified: 2010-12-27 # # Copyright (C) 1999-2000 Roland Bluethgen, Frank Schoenmann # Copyright (C) 2003-2009 Patrick Canterino @@ -21,7 +21,8 @@ package File::Access; use strict; use vars qw(@EXPORT - $has_flock); + $has_flock + $has_archive_extract); use Fcntl qw(:DEFAULT :flock); @@ -32,7 +33,8 @@ use File::Copy; use base qw(Exporter); -@EXPORT = qw(dir_copy +@EXPORT = qw(archive_unpack + dir_copy dir_read file_create file_lock @@ -49,10 +51,47 @@ use base qw(Exporter); $has_flock = eval { local $SIG{'__DIE__'}; flock(STDOUT,0); 1 }; +# Check if Archive::Extract is available + +$has_archive_extract = eval { local $SIG{'__DIE__'}; require Archive::Extract; 1 }; + # Predeclaration of dir_copy() sub dir_copy($$); +# archive_unpack() +# +# Unpack an archive +# (archive type must be supported by Archive::Extract) +# +# Params: 1. Archive path +# 2. Path to extract (optional) +# +# Return: - Status code (Boolean) +# - undef if Archive::Extract is not available + +sub archive_unpack($;$) +{ + my ($archive,$path) = @_; + + return undef unless($has_archive_extract); + + return unless(-f $archive); + return if($path && not -d $path); + + my $ae = Archive::Extract->new(archive => $archive); + return unless($ae); + + if($path) + { + return $ae->extract(to => $path); + } + else + { + return $ae->extract; + } +} + # dir_copy() # # Copy a directory diff --git a/modules/Tool.pm b/modules/Tool.pm index e810c8b..4dc6fa2 100644 --- a/modules/Tool.pm +++ b/modules/Tool.pm @@ -40,12 +40,15 @@ use base qw(Exporter); encode_html equal_url file_name + is_archive in_array is_disabled_command is_forbidden_file mode_string multi_string upper_path); + +my @archive_exts = ('.zip', 'tar.gz', 'tar.bz2'); # check_path() # @@ -290,6 +293,27 @@ sub in_array($$) return; } +# is_archive() +# +# Check if a file is an archive +# (currently only by file extension) +# +# Params: Archive file name +# +# Return: Status code (Boolean) + +sub is_archive($) +{ + my $file = shift; + + foreach my $ext(@archive_exts) + { + return 1 if(lc(substr($file,length($file)-length($ext),length($ext))) eq lc($ext)); + } + + return; +} + # is_disabled_command() # # Check if a command is disabled diff --git a/templates.conf b/templates.conf index c287466..e6e197a 100644 --- a/templates.conf +++ b/templates.conf @@ -19,6 +19,7 @@ mkdir = templates/mkdir.htm mkfile = templates/mkfile.htm renamefile = templates/renamefile.htm rmmulti = templates/rmmulti.htm +unpack = templates/unpack.htm upload = templates/upload.htm viewfile = templates/viewfile.htm viewlink = templates/viewlink.htm diff --git a/templates/dirlist_file.htm b/templates/dirlist_file.htm index 4f6192a..8fbbf10 100644 --- a/templates/dirlist_file.htm +++ b/templates/dirlist_file.htm @@ -3,5 +3,5 @@ {SIZE} {DATE}{IF gmt} (GMT){ENDIF} {IF forbidden}{FILE_NAME}{ELSE}{FILE_NAME}{ENDIF} -({IF !forbidden}{IF viewable}View{ELSE}View{ENDIF} | {IF editable}Edit{ELSE}Edit{ENDIF}{IF !link}{IF readable}| Download | Copy{ENDIF}{ENDIF}{IF dir_writeable} | Rename | Delete{ENDIF} |{IF !link}{IF users} Chmod/Chgrp |{ENDIF}{ENDIF} {ENDIF}View in Browser) +({IF !forbidden}{IF viewable}View{ELSE}View{ENDIF} | {IF editable}Edit{ELSE}Edit{ENDIF}{IF !link}{IF readable}| Download {IF archive}| Unpack {ENDIF}| Copy{ENDIF}{ENDIF}{IF dir_writeable} | Rename | Delete{ENDIF} |{IF !link}{IF users} Chmod/Chgrp |{ENDIF}{ENDIF} {ENDIF}View in Browser) diff --git a/templates/unpack.htm b/templates/unpack.htm new file mode 100644 index 0000000..fdab3d0 --- /dev/null +++ b/templates/unpack.htm @@ -0,0 +1,33 @@ + + + + +Unpack file {FILE} + + + + +

Unpack file {FILE}

+ +

(equals {URL})

+ +

Back to {DIR}

+ +
+ +
+ + + +

Unpack file '{FILE}' to:
+

+ +

+
+ +
+ +

About Dev-Editor

+ + \ No newline at end of file -- 2.34.1