Nogle der kan tilpasses dette script!! HURTGIT...
Er der nogle der kan lave dette script om, så det ikke skal bruge TreeBuiler, LWP, traverse, parse da dette ikke er installeret på min server!! Jeg har markeret det ind der sikkert skal laves om, men det kan godt være der er mere!!#!/usr/bin/perl -w
----- Her skal der rettes-----
use HTML::TreeBuilder;
use LWP::Simple;
use LWP::UserAgent;
-------------------------------
$empty= \"\";
$site = \"\";
open(TEMP, \">temp1.txt\");
print TEMP \"\";
close(TEMP);
@sites=);
-----Her skal der rettes---------
for ($i=0; $i<=$#sites; $i++){
$url = $sites[$i];
$doc = LWP::Simple::get($url);
$tree = HTML::TreeBuilder->new(); # create TreeBuilder
$tree->parse($doc); # parse file
$tree->traverse(\\&callback); # traverse parse tree
$tree->delete(); # release memory
}
-----------------------------------
sub callback {
my($node, $start, $depth) = @_;
return 1 unless ref($node);
return 1 unless $start;
open(TEMP, \">>temp1.txt\");
if($node->tag() eq \'a\') {
print TEMP $node->attr(\'href\');
print TEMP \"\\n\"; }
close(TEMP);
}
open(TEMP,\"<temp1.txt\");
while (<TEMP>){
$status=0;
next if /(\\w+)\\.cgi(.*)/;
next if /(\\w+)\\.pl(.*)/;
next if /(\\w+)\\?(.*)/;
next unless /^http:\\/\\/(.*)@(.*)/;
($site) = /\\.([^\\.]+)\\.(com|net|org)(.*)/;
if ($site eq $empty){
($site) = /(\\w+)\\.(com|net|org)(.*)/;}
if ($site eq $empty){
($site)= /\\@(([^\\/])+)\\//;}
next if ($site eq $empty);
$input=$site.\"*\".$_;
for ($i=0; $i<=$#links; $i++){if ($input eq $links[$i]) {$status=1; last;}}
if ($status==0) {
{
splice(@links, $#links + 1, length($input), $input);
}
}
}
close(TEMP);
@data1 = map { $_->[0] }
sort { $a->[1] cmp $b->[1] }
map { [$_, (/^(([^\\*])+)\\*/)[0]] } @links;
@data = (@data1, @scams);
@data = sort(@data);
open(TEMP,\">temp1.txt\");
for ($i=0; $i<=$#data; $i++){
print TEMP \"$data[$i]\";
}
close(TEMP);
open(BEST,\">../index.html\");
print BEST <<HEAD;
