Re: URLs aus über 200.000 Dateien extrahieren

[David Haller <lists@dhaller.de>]

Hallo,

Am Wed, 11 May 2005, Tilo Schwarz schrieb:
>On Tue, 10 May 2005 16:44:12 +0200, Michelle Konzack  
><linux4michelle@freenet.de> wrote:
>>Nur habe ich keine Zeit jetzt auch noch Python oder gar Perl zu lernen.
>
>Na dann woll'n wir mal ;-)
>
>Ich hab kurz was zusammengebastelt, das folgendes generiert:
>
>% python ~/tmp/mboxhttp.py 2005-04.mbs | head
[..]
>Ich hab das mal mit
>% find -name "*.mbs" -exec python ~/tmp/mboxhttp.py {} \;
>über meine ca. 10000 Mails laufen lassen. Da tut's, was nicht heißt, das  
>es da keine Fehler mehr gäbe. (Die Tücke sind kaputte (multipart-) Mails  
>etc.).

Nett, ich glaub, ich sollte mir python doch mal genauer anschauen :)

Dann will ich auch mal in perl, der Vollstaendigkeit halber ;)

Das script hab ich jetzt (man achte auf die Uhrzeit ;) aber nur
minimal getestet (geschweige denn optimiert), d.h. mal ueber ne
"spam"-mbox und debian-user-german (die letzten ~1600 Mails) laufen
lassen. V.a. die "Fortschrittsanzeige" ist verbesserungswuerdig ;)

dh@slarty[3]: ~/mail (0)$ mboxhttp.pl debian-de | head -n 8
http://IP-Adresse:3000
http://Iranians.yourbespils.info/?intriguedxtvuyoctahedronzsvoverflows
http://amavis.org/)
http://blog.emmily.com
http://broadband.afterhoursdjs.org:8008/
http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=238597
http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=293808
http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=296544

Hm. Warum bei dem amavis.org noch das ')' auftaucht? Naja, ich hab
Regex::Common::URI nicht geschrieben ;)

-dnh

-- 
Wie heisst der Super-Satz mit dem man eine Beziehung sowohl anfangen
als auch beenden kann?
Was für ein Arsch!             -- Ivy's Bar [http://www.ivys-bar.de]

#!/usr/bin/env perl
use warnings;
use strict;

use MIME::Parser;
use Regexp::Common qw(URI);
use Email::Folder::Mbox;

my %URLS;

my $parser = new MIME::Parser;
$parser->tmp_to_core(1);
$parser->output_to_core(1);
$parser->extract_uuencode(1);
$parser->extract_nested_messages(1);

my $box = new Email::Folder::Mbox($ARGV[0]) or die "$!\n";

sub geturls {
  my $entity = shift;
  if( $entity->mime_type() =~ /text/ ) {
    map {
      if (/($RE{URI}{HTTP})/) { $URLS{$1}++; }
    } split(/\s/, $entity->as_string());
  }
}

while ( my $msg = $box->next_message() ) {
  print STDERR "."; # give user some feedback, as output is
                    # delayed due to sorting...
  my $entity = $parser->parse_data($msg);
  if( $entity->is_multipart ) {
    foreach( $entity->parts ) { geturls($_); }
  } elsif( $entity->mime_type() =~ /text/ ) {
    geturls($entity);
  }
}

print STDERR "\n";

print join("\n", sort keys %URLS), "\n";