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 )