hallo Leute,
guten Morgen - ich habe heute eine besondere Frage zu einer Subroutine die ich abwandlen muss. Wenn ich den parser ueber seiten wie
diesen laufen lassen will dann sollte ich am script wohl was ändern.
was meint Ihr denn?!`
-. was muss ich an dem unten geposteten Code ändern damit ich die Subroutine so wandel dass der Content parser auf Seiten wie diesen hier automatisch lesen kann?
http://www.kite2fly.com/forum/sitemap.php
http://www.mynak.com/forum/sitemap.php
http://www.dizign.de/forum/sitemap.php
ich glaube dass ich was in der subroutine aendern muss damit das ueber die Sitemap läuft. was meint ihr denn!?
danke
Bretone
#!e:/Server/xampp/perl/bin/perl.exe -w
use strict;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use CGI;
my $cgi = CGI->new();
print $cgi->header();
warningsToBrowser(1); # dies ist wichtig und muss nach dem Header kommen!
use warnings;use LWP::RobotUA;
use HTML::LinkExtor;
use HTML::TokeParser;
use URI::URL;
use Data::Dumper; # for show and troubleshooting
my $url = "http://www.mysite.com/forums/";
my $lp = HTML::LinkExtor->new(\&wanted_links);
my $ua = LWP::RobotUA->new('my-robot/0.1', 'me@foo.com');
my $lp = HTML::LinkExtor->new(\&wanted_links);
print "Content-type: text/html\n\n";
print "Surfer variablen ua PRINT: $ua \n";
print "Surfer variablen lp PRINT: $lp \n";
my @links;
get_threads($url);
foreach my $page (@links) { # this loops over each link collected from the index
my $r = $ua->get($page);
if ($r->is_success) {
my $stream = HTML::TokeParser->new(\$r->content) or die "Parse error in $page: $!";
# just printing what was collected
print Dumper get_thread($stream);
print "Content-type: text/html\n\n";
print "surfer variablen stream PRINT: $stream \n";
} else {
warn $r->status_line;
}
}
sub get_thread {
my $p = shift;
my ($title, $name, @thread);
while (my $tag = $p->get_tag('a','span')) {
if (exists $tag->[1]{'class'}) {
if ($tag->[0] eq 'span') {
if ($tag->[1]{'class'} eq 'name') {
$name = $p->get_trimmed_text('/span');
} elsif ($tag->[1]{'class'} eq 'postbody') {
my $post = $p->get_trimmed_text('/span');
push @thread, {'name'=>$name, 'post'=>$post};
}
} else {
if ($tag->[1]{'class'} eq 'maintitle') {
$title = $p->get_trimmed_text('/a');
}
}
}
}
return {'title'=>$title, 'thread'=>\@thread};
}
sub get_threads {
my $page = shift;
my $r = $ua->request(HTTP::Request->new(GET => $url), sub {$lp->parse($_[0])});
# Expand URLs to absolute ones
my $base = $r->base;
return [map { $_ = url($_, $base)->abs; } @links];
}
sub wanted_links {
my($tag, %attr) = @_;
return unless exists $attr{'href'};
return if $attr{'href'} !~ /^viewtopic\.php\?t=/;
push @links, values %attr;
}
Datum: 01.10.2006-11:16
subroutine von useragent einstellen
