The following Perl script copies files from a Windows server (Vader) to a
Unix server (Neo).  The directory structures on each are slightly
different (hence the storm of regexp's in the subroutine).  Within each
directory on both servers there is a subdirectory called "messages"; for
some reason, the script doesn't seem to be able to traverse the tree and
descend into the "messages" directory, and there are files there that need
to be fixed.

Any suggestions would be greatly appreciated.


#!/usr/local/bin/perl -w

# FILE:         vton.pl
# PURPOSE:      Retrieve current discussion board messages
#               from Vader and put them on Neo
# AUTHOR:       Richard Crawford ([EMAIL PROTECTED])
# CREATED:      25 June 2003
# EDIT HISTORY:
# ===============================================================
# DATE          AUTHOR  EDIT
# 07/01/03      RC      Updated script to retrieve multiple files
# ===============================================================

use strict;
use File::Find;
use Net::FTP;

my $vaderIP = "xxx.xxx.xxx.xxx";

my $start_dir = shift or die "Usage: $0 <start_dir>\n";

unless (-d $start_dir) {
  die "Start files $start_dir is not a directory.\n";
}

# Connect to Vader
my $VaderConnect = Net::FTP->new($vaderIP) or die ("VTON: Can't connect to
Vader: $!\n");

$VaderConnect->login('Richard','password') or die ("VTON: Can't log in to
Vader: $!\n");
$VaderConnect->ascii();

print "\nVTON: Successfully connected to Vader.\n\n";


# traverse directory tree and move files
find (\&move, $start_dir) or die ("Couldn't get to $File::Find::dir/$_:
$!\n");

# Disconnect from Vader
$VaderConnect->quit();

sub move { #subroutine to move files

  # Find out the IP address of the current computer
  my $interface="hme0";
  my $ifconfig="/usr/sbin/ifconfig";
  my @lines = qx|$ifconfig $interface| or die "Could not execute ifconfig:
$!\n";
  my $neoIP;
  foreach(@lines) {
    if (/inet ([\d.]+)/) {
      my $neoIP = $1;
    }
  }

  # Find the current directory
  my $neoDir = $File::Find::dir;

  # Move to the equivalent directory on Vader
  my $baseDir = $neoDir;
  $baseDir =~ s#/space/usr/jrun4/servers/default/cfusion/DLC/##g;
  my $vaderDir = "/HTTPHome/$baseDir";
  $vaderDir =~ s#/extras##g;

  $VaderConnect->cwd($vaderDir);

  # Get all the files on Vader in this directory

  my @VaderFiles = $VaderConnect->ls($vaderDir) or die ("Cannot get list
of files: $!\n");

  # Now get each item from Vader and process them
  my $currentFile;

  print ("Number of files in $vaderDir: $#VaderFiles\n"); # return;

  foreach $currentFile (@VaderFiles)
  {

    $currentFile =~ s(^.*/)();

    return unless (
      ($currentFile =~ m/[0-9]+.html$/) or #message files
      ($currentFile =~ m/data.txt$/) or    #data.txt
      ($currentFile =~ m/wwwboard.html$/) #wwwboard.html
    );

    print "\nCurrent File is $currentFile\n";

    # Get the file from Vader
    $VaderConnect->get("$currentFile");

    # Replace "action=wwwboard.pl" with direct path to wwwboard.pl
    # Create an absolute path to wwwboard.pl
    $neoDir =~ s#/space/usr/jrun4/servers/default/cfusion/##g;
    my $URL="http://$neoIP/$baseDir/wwwboard.pl";;
    $URL =~ s#/messages##g;
    my $VaderURL="http://152.79.198.9/$baseDir/wwwboard.pl";;
    $VaderURL =~ s#/messages##g;
    unless (open IN, $currentFile) {
      die "VTON: Can't open file $currentFile for reading: $!\n";
    }
    unless (open OUT, "> fixedfile") {
      die "VTON: Can't open output file: $!\n";
    }
    while (<IN>) {
      # Fix form action tags.
      s/action="wwwboard\.pl"/action="$URL"/gi;
      s/action="$VaderURL"/action="$URL"/gi;
      # Fix style sheet call:
      s#href="../../../../Library/#href="../../../../../Library/#g;
      if ($currentFile =~ m#[0-9]+.html$#) {
        s#href="../../../../../Library/#href="../../../../../../Library/#g;
      }
      print(OUT $currentFile) or die "VTON: Can't write to fixedfile: $!\n";
    }
    close (IN);  close (OUT);
    rename("$currentFile","$currentFile.old");
    rename("fixedfile","$currentFile");

    chmod 0777, $currentFile;

    print "VTON: Copied and fixed $File::Find::dir/$currentFile\n";
  }
}


Sliante,
Richard S. Crawford

http://www.mossroot.com
AIM: Buffalo2K ICQ: 11646404 Y!: rscrawford
MSN: [EMAIL PROTECTED]

"It is only with the heart that we see rightly; what is essential is
invisible to the eye." --Antoine de Saint Exup�ry



-- 
redhat-list mailing list
unsubscribe mailto:[EMAIL PROTECTED]
https://www.redhat.com/mailman/listinfo/redhat-list

Reply via email to