Subversion Repositories LCARS

Rev

Rev 10 | Rev 14 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 10 Rev 11
Line 21... Line 21...
21
21
22
############################################################################
22
############################################################################
23
#                       RECENT CHANGES                                     #
23
#                       RECENT CHANGES                                     #
24
# 2011-10-03  PE  - Use more compatible shebang
24
# 2011-10-03  PE  - Use more compatible shebang
25
#                 - Fixed some Perl::Critic-ized code
25
#                 - Fixed some Perl::Critic-ized code
26
#                 - Fixed wrong indent for non-ASCII names (TODO: proper dot count)
26
#                 - Fixed wrong indent for non-ASCII names
27
#                 - Formatted source code
27
#                 - Formatted source code
28
# 2011-07-03  PE  - Use Encode to decode/encode MIME encodings
28
# 2011-07-03  PE  - Use Encode to decode/encode MIME encodings
29
#                 - Use warnings, utf8 (just in case)
29
#                 - Use warnings, utf8 (just in case)
30
#                 - Documentation update
30
#                 - Documentation update
31
# N/A         NN  - Take newsgroup name as argument
31
# N/A         NN  - Take newsgroup name as argument
Line 553... Line 553...
553
sub getdata
553
sub getdata
554
{
554
{
555
#### First, analyse header fields ####
555
#### First, analyse header fields ####
556
556
557
  # Set up this poster if not defined, get counts, sizes
557
  # Set up this poster if not defined, get counts, sizes
558
  my $poster = encode( 'UTF-8', $headers{From} );    # get the poster's name
558
  my $poster = $headers{From};    # get the poster's name
559
  if ( !defined( $data{$poster} ) )
559
  if ( !defined( $data{$poster} ) )
560
  {                                                  # seen this one before?
560
  {                                   # seen this one before?
561
    $data{$poster}{agent}  = 'Unknown';              # comes after For: field
561
    $data{$poster}{agent}  = 'Unknown';    # comes after For: field
562
    $data{$poster}{orig}   = 0;
562
    $data{$poster}{orig}   = 0;
563
    $data{$poster}{quoted} = 0;
563
    $data{$poster}{quoted} = 0;
564
  }
564
  }
565
  $data{$poster}{count}++;    # bump count for this poster
565
  $data{$poster}{count}++;                 # bump count for this poster
566
  $data{$poster}{size} += $filesize;    # total size of file
566
  $data{$poster}{size} += $filesize;       # total size of file
567
567
568
  # The User-Agent and/or X-Newsreader fields
568
  # The User-Agent and/or X-Newsreader fields
569
  # for User-Agent by poster
569
  # for User-Agent by poster
570
  if ( defined $lcheader{"user-agent"} )
570
  if ( defined $lcheader{"user-agent"} )
571
  {
571
  {
Line 691... Line 691...
691
  {
691
  {
692
    $crossposts{$_}++;    # bump count for each
692
    $crossposts{$_}++;    # bump count for each
693
  }
693
  }
694
694
695
  # Get threads
695
  # Get threads
696
  my $thread = encode( 'UTF-8', $headers{"Subject"} );
696
  my $thread = $headers{"Subject"};
697
  $thread =~ s/^re: //i;    # Remove Re: or re: at start
697
  $thread =~ s/^re: //i;    # Remove Re: or re: at start
698
  $thread =~ s/\s+/ /g;     # collapse whitespace
698
  $thread =~ s/\s+/ /g;     # collapse whitespace
699
  $threads{$thread}{count} += 1;            # bump count of this subject
699
  $threads{$thread}{count} += 1;            # bump count of this subject
700
  $threads{$thread}{size}  += $filesize;    # bump bytes for this thread
700
  $threads{$thread}{size}  += $filesize;    # bump bytes for this thread
701
701
Line 796... Line 796...
796
##############################
796
##############################
797
# right pad a string with '.'s
797
# right pad a string with '.'s
798
##############################
798
##############################
799
sub rpad
799
sub rpad
800
{
800
{
801
-
 
802
  # get text to pad, length to pad, pad chr
801
  # get text to pad, length to pad, pad chr
803
  my ( $text, $pad_len, $pad_chr ) = @_;
802
  my ( $text, $pad_len, $pad_chr ) = @_;
-
 
803
-
 
804
  ### DEBUG
-
 
805
#  printf "|%s| = %d\n", $text, length($text);
-
 
806
804
  if ( length($text) > $pad_len )
807
  if ( length($text) > $pad_len )
805
  {
808
  {
806
    $text = substr( $text, 0, $pad_len );
809
    $text = substr( $text, 0, $pad_len );
807
  }
810
  }
808
  my $padded = $text . $pad_chr x ( $pad_len - length($text) );
811
  my $padded = $text . $pad_chr x ( $pad_len - length($text) );