rename results from the CPAN

Apache-FileManager

package Apache::FileManager;

=head1 NAME

Apache::FileManager - Apache mod_perl File Manager

=head1 SYNOPSIS

 # Install in mod_perl enabled apache conf file
  <Location /FileManager>
    SetHandler           perl-script
    PerlHandler          Apache::FileManager
  </Location>

  (Then point your browser to http://www.yourwebsite.com/FileManager)

 # Or call from your own mod_perl script
  use Apache::FileManager;
  my $obj = Apache::FileManager->new();
  $obj->print();

 # Or create your own custom MyFileManager subclass

 package MyFileManager;
 use strict;
 use Apache::FileManager;

 our @ISA = ('Apache::FileManager');

 sub handler {
   my $r = shift;
   my $obj = __PACKAGE__->new();
   $r->send_http_header('text/html');
   print ("
    <HTML>
      <HEAD>
      <TITLE>".$r->server->server_hostname." File Manager</TITLE>
      </HEAD>
   ");
   $obj->print();
   print "</HTML>";
 }

 # .. overload the methods ..


=head1 DESCRIPTION

The Apache::FileManager module is a simple HTML file manager.  It provides 
file manipulations such as cut, copy, paste, delete, rename, extract archive, 
create directory, create file, edit file, and upload files.

Apache::FileManager also has the ability to rsync the server htdocs tree to 
another server. With the click of a button.

=head1 PREREQUISITES 

The following (non-core) perl modules must be installed before installing 
Apache::FileManager.

 Apache::Request => 1.00
 Apache::File    => 1.01
 File::NCopy     => 0.32
 File::Remove    => 0.20
 Archive::Any    => 0.03
 CGI::Cookie     => 1.20

=head1 SPECIAL NOTES

Make sure the web server has read, write, and execute access access to the
directory you want to manage files in. Typically you are going to want to
run the following commands before you begin.

chown -R nobody /web/xyz/htdocs
chmod -R 755 /web/xyz/htdocs

The extract functionality only works with *.tar.gz and *.zip files.

=head1 RSYNC FEATURE

To use the rync functionality you must have ssh, rsync, and the File::Rsync 
perl module installed on the development server. You also must have an sshd 
running on the production server.

Make sure you always fully qualify your server names so you don't have 
different values in your known hosts file.

 For Example:
 ssh my-machine                -  wrong
 ssh my-machine.subnet.com     -  right

Note: If the ip address of the production_server changes you will need to
create a new known_hosts file.

To get the rsync feature to work do the following:

 #1 log onto the production server

 #2 become root

 #3 give web server user (typically nobody) a home area
   I made mine /usr/local/apache/nobody
   - production_server> mkdir /usr/local/apache/nobody
   - edit passwd file and set new home area for nobody
   - production_server> mkdir /usr/local/apache/nobody/.ssh

 #4 log onto the development server

 #5 become root

FileManager.pm view on Meta::CPAN

  #for all elements in the loc except the last one
  my @ac;
  my $up_a_href = "<A HREF=# onclick=\"var f=window.document.FileManager; f.FILEMANAGER_curr_dir.value=''; f.submit(); return false;\"><FONT COLOR=#006699 SIZE=+1><B>..</B></FONT></A>&nbsp;";
  for (my $i = 0; $i < $#loc; $i++) {
    push @ac, $loc[$i];
    my $url = join("/", @ac);
    $loc[$i] = "<A HREF=# onclick=\"var f=window.document.FileManager; f.FILEMANAGER_curr_dir.value='$url'; f.submit(); return false;\"><FONT COLOR=#006699 SIZE=+1><B>".$loc[$i]."</B></FONT></A>";
    if ($i == ($#loc - 1)) {
      $up_a_href = "<A HREF=# onclick=\"var f=window.document.FileManager; f.FILEMANAGER_curr_dir.value='$url'; f.submit(); return false;\"><FONT COLOR=#006699 SIZE=+1><B>..</B></FONT></A>&nbsp;";
    }
  }

  $loc[$#loc] = "<FONT SIZE=+1><B>".$loc[$#loc]."</B></FONT>";

  my $location = "<B>location: </B><A HREF=# onclick=\"var f=window.document.FileManager; f.FILEMANAGER_curr_dir.value=''; f.submit(); return false;\"><FONT COLOR=#006699 SIZE=+1><B>/</B></FONT></A>&nbsp;".join("&nbsp;<FONT SIZE=+1><B>/</B></FONT>&nb...

  return ($location, $up_a_href);
}

sub html_cmd_toolbar {
  my $o = shift;

  my @cmds = (

   #Refresh
   "<A HREF=# onclick=\"var f=window.document.FileManager; f.submit(); return false;\"><FONT COLOR=WHITE><B>refresh</B></FONT></A>",

   #Edit
   "<A HREF=# onclick=\"window.edit_file(); return false;\"><FONT COLOR=WHITE><B>edit</B></FONT></A>",

   #Cut
   "<A HREF=# onclick=\"window.save_names('cut'); return false;\"><FONT COLOR=WHITE><B>cut</B></FONT></A>",

   #Copy
   "<A HREF=# onclick=\"window.save_names('copy'); return false;\"><FONT COLOR=WHITE><B>copy</B></FONT></A>",

   #Paste
  "<A HREF=# onclick=\"if (window.getcookie(cookie_name) != '') { var f=window.document.FileManager; f.FILEMANAGER_cmd.value='paste'; f.submit(); } else { window.alert('Please select file(s) to paste by checking the file(s) first and clicking copy or...

   #Delete
  "<A HREF=# onclick=\"
     var f=window.document.FileManager;
     if (get_num_checked() == 0) {
         window.alert('Please select a file to delete by clicking on a check box with the mouse.');
     }
     else {
         var msg = '\\n' +
                   '                 Are you sure?\\n' +
                   '\\n' +
                   'Click OK to delete selected files & directories\\n' +
                   '   ***including*** files in those directories';
         if (window.confirm(msg)) {
             f.FILEMANAGER_cmd.value='delete';
             f.submit();
         }
     }
     return false;
\"><FONT COLOR=WHITE><B>delete</B></FONT></A>",

  #Rename
  "<A HREF=# onclick=\"var f=window.document.FileManager; if (get_num_checked() != 1) { window.alert('Please select ONE file to rename by clicking on a check box with the mouse.'); } else { var rv=window.prompt('enter new name',''); if ((rv != null)&...

  #Extract
  "<A HREF=# onclick=\"var f=window.document.FileManager; if (get_num_checked() == 0) { window.alert('Please select a file to extract by clicking on a check box with the mouse.'); } else { f.FILEMANAGER_cmd.value='extract'; f.submit(); } return false...

  #New File 
  "<A HREF=# onclick=\"
var f=window.document.FileManager; 
var rv = window.prompt('new file name',''); 
var cd = f.FILEMANAGER_curr_dir.value;
if (cd != '') {
  rv = cd+'/'+rv;
}
if ((rv != null)&&(rv != '')) { 
  var w = window.open('".r->uri."?FILEMANAGER_cmd=editfile&FILEMANAGER_curr_dir='+escape(cd)+'&FILEMANAGER_editfile='+escape(rv), 'FileManagerEditFile', 'scrollbars,resizable'); 
  w.focus(); 
} else if (rv == '') {
  window.alert('can not create blank file names');
}
return false;
\"><FONT COLOR=WHITE><B>new file</B></FONT></A>",

  #New Directory
  "<A HREF=# onclick=\"var f=window.document.FileManager; var rv=window.prompt('new directory name',''); if ((rv != null)&&(rv != '')) { f.FILEMANAGER_arg.value=rv; f.FILEMANAGER_cmd.value='mkdir'; f.submit(); } else if (rv == '') { window.alert('can...

  #Upload
  "<A HREF=# onclick=\"window.print_upload(); return false;\"><FONT COLOR=WHITE><B>upload<B></FONT></A>"
  );

  #Rsync
  my $rsync = "";
  if ($$o{'RSYNC_TO'}) {
    push @cmds, "<TD><A HREF=# onclick=\"if (window.confirm('Are you sure you want to synchronize with the production server?')) {var w=window.open('','RSYNC','scrollbars=yes,resizables=yes,width=400,height=500'); w.focus(); var d=w.document.open(); ...
  }

  return "
<!-- Actions Tool bar -->
<TABLE CELLPADDING=0 CELLSPACING=0 BORDER=0><TR ALIGN=CENTER><TD ALIGN=CENTER>".join("</TD><TD>&nbsp;<B><FONT COLOR=#bcbcbc SIZE=+2>|</FONT>&nbsp;</B></TD><TD>", @cmds)."</TD></TR></TABLE>";

}

sub html_file_list {
  my $o = shift;
  my $up_a_href = shift || "";

  my $bgcolor = "efefef";

  #get the list in this directory
  my $curr_dir = "";
  $curr_dir = r->param('FILEMANAGER_curr_dir')."/"
    if (r->param('FILEMANAGER_curr_dir') ne "");

  #if there is a value for the ".." directory, then add a row for that link
  #at the *top* of the list
  my $acum = "";
  if ($up_a_href ne "") {
    $acum = "
<TR BGCOLOR=#$bgcolor>
<TD>&nbsp;</TD>
<TD>$up_a_href</TD>
<TD ALIGN=CENTER>--</TD>

FileManager.pm view on Meta::CPAN

  my $arg1 = shift;
  my $sel_files = $o->get_selected_files();
  my @files = map { $o->filename_esc($$o{DR}."/".$_) } @{ $sel_files };
  my $count = remove \1, @files;
  if ($count == 0) {
    $$o{MESSAGE} = "0 files and directories deleted";
  } elsif ($count == 1) {
    $$o{MESSAGE} = "1 file or directory deleted";
  } else {
    $$o{MESSAGE} = "$count files or directories deleted";
  }
  return undef;
}


sub cmd_extract {
  my $o = shift;
  my $arg1 = shift;
  my $sel_files = $o->get_selected_files();
  foreach my $f (@{ $sel_files }) {
    my $esc = $o->filename_esc($$o{DR}."/".$f);
    my $archive = Archive::Any->new($esc);
    $archive->extract if defined $archive;
    $$o{MESSAGE} = "Files extracted.";
  }
  return undef;
}


sub cmd_upload {
  my $o = shift;
  my $arg1 = shift;
  my $count = 0;

  foreach my $i (1 .. 10) {
    my @ar = split /\/|\\/, r->param("FILEMANAGER_file$i");
    next if ($#ar == -1);
    my $filename = pop @ar;
    $filename =~ s/[^\w\ \d\.\-]//g;
    next if ($filename eq "");

    $count++;

    my $up = r->upload("FILEMANAGER_file$i"); next if ! defined $up;
    my $in_fh = $up->fh; next if ! defined $in_fh;

    my $arg = "> ".$$o{DR}."/".r->param('FILEMANAGER_curr_dir')."/".$filename;
    my $out_fh = Apache::File->new($arg);

    next if ! defined $out_fh;

    while (<$in_fh>) {
      print $out_fh $_;
    }
  }
  #$$o{MESSAGE} = "$count file(s) uploaded.";
  $$o{'view'} = "post_upload";
  return undef;
}

sub cmd_rename {
  my $o = shift;
  my $arg1 = shift;
  my $sel_files = $o->get_selected_files();
  my $file = $$o{DR}."/".$sel_files->[0];
  my $bool = move($file, $arg1);
  if ($bool) {
    $$o{MESSAGE} = "File renamed.";
  } else {
    $$o{MESSAGE} = "File could not be renamed.";
  }
  return undef;
}


sub cmd_rsync {
  my $o = shift;
  my $arg1 = shift;
  $$o{'SSH_PATH'} ||= r->dir_config('SSH_PATH');

  #try some default paths for ssh if we can't find ssh
  for (qw(/usr/bin/ssh /usr/local/bin/ssh)) {
    last if $$o{'SSH_PATH'};
    $$o{'SSH_PATH'} = $_ if (-f $_);
  }

  eval "require File::Rsync";
  if ($@) {
    r->log_error($@);
    $$o{MESSAGE} = "Module File::Rsync not installed.";
  } else {   
    my $obj = File::Rsync->new( {
      'archive'    => 1,
      'compress'   => 1,
      'rsh'        => $$o{'SSH_PATH'},
      'delete'     => 1,
      'stats'      => 1
    } );

    $obj->exec( { src  => r->document_root, 
                  dest => $$o{'RSYNC_TO'}    } ) 
      or warn "rsyn failed\n";
    $$o{MESSAGE} = join ("<BR>", @{ $obj->out }) if ($obj->out);
    $$o{MESSAGE} = join ("<BR>", @{ $obj->err }) if ($obj->err);
  }
  $$o{'view'} = "post_upload";
  return undef;
}


sub cmd_mkdir {
  my $o = shift;
  my $arg1 = shift;
  my $bool = mkdir $arg1;
  if ($bool) {
    $$o{MESSAGE} = "New directory added.";
  } else {
    $$o{MESSAGE} = "Could not make directory.";
  }
  return undef;
}

( run in 1.025 second using v1.01-cache-2.11-cpan-39bf76dae61 )