CGI-FileManager
view release on metacpan or search on metacpan
bin/cfm-passwd.pl
bin/cfm-install.pl
lib/CGI/FileManager.pm
lib/CGI/FileManager/Auth.pm
lib/CGI/FileManager/Templates.pm
t/00.load.t
t/002-authentication.t
t/003-main.t
t/004-upload.t
xt/90-pod.t
xt/91-pod-coverage.t
xt/99-critic.t
xt/pod_checker.t
t/lib/CGI/FileManager/Test.pm
# for testing only
dir/data.txt
dir/subdir/somefile.txt
# these files are used as input files that we will upload
local/1.txt
unzip
unzip
rename_form
Rename file form
rename
Rename file
upload_file
Upload a file
create_directory
Create a directory
DEFAULT
To get the default behavior you can write the following code. The module
will use the built in templates to create the pages.
#!/usr/bin/perl -wT
lib/CGI/FileManager.pm view on Meta::CPAN
$self->session_cookie();
}
# modes that can be accessed without a valid session
my @free_modes = qw(login login_process logout about redirect);
my @restricted_modes = qw(
list_dir
change_dir
upload_file
delete_file
create_directory
remove_directory
rename_form
rename
unzip
);
=head2 setup
lib/CGI/FileManager.pm view on Meta::CPAN
#return $self->list_dir;
} else {
# after changing directory people might press back ...
# and then the whole thing can get scread up not only the change directory
# but if they now delete a file that happen to exist both in the current directory
# and in its parent (which is currenly shown in the browser) the file will be deleted
# from the "current directory", I think the only solution is that the user supplies us
# with full (virtual) path name for every action.
# This seems to be easy regarding action on existing files as they are all done by clicking
# on links and the links can contain.
# Regardin upload/create dir and later create file we have to know where should the thing go
# - what does the user think is the current working directory. For such operations we can
# hide the workdir in a hidden field in the form.
#
# In either case we have to make sure the full virtual directory is something the user
# has right to access.
#my $workdir_name = basename $workdir;
#if ($workdir_name eq $dir) {
# return $self->message("Heuristics !");
#} else {
lib/CGI/FileManager.pm view on Meta::CPAN
}
$new = File::Spec->catfile($homedir, $workdir, $new);
if (-d $new) {
$new = File::Spec->catfile($new, $old_name);
}
return $self->_move($old, $new);
}
=head2 upload_file
Upload a file
=cut
sub upload_file {
my $self = shift;
my $q = $self->query;
my $homedir = $self->session->param("homedir");
my $workdir = $self->_untaint_path($q->param("workdir"));
my $upload = CGI::Upload->new();
my $file_name = $upload->file_name('filename');
my $in = $upload->file_handle('filename');
if (ref $in ne "IO::File") {
warn "No file handle in upload ? '$file_name'";
return $self->message("Hmm, strange. Please contact the administrator");
}
if ($file_name =~ /\.\./) {
warn "two dots in upload file ? '$file_name'";
return $self->message("Hmm, we don't recognize this. Please contact the administrator");
}
if ($file_name =~ /^([\w.-]+)$/) {
$file_name = $1;
if (open my $out, ">", File::Spec->catfile($homedir, $workdir,$file_name)) {
my $buff;
while (read $in, $buff, 500) {
print $out $buff;
}
} else {
warn "Could not open local file: '$file_name'";
return $self->message("Could not open local file. Please contact the administrator");
}
} else {
warn "Invalid name for upload file ? '$file_name'";
return $self->message("Hmm, we don't recognize this. Please contact the administrator");
}
$self->list_dir;
}
=head2 create_directory
Create a directory
lib/CGI/FileManager/Templates.pm view on Meta::CPAN
<input type="hidden" name="workdir" value="<TMPL_VAR workdir>">
<input name="dir" size="15"></TD><TD>
<input type="submit" class="mybutton" value="Create Directory">
</form>
</TD></TR>
<TR><TD align="middle" colspan=2><hr></TD></TR>
<TR><TD colspan=2 align="left">
<form method="POST" enctype="multipart/form-data">
<input type="hidden" name="workdir" value="<TMPL_VAR workdir>">
<input type="hidden" name="rm" value="upload_file">
<input type="file" size="16" name="filename" class="choosebutton">
<input type="submit" class="mybutton" value="Upload">
</form>
</TD></TR>
<TR><TD align="middle" colspan=2><hr></TD></TR>
<TR><TD align="right"></TD>
<TD align="left">
<table>
<tr>
local/1.txt view on Meta::CPAN
This file is on the clients computer,
we will upload it to the server
t/004-upload.t view on Meta::CPAN
my $result = $t->cgiapp("/", $cookie);
like($result, qr{Directory Listing});
like($result, qr{data\.txt});
unlike($result, qr{<a href="\?rm=change_dir;workdir=;dir=\.\.">\s*$parent\s*</a>});
like($result, qr{<a href="\?rm=change_dir;workdir=;dir=subdir">\s*subdir\s*</a>});
unlike($result, qr{new_file\.txt});
}
{
ok(not(-f "dir/new_file.txt"), "file is not there yet");
my $result = $t->upload_file("/", $cookie, {rm => "upload_file"}, "local/1.txt", "somename/new_file.txt");
ok((-f "dir/new_file.txt"), "file was uploaded");
like($result, qr{Directory Listing});
like($result, qr{data\.txt});
unlike($result, qr{<a href="\?rm=change_dir;workdir=;dir=\.\.">\s*$parent\s*</a>});
like($result, qr{<a href="\?rm=change_dir;workdir=;dir=subdir">\s*subdir\s*</a>});
like($result, qr{new_file\.txt});
# compare file content !
# test binary files too
}
t/004-upload.t view on Meta::CPAN
}
# create new directory
{
ok(not(-d "dir/folder"), "folder is not there yet");
my $result = $t->cgiapp("/", $cookie, {rm => "create_directory", dir => "folder"});
ok(-d "dir/folder", "folder is already there");
}
# change directory to the new one
# upload a file to the subdirectory
# change back to parent, try to delete child - and fail
# change back to child
# remove uploaded file
# change back to parent
# remove directory
{
my $result = $t->cgiapp("/", $cookie, {rm => "remove_directory", dir => "folder"});
ok(not(-d "dir/folder"), "folder is not there any more");
}
t/lib/CGI/FileManager/Test.pm view on Meta::CPAN
AUTH => {
PASSWD_FILE => $pwfile,
},
TMPL_PATH => "$Bin/../templates",
# ROOT => $self->{root},
},
);
return $webapp->run();
}
sub upload_file {
my ($self, $path_info, $cookie, $params, $original_file, $long_filename_on_client) = @_;
$long_filename_on_client ||= $original_file;
my $binmode = $^O =~ /OS2|VMS|Win|DOS|Cygwin/i;
#### Prepare environment that looks like a CGI environment
my $boundary = "----------9GN0yM260jGW3Pq48BILfC";
open my $fh, "<", "$original_file" or die "Cannot open $original_file\n";
binmode $fh if $binmode;
( run in 1.499 second using v1.01-cache-2.11-cpan-b16cb0d3907 )