view release on metacpan or  search on metacpan

lib/CGI/FileManager.pm  view on Meta::CPAN

				# 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 {
					warn "change_dir: Trying to change to invalid directory ? '$workdir'$dir'";
					return $self->message("It does not seem to be a correct directory. Please contact the administrator");
				#}
			}
		} else {
			warn "change_dir: Bad regex, or bad visitor ? '$dir'";
			return $self->message("Hmm, we don't recognize this. Please contact the administrator");
		}
	}
	
	warn "should never got here....";
	return $self->list_dir;
}

=head2 list_dir

Listing the content of a directory

=cut
sub list_dir {
	my $self = shift;
	my $msgs = shift;

	my $q = $self->query;

	my $workdir = $self->_untaint_path($q->param("workdir"));
	my $homedir = $self->session->param("homedir");
	my $path = File::Spec->catfile($homedir, $workdir);


	my $t = $self->load_tmpl(
			"list_dir",
		 	associate => $q,
			loop_context_vars => 1,
	);
	if (opendir my $dh, $path) {
		my @entries = grep {$_ ne "." and $_ ne ".."} readdir $dh;
		if ($workdir ne "" and $workdir ne "/") {
			unshift @entries, "..";
		}
		my @files;
		
		foreach my $f (@entries) {
			my $full = File::Spec->catfile($path, $f);
			push @files, {
				filename    => $f,
				filetype    => $self->_file_type($full),
				subdir      => -d $full,
				zipfile     => ($full =~ /\.zip/i ? 1 : 0),
				filedate    => scalar (localtime((stat($full))[9])),
				size        => (stat($full))[7],
				delete_link => $f eq ".." ? "" : $self->_delete_link($full),
				rename_link => $f eq ".." ? "" : $self->_rename_link($full),
				workdir     => $workdir,
			};
		}	
		
		$t->param(workdir => $workdir);
		$t->param(files   => \@files);
		$t->param(version => $VERSION);
	}
	$t->param($_ => 1) foreach @$msgs;

	return $t->output;
}

# returns the type of the given file
sub _file_type {
	my ($self, $file) = @_;
	return "dir"  if -d $file;
	return "file" if -f $file;
	return "n/a";
}

sub _delete_link {
	my ($self, $file) = @_;
	return "rm=remove_directory;dir="  if -d $file;
	return "rm=delete_file;filename="  if -f $file;
	return "";
}

sub _rename_link {
	my ($self, $file) = @_;
	return "rm=rename_form;filename="  if -d $file;
	return "rm=rename_form;filename="  if -f $file;
	return "";
}


=head2 delete_file

Delete a file from the server

=cut
sub delete_file {
	my ($self) = @_;
	my $q = $self->query;

	my $filename = $q->param("filename");
	$filename = $self->_untaint($filename);

	if (not $filename) {
		warn "Tainted filename: '" . $q->param("filename") . "'";
		return $self->message("Invalid filename. Please contact the system administrator");
	}
	my $homedir = $self->session->param("homedir");
	my $workdir = $self->_untaint_path($q->param("workdir"));
	
	$filename = File::Spec->catfile($homedir, $workdir, $filename);

	unlink $filename;