Help with a Perl script?

[Steve Scrimpshire]

Ok, I'm no programmer, just a hacker, so this is probably very dirty and it has a couple bugs, like sometimes it tries to retrieve files that it has already gotten, but it's not often enough that I think there is a bad loop in the script and I'm still debugging that, but that's not my question.

 

Here's the script:

#!/usr/bin/perl



use Net::FTP;

use File::Copy;



$ez = Net::FTP->new("knight.zarb.org", Timeout => 30) 

     or die "Could not connect!n";



$user = "anonymous";

$password = "me@mine.com";

$ez->login ($user, $password) or die "cant login: $!";

$ez->cwd('/pub/plf/9.1');

$beglist="";

$list="";

(@beglist=$ez->ls) || die "Cannot get list!n";

$ez->quit;



foreach $beglist(@beglist){

       

           if (-f "/urpmi/plf/$beglist"){

           unless (($beglist =~ m/synthesis.hdlist.cz/ig)||($beglist =~ m/hdlist.cz/ig)||($beglist =~ m/list/ig)||($beglist =~ m/version/ig)||($beglist =~ m/MD5SUM/ig)){

              print "I don't need to get $beglist, because I already have it.n";

          unless (-e "/urpmi/plf2"){ system "mkdir /urpmi/plf2"; }



          copy("/urpmi/plf/$beglist","/urpmi/plf2/$beglist");

          }

          if (($beglist =~ m/synthesis.hdlist.cz/ig)||($beglist =~ m/hdlist.cz/ig)||($beglist =~ m/list/ig)||($beglist =~ m/version/ig)||($beglist =~ m/MD5SUM/ig)){

             push (@list,$beglist);

             }

          }

          else{

              push (@list,$beglist);

              }

       }

     

$fluff = Net::FTP->new("knight.zarb.org", Timeout => 30) 

     or die "Could not connect!n";

        $fluff->login ($user, $password) or die "cant login: $!";

        $fluff->cwd('/pub/plf/9.1');

$fluff->get("list", "/urpmi/plf2/list") || die "Cannot get list! $!n";

$test = system "diff /urpmi/plf/list /urpmi/plf2/list";

unless ($test){ die "I don't need to get anything!n"; }



foreach $list(@list) {

        print "Getting $list, I think.n";

        $fluff->get("$list", "/urpmi/plf2/$list") || push(@dir,$list);

        print "Got $list, I thinkn";

        }



$fluff->quit;



sub blah;



foreach $dir(@dir){

       print "$dir was a directory and was not retrieved.n";

       $cwd = "$dir";

       &blah("$cwd");

       }





sub blah(){

   print "Did I get into the sub?n";

   my $newcwd = "";

   my $newlist = "";

   my $newbeglist = "";

   my $newdir = "";

   $newcwd = shift;

   $fluff = Net::FTP->new("knight.zarb.org", Timeout => 30) 

     or die "Could not connect!n";

   $fluff->login ($user, $password) or die "cant login: $!";

   $fluff->cwd("/pub/plf/9.1/$newcwd") || die "Cant change directory to $newcwd $!";

   print "Hey, I changed directory to $newcwd. Cool!n";

   

   (@newbeglist=$fluff->ls) || die "Cannot get list!n";

   $fluff->quit;

   unless (-e "/urpmi/plf2/$newcwd") { mkdir "/urpmi/plf2/$newcwd", 0777 || die "Cannot mkdir $newcwdn"; }

 

foreach $newbeglist(@newbeglist) {



   if (-e "/urpmi/plf/$newcwd/$newbeglist"){

      unless (($newbeglist =~ m/synthesis.hdlist.cz/ig)||($newbeglist =~ m/hdlist.cz/ig)||($newbeglist =~ m/list/ig)||($newbeglist =~ m/version/ig)){

              print "I don't need to get $newbeglist, because I already have it.n";

      unless (-e "/urpmi/plf2/$newcwd") { mkdir "/urpmi/plf2/$newcwd", 0777; }

      copy ("/urpmi/plf/$newcwd/$newbeglist", "/urpmi/plf2/$newcwd/$newbeglist");

      }

      if (($newbeglist =~ m/synthesis.hdlist.cz/ig)||($newbeglist =~ m/hdlist.cz/ig)||($newbeglist =~ m/list/ig)||($newbeglist =~ m/version/ig)){

             push (@newlist,$newbeglist);

             }

      }

       else{

            push (@newlist,$newbeglist);

            }

}



       $fluffy = Net::FTP->new("knight.zarb.org", Timeout => 30) 

     or die "Could not connect!n";

        $fluffy->login ($user, $password) or die "cant login: $!";

        $fluffy->cwd("/pub/plf/9.1/$newcwd") || die "$!";



foreach $newlist(@newlist) {

        print "Getting $newlist, I think.n";

        $fluffy->get("$newlist", "/urpmi/plf2/$newcwd/$newlist") || push(@newdir,$newlist);

        print "Got $newlist, I thinkn";

        }



$fluffy->quit;





foreach $newdir(@newdir){

       print "$newdir was a directory and was not retrieved.n";

       }

   }







print "Done!n";

print "Now, I'll move the directories.n";

print "Moving /urpmi/plf to /urpmi/plf-old.n";



system "rm -rf /urpmi/plf-old" || die "Cannot remove the plf backup directory!n";

system "mv /urpmi/plf /urpmi/plf-old" || die "Cannot move plf!n";

print "Hey, I moved plf. Ain't I smart?n";

print "Moving /urpmi/plf2 to /urpmi/plf.n";

system "mv /urpmi/plf2 /urpmi/plf" || die "Cannot move plf2!n";

print "Hey, I moved plf2. Ain't I smart?n";

system "urpmi.update plf";



exit;

 

As you can see, I'm using Net::FTP. My problem is that after I do the

@beglist = $ez -> ls;

 

I cannot use the

 

if (-d "somefile")

 

to tell if a listing is a directory or a file, so what I have to do is try to retrieve a listing and if it fails, I add it to a list that is going to be labelled as directories. The problem with that is that if the 'get' of a file fails for whatever reason, it gets added to the list of directories. I would really like to be able to do the directory test operator on it, that way, if a file fails to be downloaded, I can try one more time before giving up on that file. Does it make sense? If my code is too incomprehensible for you to arrive to a conclusion, just tell me. :-)

 

Thanks in advance.

 

P.S. In case you're wondering, I run this from my home box to compare the contents of my local copy of plf to what is on knight.zarb.org and if there are new files, I grab them and if there are files on there that I already have, I just copy them over to my new temp directory and don't grab them from the server. I'd like to have this tweaked well enough to run it as a cron job. The one problem that I've run into is that I can't get the script to mkdir plf2 (the temp directory) at the beginning, it fails and I don't get a very verbose error message from it. I

[Steve Scrimpshire]

I think I've made the script simpler, so it'll only connect if PLF's list file has files on it that are not in my list file:

 

Edit: Anyone that wants to use this, feel free, under GPL ;) But, it's coded for knight.zarb.org and the case of the directories or their layout may be different for a different FTP site.

 

#!/usr/bin/perl 



#*******************************************************************************
******

#   This program is free software; you can redistribute it and/or modify        

#    it under the terms of the GNU General Public License as published by    

#   the Free Software Foundation; either version 2 of the License, or            

#   (at your option) any later version.                                                           

#                                                                                                                 

#*******************************************************************************
******



use Net::FTP;

use File::Copy;

system "mkdir /urpmi/plf2" || die "Cannot mkdir plf2! $!";



$ez = Net::FTP->new("knight.zarb.org", Timeout => 30) || die "Could not connect!n";

print "Connected...sending passwordn";



$user = "anonymous";

$password = "me@blah.com";



$ez->login ($user, $password) or die "cant login: $!";

print "Password accepted. Changing to the /pub/plf/9.1 directory.n";



$ez->cwd('/pub/plf/9.1');

$beglist="";

$list="";



print "Getting the list and checking to see if there are new packages.n";

(@beglist=$ez->ls) || die "Cannot get list!n";

$ez->get("list", "/urpmi/plf2/list") || die "Cannot get list! $!n";

$test = system "diff /urpmi/plf/list /urpmi/plf2/list";



unless ($test){

      system "rm -rf /urpmi/plf2" || die "Cannot remove directory, but I dont need anything anyway, so oh well.n";

      die "I don't need to get anything!n"; }



$plf_list = "/urpmi/plf/list";

 open(LIST, "$plf_list") || die "Cannot open $plf_list $!n";

 @list=<LIST>;



system "mkdir /urpmi/plf2/alpha" || die "Cannot mkdir alpha";

system "mkdir /urpmi/plf2/athlon"|| die "Cannot mkdir athlon";

system "mkdir /urpmi/plf2/i586" || die "Cannot mkdir i586";

system "mkdir /urpmi/plf2/ppc" || die "Cannot mkdir ppc";

system "mkdir /urpmi/plf2/noarch" || die "Cannot mkdir noarch";



foreach $list(@list){

       $list =~ s/.///;

       chomp $list;

       print "Copying $list.n";

       if (-f "/urpmi/plf/$list"){

          copy("/urpmi/plf/$list","/urpmi/plf2/$list") || die "Cannot copy $list. $!n";

          print "Copied $list.n";

          }

       else { 

          print "Hey, I need $list! I think I'll add it to the 'need' list.n";

          push (@need, $list); }

       }



foreach $need(@need){

       $need =~ s/.///;

       print "Getting $need.n";

       $ez->get("/pub/plf/9.1/$need", "/urpmi/plf2/$need") || die "Cannot get $need! $!n";

       print "Got $need.n";

       }



print "Now I'm going to get the hdlist and stuff.n";



$ez->get("hdlist.cz", "/urpmi/plf2/hdlist.cz") || die "Cannot get hdlist! $!n";

print "Got hdlist.cz.n";



$ez->get("synthesis.hdlist.cz", "/urpmi/plf2/synthesis.hdlist.cz") || die "Cannot get synthesis.hdlist! $!n";

print "Got synthesis.hdlist.cz.n";



$ez->get("MD5SUM", "/urpmi/plf2/MD5SUM") || die "Cannot get MD5SUM! $!n";

print "Got MD5SUM.n";



$ez->get("version", "/urpmi/plf2/version") || die "Cannot get version! $!n";

print "Got version.n";



$ez->quit;



print "Done!n";

print "Now, I'll move the directories.n";

print "Moving /urpmi/plf to /urpmi/plf-old.n";



system "rm -rf /urpmi/plf-old" || die "Cannot remove the plf backup directory!n";

system "mv /urpmi/plf /urpmi/plf-old" || die "Cannot move plf!n";

print "Hey, I moved plf. Ain't I smart?n";

print "Moving /urpmi/plf2 to /urpmi/plf.n";

system "mv /urpmi/plf2 /urpmi/plf" || die "Cannot move plf2!n";

print "Hey, I moved plf2. Ain't I smart?n";

system "urpmi.update plf";



exit;

 

P.S. Yeah, that's lazy man's Perl, sarah. ;)

[Steve Scrimpshire]

Y'all really don't like perl, do ya?