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',
+ \(_at_)MIMEAltPrefs);
+ }
print_var(\*DB,'DateFields', \(_at_)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 majordomo(_at_)mhonarc(_dot_)org with the
message text UNSUBSCRIBE MHONARC-DEV