Lidt hjælp til ændring af et script...

Hej Perl eksperter,

Jeg har et perl script som gør følgende:
1)Crawler andre sider vha. wget. Sider der skal hentes fra er sat i filen sites.txt
2)Når links med brugernavn og passwords er hentet, altså links. ex.
http://bruger:pass@site.com/blablabla/
så bliver disse links checket via wget.
3)Alle links der stadig virker, bliver smidt ind i en ny fil, som så til sidst bliver samlet til en html side.

Jeg kunne godt tænke mig at få lavet et par ændringer.
1)Den skal ikke crawle andre sider, kun crawle nogle links som jeg selv smider ind i filen wgetchk.txt.
Den skal så tjekke disse links et efter et (koden er der allerede).
Når den har tjekket alle links med bruger:pass fra ovenstående fil, så bliver alle de links som stadig virker kopieret over i filen links.txt, men bliver også stadig i filen wgetchk.txt, så de kommer med næste gang at der tjekkes links. Det eneste som der skal slettes fra wgetchk.txt er alle links hvor bruger:pass ikke virker mere.

Håber at nogle kan hjælpe med dette, hvis I ikke forstår så meget af det, så må i meget gerne spørge, ellers tag et kig på koden nedenunder, den giver nok mere mening. Hvis i får brug for flere filer, så sig endelig til.

Når i begynder at kigge på det, vil i så ikke godt lige skrive det her, da det måske kan tage lidt tid, så jeg ved at nogle kigger på det, og ikke behøves at lukke spørgsmålet.

For evt. adhos questions kan jeg kontaktes her eller på icq: 71849092

Her kommer al koden:

#!/usr/bin/perl
############
#

require "general.pl";

LogTxt( "Start of crawler." );

$datafile="sites.txt";
$linksfile="links.txt";
$chkfile="wgetchk.txt";
$sponsor="sponsors.txt";
$descriptions="descriptions.txt";
$blacklist="blacklist.txt";
$redirfile="redir.txt";
$logfile="extreme.txt";
$tables = "tables.htm";

$numberOfLinksPerTable = 15;

$time_out=3;

$path="../";

# Figure out operating system (is it Windows or something else)

$os = $^O;
if ($os eq 'MSWin32') {
  $isWin = 1;
}
else {
  $isWin = 0;
}

#print "os $os iswin $isWin\n";

@head=("head.htm","head.htm","head.htm","head.htm","head.htm","head.htm","head.htm");
@foot=("foot.htm","foot.htm","foot.htm","foot.htm","foot.htm","foot.htm","foot.htm");

if (!$isWin) {
  # Hello Brian, this is your testing!
  @page=("index.php","page2.htm","page3.htm","page4.htm","page5.htm","page6.htm","page7.htm");
}
else {
  # This is how it runs at my place
  @page=("index.html","page2.htm","page3.htm","page4.htm","page5.htm","page6.htm","page7.htm");
}

$supchk  = 0; # Set to 1 if link check shall be suppressed
$supwget  = 0; # set to 1 if wget shall be suppressed during link check
$linktest = 0; # Set to 1 for testoutput during link search in html from sites
$savtest  = 0; # set to 1 for testoutput of the password save/restore handling
$wgtest  = 0; # set to 1 for testoutput of the link checking process
$suplink  = 0; # set to 1 to suppress generation of new version of links.txt

$max=200;
###################################################

####################################3
# PAss Spider


# Handle program arguments

foreach my $arg (@ARGV) {
  if ($arg eq 'supchk')  { $supchk  = 1; }
  if ($arg eq 'supwget')  { $supwget  = 1; }
  if ($arg eq 'linktest') { $linktest = 1; }
  if ($arg eq 'savtest')  { $savtest  = 1; }
  if ($arg eq 'wgtest')  { $wgtest  = 1; }
  if ($arg eq 'suplink')  { $suplink  = 1; }
}

readRating( '' );

open(DATAFILE,"$datafile") || LogTxt( "cannot open $datafile" );
@sites=<DATAFILE>;
close(DATAFILE);

$c=0;
foreach $line (@sites) {
  $site[$c]=$line,$c++ unless($line =~ /#/);

}
###############################
################################
open(DATAFILE,"$descriptions") || LogTxt( "cannot open $descriptions" );
@sitess=<DATAFILE>;
close(DATAFILE);

$"="|";
$c=0;
foreach $line (@sitess){
    if($line !~ /#/) {
        ($sitename,$cateogry,$rating,$description,@more)=split(/\|/,$line);
        $DESCRIPTION{$sitename}=$description;
        $RATING{$sitename}=$rating;
        $CATEGORY{$sitename}=$rating;
        $MORE{$sitename}="@more";
    }
}
$"="";
####################################
# read and fixup the blacklist table
####################################

$blacklistsize = 0;
open(DAT,"$blacklist") || LogTxt( "cannot open $blacklist" );
while (<DAT>) {
  $blacklistsize++;
  $entry = $_;
  chomp($entry);
  $black{$entry} = 1;

  if (($entry !~ m/^www\./) and ($entry !~ /^\d+\.\d+\.\d+\.\d+$/)){
      # blacklist entry does not start with www. and is not a numerical IP address
      # add an extra entry in $black, with a prepended 'www.'
      $entry = 'www.' . $entry;
      $black{$entry} = 1;
  }
}
close(DAT);

##########################################
# Read the sites, which shall be 'crawled'
##########################################
$c=0;

if ($isWin) {
  $wget = 'c:\jesper\downloads\wget\wget.exe';
}
else {
  $wget = '/usr/local/bin/wget';
}

$totalSiteLinks = 0;      # Total number of links encountered from sites listed in
                          # sites.txt

$totalBlackListed = 0;    # Total number of blacklisted links

foreach $site (@site) {
  chomp $site;
  print "Before wget $site\n" if $linktest;
  LogTxt( "before wget $site" );
  @html = `$wget --output-document=- -q --timeout=$time_out $site`;
  print "after wget $site\n" if $linktest;
  LogTxt( "After wget $site" );

  $HTML="@html";

  @html=split(/<a/,$HTML);
  #print "<p> $site\n---------------------------\n\n";
  $numlink = 0;
  $blacklisted = 0;
  foreach $link (@html) {
      $numlink++;

      print "Raw link\n$link\nEnd of raw link\n" if $linktest;

      if ($link =~ /http:\/\/[^\:\"\']+\:[^\@]+\@[^ \"\']+/ix && $& !~ /(\?|cgi|bin|window\.)/i)
      {
        $link = $&;

        print "Matched link \n$link\n" if $linktest;

        $domain = getDomain( $link );
        #print "domain <$domain>\n";
        if (exists($black{$domain})) {
            $blacklisted++;
            print "Rejected by blacklist\n" if $linktest;
        }
        else {
            push(@links,"$link")
        }

        $c++;
      }
  }
  print "$numlink links from $site, blacklisted $blacklisted\n" if $linktest;
  LogTxt( "$numlink links from $site, blacklisted $blacklisted" );

  $totalSiteLinks  = $totalSiteLinks  + $numlink;
  $totalBlackListed = $totalBlackListed + $blacklisted;

}


#######################################
# Check for identical duplicates
#######################################

# Remove completely identical duplicates
foreach $link (@links) {
  if (exists($unique{$link})) {
      #print "double 1: discarded $link\n";
  }
  $unique{$link} = 1;
}

#########################################
# Check each link, that it actually works
#########################################


if ($supchk != 0) {
  print "Link checking suppressed\n";
}
else {

  # create list of links for wget, also create a hash, which allows us
  # to find the original password, when we process the results from wget. This
  # is necessary, since the wget output shows xxx's instead of the real passwords.

  open(CHK,">$chkfile") || LogTxt( "cannot open $chkfile" );
  $wgetNumber = 0;
  foreach $link (keys %unique) {
      $wgetNumber++;
      print CHK "$link\n";

      # save the original password in a hash, where we can
      # find it later
      $url  = getURL( $link );
      $user = getUser( $link );
      $pass = getPass( $link );
      $urluser2pass{$url}{$user} = $pass;

      print "Saving pass $pass for $url $user\n" if $savtest;
  }
  close(CHK);

  print "$wgetNumber links to check\n" if $wgtest;
  LogTxt( "Before checking $wgetNumber links" );
  if ($supwget == 0) {
      print "Now running wget for $wgetNumber links\n" if $wgtest;
      $wgetcommand = "$wget --spider --tries 2 --server-response " .
                    "--output-file=wgetresult.txt --timeout=5 --input-file=$chkfile";
      @wgetoutput = `$wgetcommand`;
      print "after wget\n" if $wgtest;
  }
  LogTxt( "After checking $wgetNumber links" );

  undef %unique; # Throw out all the links in preparation for the rebuild
                  # from wgetresult.txt

  # Read in the current redirection file
  if (open(REDIR, $redirfile)) {
      while (<REDIR>) {
        chomp;
        ($orgurl, $redirurl) = split(/\|/);
        $redirtable{$orgurl} = $redirurl;
      }
      close(REDIR);
  }

  open (RES, 'wgetresult.txt') || LogTxt( "could not open wgetresult.txt" );

  $redirurl = "";  # Start off with an empty redirect url
  $numchecked = 0;
  $numredir  = 0;

  while (<RES>) {
      if (/^--.+--  (.+)$/) {

        # First line in the attempt to check a page.
        # Obtain and save the URL.

        $link = $1;
        print "wgresult link = $link\n" if $wgtest;
      }
      elsif (/^HTTP request sent, awaiting response\.\.\. (\d\d\d)/) {

        # Line containing the HTTP status of a request
        # If the status is OK (200), and the URL being loaded is not the
        # latest Location: redirect URL, the URL is recorded in the unique table
        # as good and working.

        $httpstatus = $1;
        print "httpstatus = $httpstatus\n" if $wgtest;
        if ($httpstatus == 200) {
            if (($link ne $redirurl) && ($link ne ($redirurl . '/'))) {
              # This is OK, a good status and it was not the most recently
              # encountered Location: redirect url
              #
              # The link retrieved from wgetresult.txt has its password changed to
              # xxx's. This must now be repaired.

              $user = getUser( $link );
              $url  = getURL( $link );
              if (exists( $urluser2pass{$url}{$user} )) {
                  # Password found, build the proper link
                  $pass = $urluser2pass{$url}{$user};
                  $link = "http://$user:$pass\@$url";
                  print "final link $link\n" if $savtest;
              }
              else {
                  print "could not find password for \n$url\n$user\n" if $savtest;
              }

              $unique{$link} = 1;
              $numchecked++;
            }
            else {
              print "skipped due to redirection\n" if $wgtest;
            }
        }
      }
      elsif (/^\d+ Location: (.+)$/) {

        # This is a redirection HTTP response header. The URL is
        # recorded as the latest redirection URL, since WGET will try to
        # load it immediately, and we must ensure, that the potentially successful
        # loading of the redirect URL must not be recorded as a good link.

        $redirurl = $1;
        print "$link is redirected to $redirurl\n" if $wgtest;

        if (!exists($redirtable{$link})) {
            # A new unknown redirection, add to logfile
            open( LOG, ">>$logfile" );
            print LOG "$link is redirected to\n$redirurl\n\n";
            close(LOG);
        }
        $redirtable{$link} = $redirurl; # Record redirection in table
        $numredir++;
      }
     
  }
  close(RES);
  LogTxt( "After processing wgetresult.txt $numchecked links OK, $numredir redirections" );
  $workingLinks = $numchecked;
}

print "$numchecked links OK, $numredir redirections\n" if $wgtest;
$brokenLinks = $wgetNumber - $numchecked;

# Create a new version of the redirect table file

open(REDIR,">$redirfile") || LogTxt( "cannot open $redirfile" );
foreach $url (sort keys %redirtable) {
  print REDIR "$url|$redirtable{$url}\n";
}
close(REDIR);

############################################################################
# Add Fake (sponsor list), this is done after all the checks, so these links
# will be present, even if they perhaps don't work!
############################################################################

open(DAT,"$sponsor") || LogTxt( "cannot open $sponsor" );
@spons=<DAT>;
close(DAT);

$numSponsors = $#spons + 1;

LogTxt("Number of sponsor links: $numSponsors");

foreach $line (@spons) {
  chomp($line);
  $unique{$line} = 1;
}

# Throw out the original list so it can be reused
@links = ();

###################################################################
# Determine, which of the present links are new. Read in the result
# of the previous run from file links.txt, and make the comparison
###################################################################

if (open(PREV, $linksfile)) {
  while (<PREV>) {
      chomp;
      $prevlinks{$_} = 1;
  }
}

##########################
# Build list of alternates
##########################

foreach $line (sort cmpUrlNew keys %unique) {
  $url = getURL( $line );
  if (exists($uniqueURL{$url})) {
      #print "alternate link $line\n";
      push @{$alternates{$url}}, $line;  # $alternates{$url} is a list of the alternates
  }
  else {
      #print "link $line seen for the first time\n";
      $uniqueURL{$url} = 1;
      push(@links, $line);
  }
}


#########################################
@links=sort sortit @links;
$"="\n<p>";

$"="";

##################################
# Save the data, unless suppressed
##################################

if (!$suplink) {
  open(BOB,">$linksfile") || LogTxt( "cannot open $linksfile" );

  foreach $link (keys %unique) {
      print BOB "$link\n";
  }

  close(BOB);
}

#############################################################################
# Count number of unique links, not done above, since printing $linksfile can
# be suppressed
#############################################################################

$numchecked = 0;
foreach $link (keys %unique) {
  $numchecked++;
}

#######################################
# create the output files

$time=`/bin/date`;
if (!$time) { $time = 'Fri Jun  8 20:10:58 MST 2001'; }

# time format: Sat Apr  7 01:57:58 MST 2001


#######################################
# Make Pages

$PAGE="";
for($t=0,$c=0;$t<$#links-3;$t+=$max,$c++)
{
    $PAGE .="<a href=\"$page[$c]\" target=\"_self\">Page " .($c +1) ."</a> \n";
}
#######################################
$last="";

$c=0;
$p=0;
$total=$#links;
$count=0;

$newlinktext = 'NEW';


# Open final result output file, print header
open(PAGE,">$path$page[0]") || LogTxt( "cannot open $path$page[0]" );
&html("html/$head[0]","PAGE");


# Open the tables file
open(TABLES, "html/$tables") || LogTxt( "tables: cannot open <$tables>" );

LogTxt( "After opening $tables" );

$tabnum = 0;
$tabline = 0;

# Start off with empty table
$nexttable = '';
$linksInTable = 0;

foreach $line (@links) {
########################
# Get the Items

  $line =~ /http:\/\/([^\:]+)\:([^\@]+)\@([^\/]+)/i;
  $login=$1;
  $pass =$2;
  $sitename =$3;


  #print "<p> $line --> $login --> $pass --> $sitename";

  $sitename =~ s/(www|www1|www2|members)\.//ig;
  $sitename =~ s/\s//ig;
  $SO=$sitename;
 

############################################################
# stuff done toward printing it..
   
  $description=" No description";
  $description="$DESCRIPTION{$sitename}" if ($DESCRIPTION{$sitename});

  #print "<br>" .$links[$count+1] . " --> $SO \n";

  $url = getURL( $line );
  $domain = getDomain( $line );

  $altnum = 0; 

  $alternate = '';
  if (exists($alternates{$url})) {
      $totalt = $#{$alternates{$url}}; # Get number of alternates for this url

      foreach $alt (@{$alternates{$url}}) {
        $altnum++;
        $alternate = $alternate . "<a href=\"$alt\" target=\"_blank\">" .
                                  "<img src=\"Images/";

        # Use alternate_new if link didn't exist in the previous run
        if (!exists($prevlinks{$alt})) {
            $alternate = $alternate . "alternate_new.gif\"";
        }
        else {
            $alternate = $alternate . "alternate.gif\"";
        }

        $alternate = $alternate . " width=18 height=18 border=0></a>\n" ;
      }
  }
 

  if (($links[$count+1] =~ /$SO/i) && $c+1!=$max && $count+2 != $total ) {
      $des= "";
  }
  else {
      $des = $description;
  }   

  # Obtain rate and calculate average, if it exists
  if (exists($NUMVOTES{$domain})) {
      $numvotes = $NUMVOTES{$domain};
      $totalrate = $RATE{$domain};

      if ($totalrate != 0) {
        $avgrate = int(0.5 + $totalrate/$numvotes);
      }
      else {
        $avgrate = 0;
      }

      if ($numvotes == 1) {
        $numvotes = $numvotes . " vote";
      }
      else {
        $numvotes = $numvotes . " votes";
      }
  }
  else {
      $totalrate = 0;
      $avgrate = 0;
      $numvotes = '0 votes';
  }

  if (exists($prevlinks{$line})) {
      $newsite = '';
  }
  else {
      $newsite = $newlinktext;
  }

  if ($sitename) {
      $nexttable .= &html("html/entry.htm",'', 1);
      $linksInTable++;
      if ($linksInTable >= $numberOfLinksPerTable) {

        $tabnum++;
        LogTxt( "Starting generating table $tabnum" );

        # Read the skeleton of the next table
        $skeleton = '';
        while (defined($lin = <TABLES>)) {
            $tabline++;
            if (index( $lin, '<!-- END OF TABLE -->') >= 0) {
              last;
            }
            $skeleton .= $lin;
        }

        LogTxt( "Before printing table $tabnum" );

        eval("print PAGE <<BLOCK \n$skeleton\nBLOCK\n\n");


        $nexttable = '';
        $linksInTable = 0;
      }
  }

############################################################
  $count++;

}


# Print the remaining table rows to the next table

if ($linksInTable > 0) {

  LogTxt( "Starting generating last table" );
  # Read the skeleton of the next table
  $skeleton = '';
  while (defined($lin = <TABLES>)) {
      $tabline++;
      if (index( $lin, '<!-- END OF TABLE -->') >= 0) {
        last;
      }
      $skeleton .= $lin;
  }

  LogTxt( "Before printing last table" );
  eval("print PAGE <<BLOCK \n$skeleton\nBLOCK\n\n");
}

close(TABLES);

# Terminate the page by appending $foot

&html("html/$foot[0]","PAGE");

close(PAGE);

LogTxt( "End of crawler, $wgetNumber links checked, $numchecked links shown." );

# End of main program, below follows subroutines


sub sortit
{
  $aa=$a;$bb=$b;
  $aa =~ /http:\/\/([^\:]+)\:([^\@]+)\@([^\/]+)/ig;
  $aa=$sitename =$3;
  $bb =~ /http:\/\/([^\:]+)\:([^\@]+)\@([^\/]+)/ig;
  $bb=$sitename =$3;

  $aa =~ s/(www|www1|www2|members)\.//ig;
  $bb =~ s/(www|www1|www2|members)\.//ig;


 
return $aa cmp $bb;
}


# Comparison routine: Compares links. 'Old' links to an URL come before 'new' links to
#                                    same URL
sub cmpUrlNew
{
  my $urlA = getURL( $a );
  my $urlB = getURL( $b );
  my $retval;

  $retval = ($urlA cmp $urlB);        # Return 'highest' URL if different

  if ($retval == 0) {
      $retval = (exists($prevlinks{$b}) <=> exists($prevlinks{$a}));
  }
 
  return $retval;
}


sub getUser {
  my $link = shift;
  my $retValue;
  $retValue = $link;
  $retValue =~ s/\n//g;
  $retValue =~ s/http:\/\/(.*):(.*)\@(.*)$/$1/g;
  return $retValue;                                             
}#getUser

sub getPass {
  my $link = shift;
  my $retValue;
  $retValue = $link;
  $retValue =~ s/\n//g;
  $retValue =~ s/http:\/\/(.*):(.*)\@(.*)$/$2/g;
  return $retValue;                                             
}#getPass

sub getDomain {
  my $link = shift;
  my $retValue;
  $retValue = $link;
  $retValue =~ s/\n//g;
  $retValue =~ s/http:\/\/(.*):(.*)\@(.*)$/$3/g;;
  if ($retValue =~ /\s/) {
      $retValue =~ s/(.*)\s.*/$1/;
  }

  while ($retValue =~ /\//) {
      $retValue =~ s/^(.*)\/.*$/$1/;
  }

  return $retValue;
}#sub getDomain

sub getURL {
  my $link = shift;
  my $retValue;
  $retValue = $link;
  $retValue =~ s/\n//g;
  $retValue =~ s/http:\/\/(.*):(.*)\@(.*)$/$3/g;
  if ($retValue =~ /\s/) {
      $retValue =~ s/(.*)\s.*/$1/;
  }
  return $retValue;
}#getURL


sub checkLynxErrFile {
  my $errFile = shift;
  my $htmlCode = undef;
  my $htmlText = undef;

  open ERR, $errFile || LogTxt( "NO ERROR FILE $errFile FOUND" );
  @errFile = <ERR>;
  close ERR;

  #print "before errFile:\n";
  #print @errFile;
  #print "after errFile:\n";

  $errlines = @errFile;
  foreach $lin (@errFile) {
      chomp($lin);
      #print "errorline <$lin>\n";
      if ($lin =~ m/^STATUS=.+ (\d+) (.+)$/) {
        #print "HTML code <$1> text <$2>\n";
        $htmlCode = $1;
        $htmlText = $2;
      }
  }

  unlink $errFile;

  return ($htmlCode, $htmlText);
}

#################################
# Log text to file crawlerlog.txt
#################################

sub LogTxt {
  my ($txt) = @_;

  my ($sec,$min,$hour,$mday,$mon,$year) = localtime(time);

  open(LOG, ">>crawlerlog.txt");
  printf LOG "%04d-%02d-%02d %02d:%02d:%02d (%d) %s\n",  $year+1900, $mon+1, $mday,
                                                $hour, $min, $sec, $$, $txt;
  close(LOG);
}