6 # (c) 10/2003-10/2004 Thomas Hochstein <thh@inter.net>
8 # This program is free software; you can redistribute it and/or modify it under
9 # the terms of the GNU General Public License as published by the Free
10 # Software Foundation; either version 2 of the License, or (at your option)
12 # This program is distributed in the hope that it will be useful, but WITHOUT
13 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
17 # Modules #############################
19 use Date::Manip qw(Date_Init ParseDate Date_Cmp DateCalc UnixDate Delta_Format Date_DaysInMonth);
24 use MIME::Words qw(decode_mimewords);
26 # Versionsnummer ######################
27 $ver = '0.17 beta (20041003)';
29 # Konstanten #########################
31 $hex_nibb = '[0-9a-fA-F]';
32 $gt_hex_nibb = '[0-9A-F]';
33 $lt_hex_nibb = '[0-9a-f]';
34 $alpha_num = '[0-9a-zA-Z]';
35 $lt_alpha_num = '[0-9a-z]';
36 $gt_alpha_num = '[0-9A-Z]';
37 %reporttitel = ('newsgroups' => 'Newsgroupnutzung',
38 'poster' => 'Poster (strukturiert)',
39 'posterraw' => 'Poster (unstrukturiert)',
40 'subject' => 'Subjects (strukturiert)',
41 'newsreader' => 'Newsreader (strukturiert)',
42 'nruser' => 'Nutzer pro Newsreader (strukturiert)');
44 # Variablen ###########################
49 # $config{'newsgroup'} = '';
50 # $config{'start'} = '';
51 # $config{'stop'} = '';
52 $config{'recursive'} = 0;
53 $config{'pipeformat'} = 'mbox';
54 $config{'charset'} = 'ISO-8859-1';
55 $config{'tz'} = '+0200';
56 $config{'graphchar'} = '#';
59 @reports = ('newsgroups','poster','posterraw','subject','newsreader','nruser');
60 foreach $report (@reports) {
62 $config{$report.'_width'} = 30;
63 $config{$report.'_indent'} = 2;
64 $config{$report.'_lines'} = 0;
65 $config{$report.'_cutoff'} = 0;
66 $config{$report.'_graph'} = 20;
68 $config{'newsgroups'} = 0;
69 $config{'posterraw'} = 0;
70 $config{'unknownreader'} = 'show';
72 # Hauptprogramm #######################
73 # Konfiguration einlesen
75 getopts('hqc:r:w:', \%options);
77 print "$0 v $ver\nUsage: $0 [-hq] [-w|r <savefile>] [-c <configfile>]\n";
80 print STDERR "$0 v $ver [" . scalar(gmtime) . "]\n(c) 10/2003-10/2004 Thomas Hochstein * <thh\@inter.net>\n" if (!$options{'q'});
82 &readconfig($options{'c'});
84 if (length($config{'graphchar'}) > 1 or $config{'graphchar'} eq '') {
85 $config{'graphchar'} = '#';
88 $config{'charset'} = uc($config{'charset'});
89 $supported = Locale::Recode->getSupported;
90 if (!scalar(grep /$config{'charset'}/, @{$supported})) {
91 print STDERR "ERROR: unknown charset $config{'charset'}\n";
92 $config{'charset'} = 'ISO-8859-1';
95 &Date_Init("TZ = $config{'tz'}");
98 @postings = @{&readdata($options{'r'})};
99 print STDERR "\n>>>>> Data loaded.\n\n" if (!$options{'q'});
102 if (exists($config{'spooldir'})) {
103 if ($config{'recursive'}) {
104 @postings = @{&get_spool_recursive($config{'spooldir'})};
106 @postings = @{&get_spool($config{'spooldir'})};
109 @postings = @{&get_stdin($config{'pipeformat'})};
111 print STDERR "\n>>>>> Data parsed.\n\n" if (!$options{'q'});
113 # Daten speichern, falls verlangt
115 &writedata($options{'w'},\@postings);
126 foreach $posting (@postings) {
127 %header = %{$posting};
128 &day($header{'date'}) if $config{'day'};
129 &newsgroups($header{'newsgroups'}) if $config{'newsgroups'};
130 &poster($header{'from'}) if ($config{'poster'} or $config{'posterraw'});
131 &subject($header{'subject'}) if $config{'subject'};
132 &client($posting) if ($config{'newsreader'} or $config{'nruser'});
135 # Nutzer pro Newsreader ermitteln
136 if ($config{'nruser'}) {
137 foreach $user (keys %userreader) {
138 $nruser{$userreader{$user}}++;
139 if (length($userreader{$user}) > $nruserlgth) { $nruserlgth = length($userreader{$user}); };
141 #D print "!> $user: $userreader{$user}\n";
145 print STDERR "\n>>>>> Data analyzed.\n\n" if (!$options{'q'});
148 $output = "Auswertung";
149 if ($config{'newsgroup'}) { $output .= " für $config{'newsgroup'}"; };
150 print center($output);
151 if ($config{'start'} || $config{'stop'}) {
153 if ($config{'start'}) { $output .= "von $config{'start'} "; };
154 if ($config{'stop'}) { $output .= "bis $config{'stop'}"; };
155 print center($output);
157 print center("=" x length($output))."\n";
159 # Postings pro Tag ermitteln und ausgeben
160 if ($config{'day'}) {
161 print center("Postings pro Tag");
162 print center("----------------");
163 &Date_Init("Language = German");
164 $postcount = 0; $firstday = 0; $lastday = 0; $lastkw = 0; $lastmonat = 0;
165 foreach $day (sort keys %datecount) {
166 $firstday = $day if ($lastday == 0);
167 $monat = UnixDate($day,"%B %Y");
168 if ($monat ne $lastmonat) {
169 if ($postcount > 0) {
170 printf "\n\nPostings %-14s: %d (%.2f pro Tag)\n",$lastmonat,$postcount,($postcount / Date_DaysInMonth(UnixDate($lastday,"%m"),UnixDate($lastday,"%Y")));
173 print "\n\n".center($monat,50)."\n";
174 print " KW : Mo : Di : Mi : Do : Fr : Sa : So :\n";
175 print "------------------------------------------------";
177 $kw = UnixDate($day,"%W");
178 if ($kw != $lastkw && $lastkw > 0 && $monat eq $lastmonat) {
179 for ($i=$lastkw+1; $i < $kw; $i++) {
180 printf "\n %2.2d :",$i;
183 if ($kw != $lastkw || $monat ne $lastmonat) {
184 printf "\n %2.2d :",$kw;
185 print " " x (6*(UnixDate($day,"%w")-1));
186 } elsif ($lastday != 0 && $day-$lastday > 1) {
187 print " " x (6*($day-$lastday-1));
189 printf " %5.5s",$datecount{$day};
190 $postcount += $datecount{$day};
195 if ($postcount > 0) {
196 printf "\n\nPostings %-14s: %d (%.2f pro Tag)\n",$lastmonat,$postcount,($postcount / Date_DaysInMonth(UnixDate($lastday,"%m"),UnixDate($lastday,"%Y")));
198 $daycount = Delta_Format(DateCalc(ParseDate($firstday),ParseDate($lastday)),0,'%dh');
199 #D print STDERR "$daycount = $lastday - $firstday\n";
201 if (scalar(@postings)) {
202 printf "Postings insgesamt: %d (%.2f pro Tag)\n\n\n",scalar(@postings),scalar(@postings)/$daycount;
204 print "Keine Postings erfasst.\n\n\n";
207 #D print &format_table(\%datecount,scalar(@postings),8,50,2,0,0);
209 # restliche Reports ausgeben
210 foreach $report (@reports) {
211 if ($config{$report}) {
212 print center($reporttitel{$report});
213 print center("-" x length($reporttitel{$report}))."\n";
214 $reportlgth = $report.'lgth';
215 $reportsum = $report.'sum';
216 $$reportsum = scalar(@postings) unless defined($$reportsum);
217 print &format_table(\%$report,$$reportsum,$$reportlgth,$config{$report.'_width'},$config{$report.'_indent'},$config{$report.'_lines'},$config{$report.'_cutoff'},$config{$report.'_graph'});
222 print "-- \n$0 v $ver [" . scalar(gmtime) . "]\n(c) 10/2003-10/2004 Thomas Hochstein * <thh\@inter.net>\n";
225 # Subroutinen #########################
228 # Header aus Postings auslesen (gepipete Datei)
230 # (MBOX-File oder data.dat, gepiped in STDIN)
231 # OUT: Referenz auf @postings, das jeweils
232 # Referenzen auf %header (die Header) enthält
233 my $format = shift; # Format der zu verarbeitenden Datei
234 my ($trigger,$hname,$hcontents,%header,@postings,%midcache,$exit);
235 if ($format eq 'hamster') {
236 $trigger = '^.{4}X-Hamster-Info: ';
239 $trigger = '^From \S+\@\S+ ';
242 # Neues Posting beginnt?
247 # Leerzeile = Header beendet
248 if (/^$/) {last PARSELOOP; }
250 # Gefoldete Header an letzten anhängen
253 # $header{lc($hname)} .= "\n\t$_";
255 $header{lc($hname)} .= $_;
257 $header{lc($hname)} .= " $_";
261 ($hname,$hcontents) = split /:/,$_,2;
262 $hcontents =~ s/^\s*(.+)/$1/;
263 # richtige Newsgroup, falls gesetzt?
264 if (exists($config{'newsgroup'}) && $config{'newsgroup'} ne '' && lc($hname) eq 'newsgroups' && lc($hcontents) !~ /$config{'newsgroup'}/) {
265 #D print STDERR "ERROR: not $config{'newsgroup'}\n";
268 # richtiger Datumsbereich, falls gesetzt?
269 } elsif (lc($hname) eq 'date' && ((exists($config{'start'}) && $config{'start'} ne '' && Date_Cmp($hcontents,$config{'start'}) < 0) or (exists($config{'stop'}) && $config{'stop'} ne '' && Date_Cmp($hcontents,$config{'stop'}.' 23:59:59') > 0))) {
270 #D print STDERR "ERROR: $hcontents not between $config{'start'} and $config{'stop'}\n";
273 # Posting schonmal erfasst? MID-cache
274 } elsif (lc($hname) eq 'message-id' && exists($midcache{$hcontents})) {
275 #D print STDERR "ERROR: $hcontents was already cached\n";
279 $header{lc($hname)} = $hcontents;
282 #D $count++; print "--$count--".$header{'message-id'}."\n";
283 # Referenz auf Kopie von %header in @postings einhängen & MID cachen
285 #D print "! $header{'message-id'}\n";
286 #D print "> $header{'from'}\n";
287 #D print "> $header{'newsgroups'}\n";
288 #D print "> $header{'date'}\n";
290 $midcache{$header{'message-id'}}++;
291 push @postings, { %header };
300 # Header aus Postings auslesen (Dateien im Spool)
302 # OUT: Referenz auf @postings, das jeweils
303 # Referenzen auf %header (die Header) enthält
304 # Globale Variablen, die gesetzt werden:
306 my $verzeichnis = shift;
307 my ($file,$hname,$hcontents,%header,@postings,$exit);
308 opendir(SPOOL,$verzeichnis) || print STDERR "ERROR: Could not open spool directory $verzeichnis: $!";
310 while(defined($file = readdir(SPOOL))) {
311 if($file =~/^\./) { next FILELOOP; };
312 #D print "!-> $file\n";
313 open POSTING, "<$verzeichnis/$file" || print STDERR "ERROR: Could not open article file $verzeichnis/$file for reading: $!";
317 # Leerzeile = Header beendet
318 if (/^$/) {last PARSELOOP; }
320 # Gefoldete Header an letzten anhängen
323 # $header{lc($hname)} .= "\n\t$_";
325 $header{lc($hname)} .= $_;
327 $header{lc($hname)} .= " $_";
331 ($hname,$hcontents) = split /:/,$_,2;
332 $hcontents =~ s/^\s*(.+)/$1/;
333 # richtige Newsgroup, falls gesetzt?
334 if (exists($config{'newsgroup'}) && $config{'newsgroup'} ne '' && lc($hname) eq 'newsgroups' && lc($hcontents) !~ /$config{'newsgroup'}/) {
335 #D print STDERR "ERROR: not $config{'newsgroup'}\n";
338 # richtiger Datumsbereich, falls gesetzt?
339 } elsif (lc($hname) eq 'date' && ((exists($config{'start'}) && $config{'start'} ne '' && Date_Cmp($hcontents,$config{'start'}) < 0) or (exists($config{'stop'}) && $config{'stop'} ne '' && Date_Cmp($hcontents,$config{'stop'}).' 23:59:59' > 0))) {
340 #D print STDERR "ERROR: $hcontents not between $config{'start'} and $config{'stop'}\n";
343 # Posting schonmal erfasst? MID-cache
344 } elsif (lc($hname) eq 'message-id' && exists($midcache{$hcontents})) {
345 #D print STDERR "ERROR: $hcontents was already cached\n";
349 $header{lc($hname)} = $hcontents;
352 # Referenz auf Kopie von %header in @postings einhängen & MID cachen
354 $midcache{$header{'message-id'}} = 1 ;
355 push @postings, { %header };
358 # print "! $header{'message-id'}\n";
359 # print "> $header{'from'}\n";
366 sub get_spool_recursive {
367 # Header aus Postings auslesen (Dateien im Spool, mehrere Spoolverzeichnisse)
368 # ruft &get_spool rekursiv auf
369 # IN: $wurzelverzeichnis
370 # OUT: Referenz auf @postings, das jeweils
371 # Referenzen auf %header (die Header) enthält
372 my $wurzelverzeichnis = shift;
373 my (@verzeichnisse, $verzeichnis);
374 find sub { -d $File::Find::name && push @verzeichnisse, $File::Find::name }, $wurzelverzeichnis;
375 foreach $verzeichnis (@verzeichnisse) {
376 push @postings, @{&get_spool($verzeichnis)};
382 # Postings pro Tag ermitteln
383 # IN: Date:-Header des jeweiligen Postings
385 # Globale Variablen, die gesetzt werden:
388 if ($datum = UnixDate($datum,"%Y%m%d")) {
389 $datecount{$datum}++;
391 #D print ">> $datum\n";
396 # Poster (mit vollem From + nur mit Namen) auswerten
397 # IN: From:-Header des jeweiligen Postings
399 # Globale Variablen, die gesetzt werden:
406 ($from) = Mail::Address->parse($from);
407 if (defined($from)) {
408 # Postings pro Poster (nach Namen im From:)
409 $name = $from->format;
411 $name = '(unbekannt)';
413 if ($name eq '') { $name = '(unbekannt)'; };
415 if (length($name) > $posterrawlgth) { $posterrawlgth = length($name); };
416 if (defined($from)) {
417 # Postings pro Poster (nach From:)
418 $name = &mime_decode($from->name);
420 #D print "::>> $name\n";
422 if (length($name) > $posterlgth) { $posterlgth = length($name); };
423 #D print "!> $address : $name\n";
429 # IN: Subject:-Header des jeweiligen Postings
431 # Globale Variablen, die gesetzt werden:
436 $subject = &mime_decode($subject);
437 $subject =~ s/^(re|aw): (.+)/$2/i;
438 # Postings mit entsprechendem Subject
439 $subject{$subject}++;
440 if (length($subject) > $subjectlgth) { $subjectlgth = length($subject); };
441 #D print "!> $subject\n";
446 # Newsgroup auswerten
447 # IN: Newsgroup:-Header des jeweiligen Postings
449 # Globale Variablen, die gesetzt werden:
453 # Newsgroup decodieren - wohl nicht erforderlich?
455 my $newsgroups = shift;
456 #D print "!> $newsgroup\n";
457 # $newsgroups = &mime_decode($newsgroups);
458 my @newsgroups = split /,/,$newsgroups;
459 # Postings in entsprechende Newsgroups
460 foreach $newsgroup (@newsgroups) {
461 # auch Crossposts als Inkarnation zählen
464 $newsgroups{$newsgroup}++;
465 if (length($newsgroup) > $newsgroupslgth) { $$newsgroupslgth = length($newsgroup); };
466 #D print "--> $newsgroup\n";
472 # Newsreader zu ermitteln versuchen
473 # IN: Referenz auf %header des jeweiligen Postings
475 # Globale Variablen, die gesetzt werden:
480 my %header = %{$posting};
482 # zutreffenden Header ermitteln, mit Präzedenz User-Agent -> X-Newsreader -> X-Mailer
483 if (defined($header{'user-agent'}) && $header{'user-agent'} !~ /^hamster/i) {
484 $newsreader = &mime_decode($header{'user-agent'});
485 } elsif(defined($header{'x-newsreader'})) {
486 $newsreader = &mime_decode($header{'x-newsreader'});
487 } elsif(defined($header{'x-mailer'})) {
488 $newsreader = &mime_decode($header{'x-mailer'});
490 # Newsreader zu ermitteln versuchen
491 if ((defined($newsreader)) and ($newsreader ne '')) {
492 #D print "! $newsreader\n";
494 $newsreader = 'Outlook Express', last KNOWN if $newsreader=~/Outlook Express/i;
495 $newsreader = 'Mozilla', last KNOWN if ($newsreader=~/Mozilla/i and $newsreader!~/StarOffice/i);
496 $newsreader = 'Star Office', last KNOWN if ($newsreader=~/Mozilla/i and $newsreader =~/StarOffice/i);
497 $newsreader = 'Forté Agent', last KNOWN if ($newsreader=~/Forte.*Agent/i or $header{'message-id'}=~/^[a-zA-Z0-9=+]{28,34}\@/ or $header{'message-id'}=~/^$lt_alpha_num{8}\.\d{7,9}\@/o or $header{'message-id'}=~/^$lt_alpha_num{7}\.\d{2,3}\.\d\@/o);
498 $newsreader = 'Xnews', last KNOWN if ($newsreader=~/Xnews/i or $header{'message-id'}=~/^$lt_alpha_num{6}\.$lt_alpha_num{2}\.\d\@/o);
499 $newsreader = 'Gnus', last KNOWN if ($newsreader=~/Gnus/i or $header{'message-id'}=~/^$lt_alpha_num{10,11}\.fsf\@/o);
500 $newsreader = 'slrn', last KNOWN if ($newsreader=~/slrn/i or $header{'message-id'}=~/^slrn$lt_alpha_num{6}\.$lt_alpha_num{2,3}\.\w+\@/o);
501 $newsreader = 'MacSOUP', last KNOWN if ($newsreader=~/MacSOUP/i or $header{'message-id'}=~/^$lt_alpha_num{7}\.$lt_alpha_num{13,14}[A-Z]\%[a-zA-Z\.]+\@/o);
502 $newsreader = 'Gravity', last KNOWN if ($newsreader=~/Gravity/i or $header{'message-id'}=~/^MPG\.$lt_hex_nibb{22}\@/o);
503 $newsreader = 'Pine', last KNOWN if ($newsreader=~/Pine/i or $header{'message-id'}=~/^Pine\.$gt_alpha_num{3}\.\d\.\d{2}\.\d{14}\.\d{4,5}-\d{6}\@/o);
504 $newsreader = 'Crosspoint', last KNOWN if ($newsreader=~/Crosspoint/i or $header{'message-id'}=~/^[a-zA-Z0-9\$\-]{11}\@/o);
505 $newsreader = 'Crosspoint/OpenXP', last KNOWN if ($newsreader=~/OpenXP/);
506 $newsreader = 'Pan', last KNOWN if ($newsreader=~/Pan/);
507 $newsreader = 'Fortitude Dialog', last KNOWN if ($newsreader=~/Dialog/i);
508 $newsreader = 'tin', last KNOWN if ($newsreader=~/tin\//);
509 $newsreader = 'KNode', last KNOWN if ($newsreader=~/KNode/);
510 $newsreader = 'Opera', last KNOWN if ($newsreader=~/Opera/);
511 $newsreader = 'Freenet-Webnews', last KNOWN if ($newsreader=~/Freenet-Webnews/i);
512 $newsreader = 'NewsFleX', last KNOWN if ($newsreader=~/NewsFleX/i);
513 $newsreader = 'knews', last KNOWN if ($newsreader=~/knews/i);
514 $newsreader = 'WinVN', last KNOWN if ($newsreader=~/WinVN/i);
515 $newsreader = 'nn', last KNOWN if ($newsreader=~/nn\//);
516 $newsreader = 'Lotus Notes', last KNOWN if ($newsreader=~/Lotus.*Notes/);
517 $newsreader = 'NewsPortal', last KNOWN if ($newsreader=~/NewsPortal/i);
518 $newsreader = 'ProNews', last KNOWN if ($newsreader=~/ProNews/i);
519 $newsreader = 'Sylpheed', last KNOWN if ($newsreader=~/Sylpheed/i);
520 print STDERR "Unknown Newsreader: $newsreader\n" if (!$options{'q'});
521 if($config{'unknownreader'} eq 'show') {
522 # $newsreader ist ja schon gesetzt
524 $newsreader = '(Sonstiger)';
528 $newsreader = '(keine Angabe)'
530 # Usernamen ermitteln und Newsreader dieses Nutzers setzen
531 # (bei versch. Newsreadern zählt also der letzte)
532 ($from) = Mail::Address->parse($header{'from'});
533 if (defined($from)) {
534 $name = $from->format;
535 $userreader{$name} = $newsreader;
536 #D print "> $userreader{$name}\n";
538 #D print "> $newsreader\n";
539 if (length($newsreader) > $newsreaderlgth) { $newsreaderlgth = length($newsreader); };
540 $newsreader{$newsreader}++;
545 # Text mittig formatieren
547 # OUT: (zentrierter Text)
548 my $text = shift; # Text
549 my $width = shift; # Breite der Spalte
551 $width ||= 70; # Defaultbreite: 70
552 return ' 'x(($width-length($text))/2).$text."\n";
556 # Tabelle formatieren
557 # IN: \%values, $sum, $longest, $maxwidth, $indent, $lines, $cutoff, $graph
558 # OUT: $output (formatierte Tabelle)
559 my $values = shift; # Referenz auf %values
560 my $sum = shift; # Gesamtsumme (fuer Prozentwert)
561 my $longest = shift; # Längster Index von %values
562 my $maxwidth = shift; # Maximale Spaltenbreite für den Index
563 my $indent = shift; # Einzug links
564 my $lines = shift; # Maximale Zeilenzahl der Tabelle
565 my $cutoff = shift; # Minimaler anzuzeigender Wert
566 my $graphwidth = shift; # Spaltenbreite für Graph
567 my %values = %{$values};
568 my ($output,$value,$outputvalue,$valuelongest,$place,$outputplace,$lastvalue,$notdisplayed,$percent,$maxpercent,$graph,$graphlength);
569 # $maxwidth auf minimal 10 setzen und $longest an $maxwidth anpassen
571 if ($maxwidth < 10) { $maxwidth = 10; };
572 if ($longest > $maxwidth) { $longest = $maxwidth; };
574 # $lines auf minimal 3 setzen
575 if ($lines > 0 && $lines < 3) { $lines = 3; };
578 foreach $value (sort {$values{$b} <=> $values{$a}} keys %values) {
579 # Prozentzahl berechnen
580 $percent = 100*$values{$value}/$sum;
581 # Platzziffer setzen, ggf. unterdrücken, falls selber Wert wie zuvor
582 $place++; $outputplace = '';
583 if ($lastvalue != $values{$value}) { $outputplace = $place.'.'; };
584 $outputvalue = $value;
585 # Platz 1 hat größten Wert -> höchste Breite für Wertespalte und höchsten Prozentwert ermitteln
587 $valuelongest = length($values{$value});
588 $maxpercent = $percent;
590 # falls Index zu breit: kürzen und "[...]" anhängen
591 if ($maxwidth > 0 && length($value) > $maxwidth) {
592 $outputvalue = substr($value,0,$maxwidth-5)."[...]";
594 # Balkengrafik generieren
595 if ($graphwidth > 0) {
596 $graphlength = int($percent*$graphwidth/$maxpercent);
597 $graph = '|'.$config{'graphchar'}x$graphlength.' 'x($graphwidth-$graphlength).'|';
601 # Zeilen ausgeben, bis maximale Zeilenzahl oder Grenzwert erreicht (in letzterem Fall aber mind. 1 Zeile)
602 if (($lines < 1 || $place <= $lines) && ($cutoff < 1 || $place < 2 || $values{$value} >= $cutoff)) {
603 $output .= ' 'x$indent.sprintf "%4s %-${longest}s: %${valuelongest}s (%5.2f%%) %${graphwide}s\n", $outputplace, $outputvalue, $values{$value}, $percent, $graph;
604 # falls Zeile nicht mehr ausgegeben: mitzählen
608 $lastvalue = $values{$value};
611 if (($lines > 0 && $place > $lines) or ($cutoff > 0 && $lastvalue < $cutoff)) {
612 $output .= ' 'x($indent+4)."(+ $notdisplayed weitere";
613 if ($cutoff > 0 || $values{$value} < $cutoff) {
614 $output .= " mit < $cutoff";
618 $output .= ' 'x$indent.'-'x(16+$longest+$valuelongest)."\n";
619 $output .= ' 'x($indent+6+$longest).sprintf "%${valuelongest}s ( 100% )\n", $sum;
624 # Konfigurationsdatei auslesen
625 # IN: Name der Konfigurationsdatei
627 # Globale Variablen, die gesetzt werden:
629 my $conffile = shift;
631 open CONFIG, "<$conffile" || print STDERR "ERROR: Could not open config file $conffile for reading: $!";
633 print STDERR "ERROR: Config file $conffile does not exist!\n";
642 my($option,$value) = split(/\s*=\s*/, $_, 2);
643 $config{$option} = $value;
644 #D print "$option: $value\n;"
651 # Header mit MIME-Words decodieren
652 # IN: $mimeheader - potentiell codierter Header
653 # OUT: $decoded - decodierte Zeile
654 my $mimeheader = shift;
655 my ($mimeword, $decoded);
656 foreach $mimeword (decode_mimewords($mimeheader)) {
657 my ($data, $encoding) = @{$mimeword};
658 #D printf "Enc: %12s %s \n", $encoding, $data;
659 if ($encoding ne '') {
660 $encoding = uc($encoding);
661 my $convert = Locale::Recode->new (from => $encoding,
662 to => $config{'charset'});
663 print STDERR 'Recode: '.$convert->getError."\n" if $convert->getError;
664 $convert->recode ($data) or print STDERR 'Recode: '.$convert->getError."\n";
665 #D printf " >>> %12s %s \n", $encoding, $data;
673 # --> Perl-Kochbuch, Rezept 11.10
674 # Datendatei (Header) schreiben
675 # IN: $datei - Name der Datendatei
676 # Referenz auf @postings
679 my $postingr = shift;
680 my @postings = @{$postingr};
681 open DATEI, ">$datei" || print STDERR "ERROR: Could not open file $datei for writing: $!";
682 foreach $posting (@postings) {
683 for $header (sort keys %{$posting}) {
684 print DATEI "$header: $posting->{$header}\n";
693 # --> Perl-Kochbuch, Rezept 11.10
694 # Datendatei (Header) einlesen
695 # IN: $datei - Name der Datendatei
696 # OUT: Referenz auf @postings, das jeweils
697 # Referenzen auf %header (die Header) enthält
699 open DATEI, "<$datei" || print STDERR "ERROR: Could not open file $datei for reading: $!";
702 my @fields = split /^([^:]+):\s*/m;
704 push(@postings, {map/(.*)/, @fields});