Apache-UploadSvr
view release on metacpan or search on metacpan
lib/Apache/UploadSvr.pm view on Meta::CPAN
@dirlisting{@dirlisting} = (" ") x @dirlisting;
my(@chkbox) = split /<BR>/, $cgi->checkbox_group(
-name => 'STAGEDFILES',
'values' => \@dirlisting,
linebreak=>'true',
labels=> \%dirlisting
);
for my $e (0..$#rows) {
push @m, "<TR>";
my @l = @{$rows[$e]};
if ($l[0] eq " ALL") {
push @m, sprintf(
"<TD ALIGN=RIGHT>%s</TD><TD COLSPAN=4>%s</TD>",
$chkbox[$e],
"perform above selected action on all files below"
);
} else {
push @m, sprintf(
qq{<TD ALIGN=RIGHT>%s</TD><TD> %s </TD><TD><A HREF="/STAGE/%s%s">view</A></TD><TD ALIGN=RIGHT> %d </TD><TD> %s </TD>},
$chkbox[$e],
@l[0,1,0,2,3]
);
}
push @m, qq{</TR>};
}
push @m, "</TABLE>";
$file_listing = join "", @m;
} else {
$file_listing = $self->dict("D020");
}
File::Find::finddepth( sub {
return unless -d $_;
rmdir $_; # may fail
}, $stagedir);
$r->content_type("text/html");
$r->send_http_header;
my(@m);
push @m, $cgi->start_html(
-title => $self->dict("D021"),
author => 'andreas.koenig@kulturbox.de'
);
if ($time - $userref->{lastlogin} > 7200) {
push @m, $self->hello;
}
$userref->{lastlogin} = $time;
if ($what_we_did) {
unless ( $what_we_did =~ /^<TABLE/ ) {
$what_we_did =~ s/^/<TABLE BORDER=2><TR><TD>/;
$what_we_did =~ s|$|</TD></TR></TABLE>|;
}
} else {
$what_we_did = "<HR>";
}
push @m, $what_we_did;
push @m, $self->upload_form;
push @m, qq{<HR><H4>Delete, Unzip, Publish, etc.</H4>};
push @m, $file_listing;
push @m, "<HR>";
# push @m, $self->as_string;
push @m, $cgi->endform;
push @m, $cgi->end_html;
$cgi->print(@m);
}
sub secure_transaction {
my($self,$sectrans) = @_;
my $r = $self->{R}; # attn: Directory.pm calls this with a different $self
my($userref) = $self->{USERREF};
my($what_we_did);
my $script_name = $r->dir_config("Apache_UploadSvr_myuri");
unless ($script_name) {
# script_name may be different from this script_name
$script_name = $r->path_info ?
substr($r->uri, 0, length($r->uri)-length($r->path_info)) :
$r->uri;
}
my $me_url = URI::URL->new(
"http://" .
$r->server->server_hostname .
$script_name)->as_string;
my $secret = 100000 + int rand 900000;
my $secretfile;
my $transdir = $r->dir_config('Apache_UploadSvr_transdir');
unless ($transdir) {
$r->log_error("No Apache_UploadSvr_transdir specified. Setting to /tmp");
$transdir = "/tmp";
}
$secret++ while -f ($secretfile = "$transdir/$userref->{user}$secret");
my $fh = IO::File->new(">$secretfile") or
die "Couldn't create secretfile $secretfile: $!";
my $plural = split(/\n/, $sectrans) > 1;
my $mailtext = join("\n",
$self->dict($plural ? "D025" : "D024"),
$sectrans,
$self->dict("D026"),
" $me_url?SUBMITtrans=$secret",
);
$fh->print($sectrans);
$fh->close;
my($msg) = Mail::Send
->new(
"Subject" => $self->dict("D027"),
"To" => qq{"$userref->{fullname}" <$userref->{email}>}
);
my $from = $r->dir_config("Apache_UploadSvr_from");
$msg->add("From",$from) if $from;
my $sendh = $msg->open or $r->log_error("Could not open sendmail");
$sendh->print($mailtext);
$what_we_did = <<EOS;
<TABLE BORDER=2 CELLPADDING=5><TR><TD BGCOLOR="#ff8888">
EOS
if ($sendh->close) {
warn "Uploader sent mail to $userref->{email} and closed successfully";
$what_we_did .= $self->dict("D028", $userref->{email});
} else {
warn "Uploader tried to send mail, but...: $!";
$what_we_did .= $self->dict("D029", $!);
}
$what_we_did .= qq{</TD></TR></TABLE>};
$what_we_did;
}
sub upload_form {
my($self) = @_;
my $cgi = $self->{CGI};
my $r = $self->{R};
my($userref) = $self->{USERREF};
my(@m);
push @m, $cgi->start_multipart_form(-action => $r->uri);
push @m, "<H4>Upload</H4>\n";
push @m, $self->dict("D030");
push @m, "<BR>";
push @m, $cgi->hidden('HIDDEN1',"VALUE1");
push @m, $cgi->filefield(-name => "HTTPUPLOAD", size => 48);
push @m, $cgi->hidden('HIDDEN2',"VALUE2");
push @m, qq{<BR>\n};
push @m, $self->dict("D031");
push @m, join(", ", @{$userref->{permitted} || []});
push @m, qq{ \)<BR>\n};
push @m, $cgi->textfield(
-name => "TARGETDIR",
size => 63,
maxlength => 63,
'default' => $userref->{permitted}[0],
);
push @m, "\n<BR>";
push @m, $cgi->submit(
-name=>'SUBMITup',
value=> $self->dict("D032")
);
join "", @m;
}
sub hello {
my($self) = @_;
my($cgi) = $self->{CGI};
my($userref) = $self->{USERREF};
my(@m);
my @hello = ("D033".."D037");
my $time = $self->time;
my @time = localtime($time);
my $daytime = $time[2];
if ($daytime >= 7 && $daytime < 10) {
push @hello, "D038";
} elsif ($daytime >= 19 || $daytime < 1) {
push @hello, "D039";
} elsif ($daytime >= 10) {
push @hello, "D040";
if ($daytime >=11 && $daytime < 14) {
push @hello, "D042";
}
} else {
push @hello, "D043";
}
my $hello = $self->dict($hello[rand @hello]);
my(@m);
push @m, qq{<H3>$hello $userref->{salut} $userref->{lastname},</H3>};
push @m, $self->dict('D001');
push @m, $self->dict("D044");
push @m, qq{<P>\n};
( run in 2.633 seconds using v1.01-cache-2.11-cpan-b16cb0d3907 )