#!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; }