Thread Fragen eines Perl Fans (21 answers)
Opened by der_thomas at 2013-09-07 01:46

topeg
 2013-09-07 13:04
#169968 #169968
User since
2006-07-10
2611 Artikel
BenutzerIn

user image
Das man in Perl wie Kraut und Rüben programmieren kann ist seine größte stärke und seine größte schwäche. :-)

Mal eben schauen welche Dateien auf dem Server sind?
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14

#!/usr/bin/perl
use LWP::Simple; use URI::URL;
@l=(URI::URL->new($ARGV[0]));
while(@l) {
  $url=shift(@l) and !$sites{$url}++ and $html=get($url) and do{
    while($html=~s/(href|src)\s*=\s*['"]((?!javascript|mailto).+?)['"]//) {
      ($t,$n)=($1,URI::URL->new($2,$url)->abs());
      $n->params(undef); 
      $n->query(undef);
      $n->host() eq $url->host() and ( $t eq 'href'?push(@l,$n):$sites{$n}++ );
    }
  }
}
print "$_\n" for sort keys %sites;

Weniger als 20 Zeilen und man hat was man will. Das ist aber kein Code den man weiter geben sollte. Völlig undokumentiert, keine Fehlerbehandlung, Globale Variablen, schlechter HTML-Parser und nach zwei Tagen muss man in die Dokus schauen um zu wissen was passiert.

Man kann aber auch ordentlich Programmieren:
more (13.9kb):
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67

#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
use URI::URL;
use HTML::TreeBuilder 5 -weak;

my $server=$ARGV[0];
die("Bitte Server angeben!\n") unless $server;

my $ua=LWP::UserAgent->new();
my %sites;
my @stack=(URI::URL->new($server));

while(@stack) {
  my $url = shift(@stack);
  next if $sites{$url};
  $sites{$url}++;

  my $res=$ua->get($url);
  if($res->is_error()) {
    warn "$url -> ".$res->status_message()."\n";
    next;
  }
  my $html=$res->decoded_content();
  next unless $html;

  # gehe alle HTML-Tags durch:
  HTML::TreeBuilder->new()->parse_content($html)->look_down(sub{

    # hole src-Verweis:
    my $new_src=bereinige_url($_[0]->attr('src'),$url);
    $sites{$new_src}++ if $new_src;

    # hole href-Verweis:
    my $new_href=bereinige_url($_[0]->attr('href'),$url);
    push(@stack,$new_href) if $new_href;

    return 0;
  });
}

# alle Verweise Ausgeben:
print "$_\n" for sort keys %sites;

########################################################################

sub bereinige_url {
  my ($link,$base)=@_;
  return undef unless $link and $base;
  return undef if $link=~/^(?:javascript|mailto)/s;

  my $url=URI::URL->new($link,$base);
  return undef unless $url;

  # absolute URL:
  $url=$url->abs();

  # auf dem selben Server bleiben:
  return undef if $base->host() ne $url->host();

  # entferne alle Parameter:
  $url->params(undef);
  $url->query(undef);

  return $url;
}


Wer weiß was er tut kann sehr schnell zu Lösungen kommen oder sehr dauerhafte Scripte schreiben. Wenn er nicht weiß was er tut kann viel Ärger und Arbeit für andere Produzieren.
Perl ist ein Werkzeugkasten. Wenn du mal eben einen Nagel in die Wand hauen willst, kannst du nach einem Hammer greifen oder nach einem Schraubenschlüssel. Es bleibt dir überlassen. Mit beiden bekommst du den Nagel in die Wand. :-)
Und es schadet auch nichts, das man einen Interpreter auf so ziemlich jedem Betriebssystem finden oder installieren kann.

View full thread Fragen eines Perl Fans