Update of /cvsroot/mhonarc/mhonarc/MHonArc/lib
In directory subversions:/tmp/cvs-serv12726/lib

Modified Files:
        mhdb.pl mhinit.pl mhopt.pl mhrcfile.pl readmail.pl 
Log Message:
* Added MIMEALTPREFS resource: Content-type preferences for
  multipart/alternative data.  You can now tell MHonArc to use the
  text/plain part over a text/html part in multipart/alternative
  messages.
* FAQ update to mention MIMEALTPREFS.


Index: mhdb.pl
===================================================================
RCS file: /cvsroot/mhonarc/mhonarc/MHonArc/lib/mhdb.pl,v
retrieving revision 2.20
retrieving revision 2.21
diff -C2 -r2.20 -r2.21
*** mhdb.pl     27 Jun 2002 00:12:40 -0000      2.20
--- mhdb.pl     28 Jun 2002 03:28:10 -0000      2.21
***************
*** 108,111 ****
--- 108,115 ----
                    unless $IsDefault{'MIMEEXCS'};
  }
+ unless ($IsDefault{'MIMEALTPREFS'}) {
+     print_var(\*DB,'MIMEAltPrefs',
+                   \@MIMEAltPrefs);
+ }
  
  print_var(\*DB,'DateFields', \@DateFields) unless $IsDefault{'DATEFIELDS'};

Index: mhinit.pl
===================================================================
RCS file: /cvsroot/mhonarc/mhonarc/MHonArc/lib/mhinit.pl,v
retrieving revision 2.34
retrieving revision 2.35
diff -C2 -r2.34 -r2.35
*** mhinit.pl   27 Jun 2002 05:00:01 -0000      2.34
--- mhinit.pl   28 Jun 2002 03:28:10 -0000      2.35
***************
*** 731,735 ****
  ##  Content-Transfer-Encoding decoders:
  ##    readmail.pl has a default set, so we just use it.
- ##
  $IsDefault{'MIMEDECODERS'} = 1;
  
--- 731,734 ----
***************
*** 737,740 ****
--- 736,745 ----
  ##    Nothing is excluded by default.
  $IsDefault{'MIMEEXCS'} = 1;
+ 
+ ##  Content-type multipart/alternative preferences
+ ##    Note: The variable is not a readmail package variable, but it
+ ##        is used to set readmail package properties.
+ @MIMEAltPrefs = ( );
+ $IsDefault{'MIMEALTPREFS'} = 1;
  
  }

Index: mhopt.pl
===================================================================
RCS file: /cvsroot/mhonarc/mhonarc/MHonArc/lib/mhopt.pl,v
retrieving revision 2.28
retrieving revision 2.29
diff -C2 -r2.28 -r2.29
*** mhopt.pl    27 Jun 2002 05:00:01 -0000      2.28
--- mhopt.pl    28 Jun 2002 03:28:10 -0000      2.29
***************
*** 454,457 ****
--- 454,459 ----
        $readmail::FormatHeaderFunc = \&mhonarc::htmlize_header;
        $MHeadCnvFunc = \&readmail::MAILdecode_1522_str;
+       readmail::MAILset_alternative_prefs(@MIMEAltPrefs);
+       $IsDefault{'MIMEALTPREFS'} = !scalar(@MIMEAltPrefs);
      }
  

Index: mhrcfile.pl
===================================================================
RCS file: /cvsroot/mhonarc/mhonarc/MHonArc/lib/mhrcfile.pl,v
retrieving revision 2.22
retrieving revision 2.23
diff -C2 -r2.22 -r2.23
*** mhrcfile.pl 27 Jun 2002 00:12:40 -0000      2.22
--- mhrcfile.pl 28 Jun 2002 03:28:10 -0000      2.23
***************
*** 419,422 ****
--- 419,432 ----
            last FMTSW;
        }
+       if ($elem eq 'mimealtprefs') {          # Mime alternative prefs
+           $IsDefault{'MIMEALTPREFS'} = 0;
+           @MIMEAltPrefs = ();
+           while (defined($line = <$handle>)) {
+               last  if $line =~ /^\s*<\/mimealtprefs\s*>/i;
+               $line =~ s/\s//g;
+               push(@MIMEAltPrefs, lc($line))  if $line;
+           }
+           last FMTSW;
+       }
        if ($elem eq 'mimedecoders') {          # Mime decoders
            $IsDefault{'MIMEDECODERS'} = 0;

Index: readmail.pl
===================================================================
RCS file: /cvsroot/mhonarc/mhonarc/MHonArc/lib/readmail.pl,v
retrieving revision 2.17
retrieving revision 2.18
diff -C2 -r2.17 -r2.18
*** readmail.pl 31 May 2002 02:54:10 -0000      2.17
--- readmail.pl 28 Jun 2002 03:28:10 -0000      2.18
***************
*** 44,47 ****
--- 44,58 ----
  package readmail;
  
+ ###############################################################################
+ ##    Private Globals                                                      ##
+ ###############################################################################
+ 
+ my @_MIMEAltPrefs = ();
+ my %_MIMEAltPrefs = ();
+ 
+ ###############################################################################
+ ##    Public Globals                                                       ##
+ ###############################################################################
+ 
  ##---------------------------------------------------------------------------##
  ##    Constants
***************
*** 541,552 ****
                    }
                    $found = 1;
!                   if ($isalt) {
!                       # if alternative, do things in reverse
!                       unshift(@parts, substr($$body, 0, $pos));
!                       $parts[0] =~ s/^\r//;
!                   } else {
!                       push(@parts, substr($$body, 0, $pos));
!                       $parts[$#parts] =~ s/^\r//;
!                   }
                    # prune out part data just grabbed
                    substr($$body, 0, $pos+$blen) = "";
--- 552,558 ----
                    }
                    $found = 1;
!                   push(@parts, substr($$body, 0, $pos));
!                   $parts[$#parts] =~ s/^\r//;
! 
                    # prune out part data just grabbed
                    substr($$body, 0, $pos+$blen) = "";
***************
*** 561,565 ****
                if ($found) {
                    # discard front-matter
!                   if ($isalt) { pop(@parts); } else { shift(@parts); }
                } else {
                    # no boundary separators in message!
--- 567,571 ----
                if ($found) {
                    # discard front-matter
!                   shift(@parts);
                } else {
                    # no boundary separators in message!
***************
*** 581,585 ****
            ## Process parts
            my(@entity) = ();
!           my($cid, $href);
            @parts = \(@parts);
            while (defined($part = shift(@parts))) {
--- 587,593 ----
            ## Process parts
            my(@entity) = ();
!           my($cid, $href, $pctype);
!           my %alt_exc = ( );
!           my $have_alt_prefs = $isalt && scalar(@_MIMEAltPrefs);
            @parts = \(@parts);
            while (defined($part = shift(@parts))) {
***************
*** 588,596 ****
                $href->{'body'} = $part;
                $href->{'filtered'} = 0;
  
                ## only add to %Cid if not excluded
!               if (!defined($partfields->{'content-type'}) ||
!                       !&MAILis_excluded($partfields->{'content-type'}[0])) {
!                   push(@entity, $href);
                    $cid = $partfields->{'content-id'}[0] ||
                           $partfields->{'message-id'}[0];
--- 596,620 ----
                $href->{'body'} = $part;
                $href->{'filtered'} = 0;
+               $pctype = extract_ctype(
+                   $partfields->{'content-type'}, $ctype);
+ 
+               ## check alternative preferences
+               if ($have_alt_prefs) {
+                 next  if ($alt_exc{$pctype});
+                 my $pos = $_MIMEAltPrefs{$pctype};
+                 if (defined($pos)) {
+                     for (++$pos; $pos <= $#_MIMEAltPrefs; ++$pos) {
+                         $alt_exc{$_MIMEAltPrefs[$pos]} = 1;
+                     }
+                 }
+               }
  
                ## only add to %Cid if not excluded
!               if (!&MAILis_excluded($pctype)) {
!                   if ($isalt) {
!                       unshift(@entity, $href);
!                   } else {
!                       push(@entity, $href);
!                   }
                    $cid = $partfields->{'content-id'}[0] ||
                           $partfields->{'message-id'}[0];
***************
*** 630,634 ****
  
                ## Only use last filterable part in alternate
!               if ($subtype =~ /alternative/) {
                    $ret = shift @array;
                    if ($ret) {
--- 654,658 ----
  
                ## Only use last filterable part in alternate
!               if ($isalt) {
                    $ret = shift @array;
                    if ($ret) {
***************
*** 649,653 ****
  
            ## Check if multipart/alternative, and no success
!           if (!$ret && ($subtype =~ /alternative/)) {
                warn qq|Warning: No recognized part in multipart/alternative; |,
                     qq|will try to decode last part\n|;
--- 673,677 ----
  
            ## Check if multipart/alternative, and no success
!           if (!$ret && $isalt) {
                warn qq|Warning: No recognized part in multipart/alternative; |,
                     qq|will try to decode last part\n|;
***************
*** 799,805 ****
  ##
  sub MAILis_excluded {
!     my $content = $_[0] || 'text/plain';
!     my($ctype) = $content =~ m|^\s*([\w\-\./]+)|;
!     $ctype =~ tr/A-Z/a-z/;
      if ($MIMEExcs{$ctype}) {
        return 1;
--- 823,827 ----
  ##
  sub MAILis_excluded {
!     my $content = lc($_[0]) || 'text/plain';
      if ($MIMEExcs{$ctype}) {
        return 1;
***************
*** 929,932 ****
--- 951,979 ----
  }
  
+ ##---------------------------------------------------------------------------##
+ ##    MAILset_alternative_prefs() is used to set content-type
+ ##    preferences for multipart/alternative entities.  The list
+ ##    specified will supercede the prefered format as denoted by
+ ##    the ording of parts in the entity.
+ ##
+ ##    A content-type listed earlier in the array will be prefered
+ ##    over one later.  For example:
+ ##
+ ##      MAILset_alternative_prefs('text/plain', 'text/html');
+ ##
+ ##    States that if a multipart/alternative entity contains a
+ ##    text/plain part and a text/html part, the text/plain part will
+ ##    be prefered over the text/html part.
+ ##
+ sub MAILset_alternative_prefs {
+     @_MIMEAltPrefs = map { lc } @_;
+     %_MIMEAltPrefs = ();
+     my $i = 0;
+     my $ctype;
+     foreach $ctype (@_MIMEAltPrefs) {
+       $_MIMEAltPrefs{$ctype} = $i++;
+     }
+ }
+ 
  ###############################################################################
  ##    Private Routines
***************
*** 1003,1006 ****
--- 1050,1073 ----
      }
      $args;
+ }
+ 
+ ##---------------------------------------------------------------------------##
+ ##    extract_ctype() extracts the content-type specification from
+ ##    the beginning of given string.
+ ##
+ sub extract_ctype {
+     if (!defined($_[0]) ||
+         (ref($_[0]) && ($_[0][0] !~ /\S/)) ||
+         ($_[0] !~ /\S/)) {
+       return 'message/rfc822'
+           if (defined($_[1]) && ($_[1] eq 'multipart/digest'));
+       return 'text/plain';
+     }
+     if (ref($_[0])) {
+       $_[0][0] =~ m|^\s*([\w\-\./]+)|;
+       return lc($1);
+     }
+     $_[0] =~ m|^\s*([\w\-\./]+)|;
+     lc($1);
  }
  

---------------------------------------------------------------------
To sign-off this list, send email to [EMAIL PROTECTED] with the
message text UNSUBSCRIBE MHONARC-DEV

Reply via email to