Patch Digest

[Olivier Salaun - CRU <adresse@cachée>]

En attendant la prochaine version de Sympa (les patchs s'entrecroisent :-\, 
je vous propose une évolution du mode Digest de Sympa conforme
au RFC 934 (burst utilisable). Entre autres améliorations :

        - Sommaire respectant l'ordre des messages
        - Présentation des seules entêtes principales des messages
          (From, Date, To)
        - Meilleur décodage du QP/Base64, utilisant les Librairies Perl
          MIME::Base64 et MIME::QuotedPrint

Le patch agit sur les fichiers List.pm, msg.pl et fr.msg (vous devrez
donc regénérer le catalogue avec gencat).

Le module Perl MIME-Base64 est nécessaire :
ftp://ftp.lip6.fr/pub/perl/CPAN/modules/by-module/MIME/


---------------------
Olivier Salaun - CRU

*** List.pm.orig        Wed Nov  4 16:11:00 1998
--- List.pm     Tue Dec  1 10:29:17 1998
***************
*** 437,608 ****
  
  ## Send a digest message to the subscribers with reception=digest
  sub send_msg_digest {
-    my($self, $file) = @_;
  
!    ## Who is the enveloppe sender ?
!    my $admin = $self->{'admin'};
!    my $host = $admin->{'host'} || $Conf{'host'};
!    my $name = "$self->{'name'}";
!    my $from = "$name-request\@$host";
!    my $to = "$name\@$host";
!    my $reply = "$name-owner\@$host";
!   ## verifications much later.
!    my @tabrcpt;
!    my @tabmsg;
!    my $nbkeys=0;
!    my $nblines=0;
!    my $etat=0;
!    my $index=0;
!    my %u;
!    my %tabsujet;
!    my($i, $j,$ligne,$sujet,$ind);
!    my $fichier="$Conf{'queuedigest'}/$file";
!    my @now  = localtime(time);
!    my @oldtime=localtime((stat $fichier)[9]);
!    my %convertiso=%msg::convertiso;
!    my $separator = $msg::separator;
!    my $separatorbis = $msg::separatorbis;
!    
!    # check the list
!    return unless($file eq $name);
! 
!    # make the tab of subscibers in digest mode
!    foreach $ind (keys %{$self->{'users'}}) {
!        %u = split(/\n/,$self->{'users'}->{$ind});
!        push(@tabrcpt, $ind) if ($u{'reception'} =~ /^(digest)$/i);
!    }
!  
!   # Open the digest file and make the index array in @tabsujet
! 
!    open(OLD,$fichier ) || return undef;
!    foreach $ligne (<OLD>){
!        $nblines++;
!        # push into an array in memory
!        push(@tabmsg, $ligne) unless ($etat==0 and $ligne =~/^$separator/i);
!        # try to find the number of messages digested in the file ...
!        if ($etat==0 and $ligne =~/^$separator/i){
!          $ligne=$separatorbis;
!          push(@tabmsg, $ligne);
!          $etat=1;
!          next;
!        }
!        if($etat==1 and $ligne =~/^\n/){
!          $etat=2;
!          next;
!        }else{
!          $etat=0 unless($etat==2);
!        }
!        
!        if ($etat==2 and $ligne 
=~/^Subject\:(\s*)?((\=\?iso\-8859\-1\?Q\?)?Re(\s*)?\:)?\s*(.*)/i) {
!          $sujet=$3.$5;
! 
! 
!          # CONVERT
!          if ($sujet=~ /\=\?iso\-8859\-1\?Q\?/i){
!              $sujet =~ s/\=\?iso\-8859\-1\?Q\?([^\?]*)\?\=/$1/ig;
!              $sujet =~ s/\=\?iso\-8859\-1\?Q\?(\S*(\s?(\S*)?){3})\?\=/$1/ig;
!              foreach $i (keys %convertiso) {
!                  $sujet=~ s/\=$i/$convertiso{$i}/ig;
!                  $sujet=~ s/\_/ /ig;
!              }
!          }
!          $sujet =~ s/^\s*//;
!          if (exists $tabsujet{$sujet}) {  
!              $tabsujet{$sujet}[0]++;
!              
!          }else{
!                  $tabsujet{$sujet}[0]=1; 
!              }
!              $etat=0;
!              
!          }
!          if($etat==2 and $ligne=~/^\n/){
!              $etat=0;
!              if (exists $tabsujet{Msg(8, 12,"without subject")} ) {  
!                  $tabsujet{Msg(8, 12,"without subject")}[0]++;
!              }else{
!                  $tabsujet{Msg(8, 12,"without subject")}[0]=1; 
!              }
!          }
!    }  
!    close OLD;
!    # create the index numbers into the hash
!    $index=0;
!    foreach $i (keys %tabsujet){
!        $index++;
!        $tabsujet{$i}[1]=$index;
!        $nbkeys+=$tabsujet{$i}[0];
!    }
!    my $dernier=0;
!    $i=$#tabmsg; #size of the array
! 
! for ($i=$#tabmsg;$i>0;$i--){
!     $ligne =$tabmsg[$i];
!     if ($ligne 
=~/^Subject\:(\s*)?((\=\?iso\-8859\-1\?Q\?)?Re(\s*)?\:)?\s*(.*)/i) {
!       $sujet=$3.$5;
        
!       # CONVERT
!       if ($sujet=~ /\=\?iso\-8859\-1\?Q\?/i){
!           $sujet =~ s/\=\?iso\-8859\-1\?Q\?([^\?]*)\?\=/$1/ig;
!           $sujet =~ s/\=\?iso\-8859\-1\?Q\?(\S*(\s?(\S*)?){3})\?\=/$1/ig;
!           foreach $i (keys %convertiso) {
!               $sujet=~ s/\=$i/$convertiso{$i}/ig;
!               $sujet=~ s/\_/ /ig;
!           }
!       }
!       $sujet =~ s/^\s*//;
!       if (exists $tabsujet{$sujet})  {
!           $dernier=$tabsujet{$sujet}[1];
        }
!       next;
      }
!     if ($ligne =~/^$separatorbis/i){
!       if ($dernier!=0){
!           $ligne =~s/X/$dernier/;
!       }else{ 
!           $ligne =~s/X/--/;
        }
!       $tabmsg[$i]=$ligne;
      }
  }
! # modify and send the digest 
!    my $hdr = new Mail::Header;
!    $hdr->add('Reply-to', "$reply");
!    $hdr->add('From', "$from");
!    $hdr->add('To', "$to");
!    $hdr->add('Subject',sprintf(Msg(8, 9, "DIGEST de la liste %s"),$file));
!   *DESC = smtp::smtpto(\$from, \@tabrcpt);
!    $hdr->print(\*DESC);
!    print DESC "\n";
!    
!    print DESC "\n";
!    printf DESC Msg(8, 13, "There are %d messages totalling %d lines in this 
issue."),$nbkeys,$nblines;
!    print DESC "\n\n";
!    
!    $index=0;
!    foreach $i ( keys %tabsujet)
!    {
!        print DESC "\t$tabsujet{$i}[1]. $i ";
!        print DESC "($tabsujet{$i}[0])" if($tabsujet{$i}[0]>1);
!        print DESC "\n";  
!    }
!    print DESC "\n";
!    foreach (@tabmsg)
!    {
!        print DESC  $_;
!    }
!    
!    print DESC "\n";
!    printf DESC Msg(8, 14, "End of %s Digest"),$file;
!    print DESC   " - ".POSIX::strftime("%a %b %e %H:%M:%S %Y", @oldtime)." 
to ".       
!      POSIX::strftime("%a %b %e %H:%M:%S %Y", @now)."\n";
!    print DESC 
"******************************************************************************";
!    close(DESC); 
! 
!    undef %tabsujet;
!    undef @tabmsg;
!    undef @tabrcpt;
! }
  
  ## Send a file to a user
  sub send_file {
--- 437,597 ----
  
  ## Send a digest message to the subscribers with reception=digest
  sub send_msg_digest {
  
!     my($self, $listname) = @_;
!     
!     my $filename = "$Conf{'queuedigest'}/$listname";
! 
!     ## Who is the enveloppe sender ?
!     my $admin = $self->{'admin'};
!     my $host = $admin->{'host'} || $Conf{'host'};
!     my $name = "$self->{'name'}";
!     my $from = "$name-request\@$host";
!     my $to = "$name\@$host";
!     my $reply = "$name-owner\@$host";
! 
!     my @tabrcpt;
!     my $i;
! 
!     my $subject;
!     my %user;
!     my ($mail, @list_of_mail);
!     my (%thread, $nbthrd, %order);
! 
!     ## Check the list
!     return undef unless ($listname eq $name);
! 
!     ## Create the list of subscribers in digest mode
!     for (%user = $self->get_first_user(); %user; %user = 
$self->get_next_user()) {
!       push @tabrcpt, $user{'email'} 
!            if $user{'reception'} eq "digest";
!     }
! 
!     my $old = $/;
!     $/ = "\n\n" . $msg::separator . "\n\n";
! 
!     ## Digest split in individual messages
!     open DIGEST, $filename or return undef;
!     foreach (<DIGEST>){
        
!       my @text = split /\n/;
!       pop @text; pop @text;
! 
!       ## Restore carriage returns
!       foreach $i (0 .. $#text) {
!           $text[$i] .= "\n";
        }
! 
!       $mail = new Mail::Internet \@text;
! 
!       push @list_of_mail, $mail;
!       
!     }
!     close DIGEST;
!     $/ = $old;
! 
!     ## Deletes the introduction part
!     splice @list_of_mail, 0, 1;
! 
!     ## Index construction
!     foreach $i (0 .. $#list_of_mail){
!       my $mail = $list_of_mail[$i];
! 
!       ## Subject cleanup
!       $subject = $mail->head->get('Subject') or next;
!       ## [RFC 2047] encoded-word = "=?" charset "?" encoding "?" encoded 
text "?="
!       while ($subject =~ /=\?ISO-8859-1\?(Q|B)\?([^\?]*)\?=/i) {
!           my $decoded_text;
!           my ($encoding, $encoded_text) = ($1, $2);
! 
!           if ($encoding =~ /Q/i) {
!               use MIME::QuotedPrint;
!               $decoded_text = MIME::QuotedPrint::decode($encoded_text);
!           }elsif ($encoding =~ /B/i) {
!               use MIME::Base64;
!               $decoded_text = MIME::Base64::decode($encoded_text);
!           }
!           $subject =~ s/=\?ISO-8859-1\?(Q|B)\?([^\?]*)\?=/$decoded_text/i;
!       } 
!       
!       $mail->head->replace('Subject', $subject);
! 
!       $subject =~ s/^Re:\s*(.*)/$1/i;
!       chomp $subject;
! 
!       push @ { $thread{"$subject"} }, $mail;
!       $order{"$subject"} ||= $i; # for sorting
!     }
! 
!     ## Digest Headers
!     my $hdr = new Mail::Header;
!     $hdr->add('Reply-to', "$reply");
!     $hdr->add('From', "$from");
!     $hdr->add('To', "$to");
!     $hdr->add('Subject',sprintf(Msg(8, 9, "Digest of list %s"),$listname));
! 
!     ## Digest construction
!     *DESC = smtp::smtpto(\$from, \@tabrcpt);
!     $hdr->print(\*DESC);
!     print DESC "\n\n";
!     printf DESC Msg(8, 13, "There are %d messages in this issue.\n\nTopics 
:"),$#list_of_mail + 1;
!     print DESC "\n\n";
! 
!     ## Digest index
!     foreach $subject (sort { $order{$a} <=> $order{$b} } keys %thread) {
!       $nbthrd++;
!       print DESC ' ' x (3 - length($nbthrd)) . "$nbthrd.";
!       print DESC " $subject";
!       printf DESC " (%d)", $#{ $thread{"$subject"} } + 1 if $#{ 
$thread{"$subject"} } > 0;
!       print DESC "\n";
      }
!     
!     my $is_first = 1;
!     ## Digest messages
!     foreach $mail (@list_of_mail) {
!       
!       my $header = $mail->head;
!       my $field;
!       my $boundary = $msg::digest_separator;
! 
!       ## Encapsulation Boundary
!       if ($is_first) {
!           my $s = Msg(8, 18, "FIRST MESSAGE");
! 
!           $boundary =~ s/X/$s/;
!           print DESC "\n\n" . $boundary . "\n\n";
!           undef $is_first;
!       }else {
!           my $s = Msg(8, 19, "NEXT MESSAGE");
! 
!           $boundary =~ s/X/$s/;
!           print DESC "\n" . $boundary . "\n\n";
!       }
! 
!       foreach $field ('Date', 'From', 'Subject') {
!           printf DESC "%s: %s",$field, $header->get($field);
        }
!       print DESC "\n";
!       
!       $mail->tidy_body;
!       $mail->remove_sig;
!       $mail->print_body (\*DESC);
! 
      }
+ 
+     my $s = Msg(8, 20, "LAST MESSAGE");
+     my $boundary = $msg::digest_separator;
+     $boundary =~ s/X/$s/;
+     print DESC "\n\n" . $boundary . "\n\n";
+ 
+     my @now  = localtime(time);
+ 
+     printf DESC Msg(8, 14, "End of %s Digest"),$listname;
+     printf DESC   " - %s\n", POSIX::strftime("%a %b %e %H:%M:%S %Y", @now);
+     close(DESC); 
+ 
  }
! 
  
  ## Send a file to a user
  sub send_file {
*** msg.pl.orig Tue Jun 30 17:53:06 1998
--- msg.pl      Fri Nov 20 12:26:39 1998
***************
*** 281,321 ****
  'To cancel the EXPIRE process : EXPIREDEL %s
  ';
  
- %convertiso=(
- 
"00"=>'',"01"=>'
',"02"=>'',"03"=>'',"04"=>'',"05"=>'',"06"=>'',"07"=>'',
- "08"=>'',"09"=>'',  "0A"=>'',  "0B"=>'',"0C"=>'',"0D"=>'
',"0E"=>'§¬¢°Æ¢½¾§',
- 
"10"=>'',"11"=>'',"12"=>'',"13"=>'',"14"=>'',"15"=>'',"16"=>'',"17"=>'',
- 
"18"=>'',"19"=>'',"1A"=>'',"1B"=>'',"1C"=>'',"1D"=>'',"1E"=>'',"1F"=>'',
- "20"=>'',  "21"=>'!', 
"22"=>'"',"23"=>'#',"24"=>'$',"25"=>'%',"26"=>'&',"27"=>'\'',
- 
"28"=>'(',"29"=>')',"2A"=>'*',"2B"=>'+',"2C"=>',',"2D"=>'-',"2E"=>'.',"2F"=>'/',
- 
"30"=>'0',"31"=>'1',"32"=>'2',"33"=>'3',"34"=>'4',"35"=>'5',"36"=>'6',"37"=>'7',
- 
"38"=>'8',"39"=>'9',"3A"=>':',"3B"=>';',"3C"=>'<',"3D"=>'=',"3E"=>'>',"3F"=>'?',
- 
"40"=>'@',"41"=>'A',"42"=>'B',"43"=>'C',"44"=>'D',"45"=>'E',"46"=>'F',"47"=>'G',
- 
"48"=>'H',"49"=>'I',"4A"=>'J',"4B"=>'K',"4C"=>'L',"4D"=>'M',"4E"=>'N',"4F"=>'O',
- 
"50"=>'P',"51"=>'Q',"52"=>'R',"53"=>'S',"54"=>'T',"55"=>'U',"56"=>'V',"57"=>'W',
- 
"58"=>'X',"59"=>'Y',"5A"=>'Z',"5B"=>'[',"5C"=>"\\","5D"=>']',"5E"=>"\^","5F"=>'_',
- 
"60"=>'`',"61"=>'a',"62"=>'b',"63"=>'c',"64"=>'d',"65"=>'e',"66"=>'f',"67"=>'g',
- 
"68"=>'h',"69"=>'i',"6A"=>'j',"6B"=>'k',"6C"=>'l',"6D"=>'m',"6E"=>'n',"6F"=>'o',
- 
"70"=>'p',"71"=>'q',"72"=>'r',"73"=>'s',"74"=>'t',"75"=>'u',"76"=>'v',"77"=>'w',
- 
"78"=>'x',"79"=>'y',"7A"=>'z',"7B"=>'{',"7C"=>'|',"7D"=>'}',"7E"=>'~',"7F"=>'',
- "80"=>'€',"81"=>'',"82"=>'‚',"83"=>'ƒ',"84"=>'„',"85"=>'…
',"86"=>'†',"87"=>'‡',
- 
"88"=>'ˆ',"89"=>'‰',"8A"=>'Š',"8B"=>'‹',"8C"=>'Œ',"8D"=>'',"8E"=>'Ž',"8F"=>'',
- 
"90"=>'',"91"=>'‘',"92"=>'’',"93"=>'“',"94"=>'”',"95"=>'•',"96"=>'–',"97"=>'—',
- 
"98"=>'˜',"99"=>'™',"9A"=>'š',"9B"=>'›',"9C"=>'œ',"9D"=>'',"9E"=>'ž',"9F"=>'Ÿ',
- "A0"=>' 
',"A1"=>'¡',"A2"=>'¢',"A3"=>'£',"A4"=>'¤',"A5"=>'¥',"A6"=>'¦',"A7"=>'§',
- 
"A8"=>'¨',"A9"=>'©',"AA"=>'ª',"AB"=>'«',"AC"=>'¬',"AD"=>'­',"AE"=>'®',"AF"=>'¯',
- 
"B0"=>'°',"B1"=>'±',"B2"=>'²',"B3"=>'³',"B4"=>'´',"B5"=>'µ',"B6"=>'¶',"B7"=>'·',
- 
"B8"=>'¸',"B9"=>'¹',"BA"=>'º',"BB"=>'»',"BC"=>'¼',"BD"=>'½',"BE"=>'¾',"BF"=>'¿',
- 
"C0"=>'À',"C1"=>'Á',"C2"=>'Â',"C3"=>'Ã',"C4"=>'Ä',"C5"=>'Å',"C6"=>'Æ',"C7"=>'Ç',
- 
"C8"=>'È',"C9"=>'É',"CA"=>'Ê',"CB"=>'Ë',"CC"=>'Ì',"CD"=>'Í',"CE"=>'Î',"CF"=>'Ï',
- 
"D0"=>'Ð',"D1"=>'Ñ',"D2"=>'Ò',"D3"=>'Ó',"D4"=>'Ô',"D5"=>'Õ',"D6"=>'Ö',"D7"=>'×',
- 
"D8"=>'Ø',"D9"=>'Ù',"DA"=>'Ú',"DB"=>'Û',"DC"=>'Ü',"DD"=>'Ý',"DE"=>'Þ',"DF"=>'ß',
- 
"E0"=>'à',"E1"=>'á',"E2"=>'â',"E3"=>'ã',"E4"=>'ä',"E5"=>'å',"E6"=>'æ',"E7"=>'ç',
- 
"E8"=>'è',"E9"=>'é',"EA"=>'ê',"EB"=>'ë',"EC"=>'ì',"ED"=>'í',"EE"=>'î',"EF"=>'ï',
- 
"F0"=>'ð',"F1"=>'ñ',"F2"=>'ò',"F3"=>'ó',"F4"=>'ô',"F5"=>'õ',"F6"=>'ö',"F7"=>'÷',
- 
"F8"=>'ø',"F9"=>'ù',"FA"=>'ú',"FB"=>'û',"FC"=>'ü',"FD"=>'ý',"FE"=>'þ',"FF"=>'ÿ');
- 
  $separator="------- CUT --- CUT --- CUT --- CUT --- CUT --- CUT --- CUT 
-------";
! $separatorbis="--------------------  MESSAGE X  
----------------------------------\n";
  
  1;
--- 281,287 ----
  'To cancel the EXPIRE process : EXPIREDEL %s
  ';
  
  $separator="------- CUT --- CUT --- CUT --- CUT --- CUT --- CUT --- CUT 
-------";
! $digest_separator = '-------' . '_-' x 8 . 'X' . '-_' x 8 . '-------';
  
  1;
*** ../nls/fr.msg.orig  Wed Jul  1 14:10:49 1998
--- ../nls/fr.msg       Fri Nov 20 12:28:19 1998
***************
*** 352,366 ****
     Nombre de messages transmis :  %9d\n\n\
     Méga-octets reçus           : %9.2f\n\
     Méga-octets transmis        : %9.2f\n"
! 9     "Digest de la liste %s"
  10    "Pour diffuser le message ci-joint dans la liste %s, veuillez 
retourner la commande suivante à Sympa :\n"
  11    "et pour refuser sa diffusion (il sera effacé) :\n"
  12    "sans sujet"
! 13    "Il y a %d messages dans ce digest (%d lignes)" 
! 14    "Fin du digest de la liste %s"
  15    "Il y a %d messages à modérer pour la liste %s" 
  16    "Authentification demandee"
  17    "Une confirmation est requise avant de diffuser votre message\n"
  
  $delset 9
  $set 9        Messages pour l'entête review
--- 352,369 ----
     Nombre de messages transmis :  %9d\n\n\
     Méga-octets reçus           : %9.2f\n\
     Méga-octets transmis        : %9.2f\n"
! 9     "Compilation de la liste %s"
  10    "Pour diffuser le message ci-joint dans la liste %s, veuillez 
retourner la commande suivante à Sympa :\n"
  11    "et pour refuser sa diffusion (il sera effacé) :\n"
  12    "sans sujet"
! 13    "Cette compilation contient %d messages\n\nSommaire :"
! 14    "Fin de compilation de la liste %s"
  15    "Il y a %d messages à modérer pour la liste %s" 
  16    "Authentification demandee"
  17    "Une confirmation est requise avant de diffuser votre message\n"
+ 18      "PREMIER MESSAGE"
+ 19      "MESSAGE SUIVANT"
+ 20      "DERNIER MESSAGE"
  
  $delset 9
  $set 9        Messages pour l'entête review