[otrs-cvs] otrs/Kernel/cpan-lib/MIME Entity.pm, 1.13, 1.14 Decoder.pm, 1.13, 1.14 Head.pm, 1.13, 1.14 Tools.pm, 1.13, 1.14 WordDecoder.pm, 1.9, 1.10 Parser.pm, 1.14, 1.15 Body.pm, 1.13, 1.14 Words.pm, 1.15, 1.16
"CVS commits notifications of OTRS.org" <[email protected]>
| Newsgroups | gmane.comp.otrs.cvs |
|---|---|
| Message-ID | <[email protected]> |
Comments:
Update of /home/cvs/otrs/Kernel/cpan-lib/MIME
In directory lancelot:/tmp/cvs-serv9222/Kernel/cpan-lib/MIME
Modified Files:
Entity.pm Decoder.pm Head.pm Tools.pm WordDecoder.pm Parser.pm
Body.pm Words.pm
Log Message:
- 2013-01-29 Updated CPAN module MIME::Tools to version 5.503, keeping an OTRS patch in MIME::Words.
Author: mg
Index: Entity.pm
===================================================================
RCS file: /home/cvs/otrs/Kernel/cpan-lib/MIME/Entity.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -2 -u -d -r1.13 -r1.14
--- Entity.pm 18 Jul 2012 09:46:21 -0000 1.13
+++ Entity.pm 29 Jan 2013 14:37:18 -0000 1.14
@@ -235,5 +235,4 @@
use MIME::Body;
use MIME::Decoder;
-use IO::Lines;
@ISA = qw(Mail::Internet);
@@ -247,5 +246,5 @@
### The package version, both in 1.23 style *and* usable by MakeMaker:
-$VERSION = "5.428";
+$VERSION = "5.503";
### Boundary counter:
@@ -1817,6 +1816,13 @@
### Preamble:
- my $preamble = join('', @{ $self->preamble || $DefPreamble });
- $out->print("$preamble\n") if ($preamble ne '' or $self->preamble);
+ my $plines = $self->preamble;
+ if (defined $plines) {
+ # Defined, so output the preamble if it exists (avoiding additional
+ # newline as per ticket 60931)
+ $out->print( join('', @$plines) . "\n") if (@$plines > 0);
+ } else {
+ # Undefined, so use default preamble
+ $out->print( join('', @$DefPreamble) . "\n" );
+ }
### Parts:
@@ -1875,5 +1881,5 @@
### need to encode it again
my $buf;
- $out->print($buf) while ($IO->read($buf, 2048));
+ $out->print($buf) while ($IO->read($buf, 8192));
} else {
### Get the encoding, defaulting to "binary" if unsupported:
Author: mg
Index: Decoder.pm
===================================================================
RCS file: /home/cvs/otrs/Kernel/cpan-lib/MIME/Decoder.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -2 -u -d -r1.13 -r1.14
--- Decoder.pm 18 Jul 2012 09:46:21 -0000 1.13
+++ Decoder.pm 29 Jan 2013 14:37:18 -0000 1.14
@@ -87,4 +87,5 @@
### System modules:
use IPC::Open2;
+use IO::Select;
use FileHandle;
@@ -126,5 +127,5 @@
### The package version, both in 1.23 style *and* usable by MakeMaker:
-$VERSION = "5.428";
+$VERSION = "5.503";
### Me:
@@ -336,8 +337,4 @@
=over 4
-=cut
-
-#------------------------------
-
=item decode_it INSTREAM,OUTSTREAM
@@ -367,6 +364,4 @@
}
-#------------------------------
-
=item encode_it INSTREAM,OUTSTREAM
@@ -396,6 +391,4 @@
}
-#------------------------------
-
=item filter IN, OUT, COMMAND...
@@ -418,23 +411,63 @@
=cut
-sub filter {
- my ($self, $in, $out, @cmd) = @_;
- my $buf = '';
+sub filter
+{
+ my ($self, $in, $out, @cmd) = @_;
+ my $buf = '';
- ### Open pipe:
- STDOUT->flush; ### very important, or else we get duplicate output!
- my $kidpid = open2(\*CHILDOUT, \*CHILDIN, @cmd) || die "open2 failed: $!";
+ ### Open pipe:
+ STDOUT->flush; ### very important, or else we get duplicate output!
- ### Write all:
- while ($in->read($buf, 2048)) { print CHILDIN $buf }
- close \*CHILDIN;
+ my $kidpid = open2(my $child_out, my $child_in, @cmd) || die "@cmd: open2 failed: $!";
- ### Read all:
- while (read(\*CHILDOUT, $buf, 2048)) { $out->print($buf) }
- close \*CHILDOUT;
+ ### We have to use select() for doing both reading and writing.
+ my $rsel = IO::Select->new( $child_out );
+ my $wsel = IO::Select->new( $child_in );
- ### Wait for it:
- waitpid($kidpid,0) or die "couldn't reap child $kidpid";
- 1;
+ while (1) {
+
+ ### Wait for one hour; if that fails, it's too bad.
+ my ($read, $write) = IO::Select->select( $rsel, $wsel, undef, 3600);
+
+ if( !defined $read && !defined $write ) {
+ kill 1, $kidpid;
+ waitpid $kidpid, 0;
+ die "@cmd: select failed: $!";
+ }
+
+ ### If can read from child:
+ if( my $fh = shift @$read ) {
+ if( $fh->sysread(my $buf, 1024) ) {
+ $out->print($buf);
+ } else {
+ $rsel->remove($fh);
+ $fh->close();
+ }
+ }
+
+ ### If can write to child:
+ if( my $fh = shift @$write ) {
+ if($in->read(my $buf, 1024)) {
+ local $SIG{PIPE} = sub {
+ warn "got SIGPIPE from @cmd";
+ $wsel->remove($fh);
+ $fh->close();
+ };
+ $fh->syswrite( $buf );
+ } else {
+ $wsel->remove($fh);
+ $fh->close();
+ }
+ }
+
+ ### If both $child_out and $child_in are done:
+ last unless ($rsel->count() || $wsel->count());
+ }
+
+ ### Wait for it:
+ waitpid($kidpid, 0) == $kidpid or die "@cmd: couldn't reap child $kidpid";
+ ### Check if it failed:
+ $? == 0 or die "@cmd: bad exit status: \$? = $?";
+ 1;
}
Author: mg
Index: Head.pm
===================================================================
RCS file: /home/cvs/otrs/Kernel/cpan-lib/MIME/Head.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -2 -u -d -r1.13 -r1.14
--- Head.pm 18 Jul 2012 09:46:21 -0000 1.13
+++ Head.pm 29 Jan 2013 14:37:18 -0000 1.14
@@ -1,5 +1,5 @@
package MIME::Head;
-
+use MIME::WordDecoder;
=head1 NAME
@@ -139,5 +139,5 @@
### The package version, both in 1.23 style *and* usable by MakeMaker:
-$VERSION = "5.428";
+$VERSION = "5.503";
### Sanity (we put this test after our own version, for CPAN::):
@@ -367,5 +367,5 @@
octet (hexadecimal C<F8>), period. For piece-by-piece decoding
of a given field, you want the array context of
-C<MIME::Word::decode_mimewords()>.
+C<MIME::Words::decode_mimewords()>.
B<Warning:> the CRLF+SPACE separator that splits up long encoded words
@@ -464,4 +464,7 @@
my @all_received = $head->get('received');
+B<NOTE>: The header(s) returned may end with a newline. If you don't
+want this, then B<chomp> the return value.
+
=cut
@@ -728,7 +731,11 @@
my ($self, $default) = @_;
$self->{MIH_DefaultType} = $default if @_ > 1;
- lc($self->mime_attr('content-type') ||
+ my $s = $self->mime_attr('content-type') ||
$self->{MIH_DefaultType} ||
- 'text/plain');
+ 'text/plain';
+ # avoid [perl #87336] bug, lc laundering tainted data
+ return lc($s) if $] <= 5.008 || $] >= 5.014;
+ $s =~ tr/A-Z/a-z/;
+ $s;
}
@@ -766,5 +773,6 @@
I<Instance method.>
Return the recommended external filename. This is used when
-extracting the data from the MIME stream.
+extracting the data from the MIME stream. The filename is always
+returned as a string in Perl's internal format (the UTF8 flag may be on!)
Returns undef if no filename could be suggested.
@@ -778,4 +786,5 @@
# Try these headers in order, taking the first defined,
# non-blank one we find.
+ my $wd = supported MIME::WordDecoder 'UTF-8';
foreach my $attr_name ( qw( content-disposition.filename content-type.name ) ) {
my $value = $self->mime_attr( $attr_name );
@@ -783,5 +792,5 @@
&& $value ne ''
&& $value =~ /\S/ ) {
- return $value;
+ return $wd->decode($value);
}
}
Author: mg
Index: Tools.pm
===================================================================
RCS file: /home/cvs/otrs/Kernel/cpan-lib/MIME/Tools.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -2 -u -d -r1.13 -r1.14
--- Tools.pm 18 Jul 2012 09:46:21 -0000 1.13
+++ Tools.pm 29 Jan 2013 14:37:18 -0000 1.14
@@ -29,5 +29,5 @@
# The TOOLKIT version, both in 1.23 style *and* usable by MakeMaker:
-$VERSION = "5.428";
+$VERSION = "5.503";
# Configuration (do NOT alter this directly)...
@@ -175,6 +175,4 @@
#------------------------------
1;
-package MIME::ToolUtils;
-@MIME::ToolUtils::ISA = qw(MIME::Tools);
__END__
@@ -251,5 +249,4 @@
File::Spec
IPC::Open2 (optional)
- IO::ScalarArray from the IO-stringy distribution
MIME::Base64
MIME::QuotedPrint
Author: mg
Index: WordDecoder.pm
===================================================================
RCS file: /home/cvs/otrs/Kernel/cpan-lib/MIME/WordDecoder.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -2 -u -d -r1.9 -r1.10
--- WordDecoder.pm 18 Jul 2012 09:46:21 -0000 1.9
+++ WordDecoder.pm 29 Jan 2013 14:37:18 -0000 1.10
@@ -1,9 +1,10 @@
package MIME::WordDecoder;
-
=head1 NAME
MIME::WordDecoder - decode RFC 2047 encoded words to a local representation
+WARNING: Most of this module is deprecated and may disappear. The only
+function you should use for MIME decoding is "mime_to_perl_string".
=head1 SYNOPSIS
@@ -28,7 +29,14 @@
$str = unmime('To: =?ISO-8859-1?Q?Keld_J=F8rn_Simonsen?= <keld>');
+ ### Decode a string to an internal Perl string, non-OO style
+ ### The result is likely to have the UTF8 flag ON.
+ $str = mime_to_perl_string('To: =?ISO-8859-1?Q?Keld_J=F8rn_Simonsen?= <keld>');
=head1 DESCRIPTION
+WARNING: Most of this module is deprecated and may disappear. It
+duplicates (badly) the function of the standard 'Encode' module. The
+only function you should rely on is mime_to_perl_string.
+
A MIME::WordDecoder consists, fundamentally, of a hash which maps
a character set name (US-ASCII, ISO-8859-1, etc.) to a subroutine which
@@ -65,5 +73,13 @@
### ...which will now hold: "To: Keld J#rn Simonsen <keld>"
+The UTF-8 built-in decoder decodes everything into Perl's internal
+string format, possibly turning on the internal UTF8 flag. Use it like
+this:
+ $wd = supported MIME::WordDecoder 'UTF-8';
+ $perl_string = $wd->decode('To: =?ISO-8859-1?Q?Keld_J=F8rn_Simonsen?= <keld>');
+ # perl_string will be a valid UTF-8 string with the "UTF8" flag set.
+
+Generally, you should use the UTF-8 decoder in preference to "unmime".
=head1 PUBLIC INTERFACE
@@ -80,5 +96,5 @@
@ISA = qw(Exporter);
-@EXPORT = qw( unmime );
+@EXPORT = qw( unmime mime_to_perl_string );
@@ -105,4 +121,6 @@
my $Default;
+### Global UTF8 decoder.
+my $DefaultUTF8;
#------------------------------
@@ -295,4 +313,7 @@
See L<default()|/default>.
+You should consider using the UTF-8 decoder instead. It decodes
+MIME strings into Perl's internal string format.
+
=cut
@@ -302,4 +323,19 @@
}
+=item mime_to_perl_string
+
+I<Function, exported.>
+Decode the given STRING into an internal Perl Unicode string.
+You should use this function in preference to all others.
+
+The result of mime_to_perl_string is likely to have Perl's
+UTF8 flag set.
+
+=cut
+
+sub mime_to_perl_string($) {
+ my $str = shift;
+ $DecoderFor{'UTF-8'}->decode($str);
+}
=back
@@ -402,4 +438,5 @@
#print STDERR "UTF8 in: <$_>\n";
+ local($1,$2,$3);
my $tgt = '';
while (m{\G(
@@ -429,4 +466,5 @@
#print STDERR "UTF16 in: <$_>\n";
+ local($1,$2,$3,$4,$5);
my $tgt = '';
while (m{\G(
@@ -559,4 +597,32 @@
=cut
+package MIME::WordDecoder::UTF_8;
+use strict;
+use Encode qw();
+use Carp qw( carp );
+use vars qw(@ISA);
+
+@ISA = qw( MIME::WordDecoder );
+
+sub h_convert_to_utf8
+{
+ my ($data, $charset, $decoder) = @_;
+ $charset = 'US-ASCII' if ($charset eq 'raw');
+ my $enc = Encode::find_encoding($charset);
+ if (!$enc) {
+ carp "Unable to convert text in character set `$charset' to UTF-8... ignoring\n";
+ return '';
+ }
+ my $ans = $enc->decode($data, Encode::FB_PERLQQ);
+ return $ans;
+}
+
+sub new {
+ my ($class) = @_;
+ my $self = $class->SUPER::new();
+ $self->handler('*' => \&h_convert_to_utf8);
+}
+
+
#------------------------------------------------------------
#------------------------------------------------------------
@@ -567,4 +633,5 @@
$Default = (MIME::WordDecoder::ISO_8859->new('1'));
+
### Add US-ASCII handler:
$DecoderFor{"US-ASCII"} = MIME::WordDecoder::US_ASCII->new;
@@ -575,4 +642,7 @@
}
+### UTF-8
+$DecoderFor{'UTF-8'} = MIME::WordDecoder::UTF_8->new();
+
1; # end the module
__END__
Author: mg
Index: Parser.pm
===================================================================
RCS file: /home/cvs/otrs/Kernel/cpan-lib/MIME/Parser.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -2 -u -d -r1.14 -r1.15
--- Parser.pm 18 Jul 2012 09:46:21 -0000 1.14
+++ Parser.pm 29 Jan 2013 14:37:18 -0000 1.15
@@ -107,6 +107,6 @@
### Convert a Mail::Internet object to a MIME::Entity:
- @lines = (@{$mail->header}, "\n", @{$mail->body});
- $entity = $parser->parse_data(\@lines);
+ my $data = join('', (@{$mail->header}, "\n", @{$mail->body}));
+ $entity = $parser->parse_data(\$data);
@@ -130,8 +130,6 @@
use vars (qw($VERSION $CAT $CRLF));
-### Built-in modules:
-use IO::ScalarArray 1.114;
+### core Perl modules
use IO::File;
-use IO::InnerFile;
use File::Spec;
use File::Path;
@@ -149,29 +147,4 @@
use MIME::Parser::Results;
-
-#============================================================
-#
-# A special kind of inner file that we can virtually print to.
-#
-package MIME::Parser::InnerFile;
-
-use vars qw(@ISA);
-@ISA = qw(IO::InnerFile);
-
-sub print {
- shift->add_length(length(join('', @_)));
- 1;
-}
-
-sub PRINT {
- shift->{LG} += length(join('', @_));
- 1;
-}
-
-#============================================================
-
-package MIME::Parser;
-
-
#------------------------------
#
@@ -181,5 +154,5 @@
### The package version, both in 1.23 style *and* usable by MakeMaker:
-$VERSION = "5.428";
+$VERSION = "5.503";
### How to catenate:
@@ -246,5 +219,4 @@
$self->{MP5_TmpToCore} = 0;
$self->{MP5_IgnoreErrors} = 1;
- $self->{MP5_UseInnerFiles} = 0;
$self->{MP5_UUDecode} = 0;
$self->{MP5_MaxParts} = -1;
@@ -578,5 +550,17 @@
### Parse preamble:
my @saved;
- $rdr->read_lines($in, \@saved);
+ my $data = '';
+ open(my $fh, '>', \$data) or die $!;
+ $rdr->read_chunk($in, $fh, 1);
+ close $fh;
+
+ # Ugh. Horrible. If the preamble consists only of CRLF, squash it down
+ # to the empty string. Else, remove the trailing CRLF.
+ if( $data =~ m/^[\r\n]\z/ ) {
+ @saved = ('');
+ } else {
+ $data =~ s/[\r\n]\z//;
+ @saved = split(/^/, $data);
+ }
$ent->preamble(\@saved);
1;
@@ -639,6 +623,9 @@
$hdr_rdr->add_terminator("");
$hdr_rdr->add_terminator("\r"); ### sigh
- $hdr_rdr->read_lines($in, \@headlines);
- foreach (@headlines) { s/[\r\n]+\Z/\n/ } ### fold
+
+ my $headstr = '';
+ open(my $outfh, '>:scalar', \$headstr) or die $!;
+ $hdr_rdr->read_chunk($in, $outfh, 0, 1);
+ close $outfh;
### How did we do?
@@ -650,25 +637,14 @@
$self->error("unexpected end of header\n");
- ### Cleanup bogus header lines.
- ### Some folks like to parse mailboxes, so the header will start
- ### with "From " or ">From ". Tolerate this by removing both kinds
- ### of lines silently (can't we use Mail::Header for this, and try
- ### and keep the envelope?). Ditto for POP.
- while (@headlines) {
- if ($headlines[0] =~ /^>?From /) { ### mailbox
- $self->whine("skipping bogus mailbox 'From ' line");
- shift @headlines;
- }
- elsif ($headlines[0] =~ /^\+OK/) { ### POP3 status line
- $self->whine("skipping bogus POP3 '+OK' line");
- shift @headlines;
- }
- else { last }
+ ### Extract the header (note that zero-size headers are admissible!):
+ open(my $readfh, '<:scalar', \$headstr) or die $!;
+ $head->read( $readfh );
+
+ unless( $readfh->eof() ) {
+ # Not entirely correct, since ->read consumes the line it gives up on.
+ # it's actually the line /before/ the one we get with ->getline
+ $self->error("couldn't parse head; error near:\n", $readfh->getline());
}
- ### Extract the header (note that zero-size headers are admissible!):
- $head->extract(\@headlines);
- @headlines and
- $self->error("couldn't parse head; error near:\n",@headlines);
### If desired, auto-decode the header as per RFC 2047
@@ -790,14 +766,6 @@
else {
- ### Can we read real fast?
- if ($self->{MP5_UseInnerFiles} &&
- $in->can('seek') && $in->can('tell')) {
- $self->debug("using inner file");
- $ENCODED = MIME::Parser::InnerFile->new($in, $in->tell, 0);
- }
- else {
- $self->debug("using temp file");
- $ENCODED = $self->new_tmpfile();
- }
+ $self->debug("using temp file");
+ $ENCODED = $self->new_tmpfile();
### Read encoded body until boundary (or EOF)...
@@ -819,28 +787,14 @@
### Get a content-decoder to decode this part's encoding:
my $encoding = $head->mime_encoding;
-# ---
-# OTRS
-# ---
-# 2011-01-07 added patch/workaround for bug in MIME::Words (v5.428)
-# see also: https://rt.cpan.org/Public/Bug/Display.html?id=64589
-# http://bugs.otrs.org/show_bug.cgi?id=6555
-# my $decoder = new MIME::Decoder $encoding;
-# if (!$decoder) {
-# $self->whine("Unsupported encoding '$encoding': using 'binary'... \n".
-# "The entity will have an effective MIME type of \n".
-# "application/octet-stream."); ### as per RFC-2045
-# $ent->effective_type('application/octet-stream');
-# $decoder = new MIME::Decoder 'binary';
-# $encoding = 'binary';
-# }
- if ( ! supported MIME::Decoder $encoding ){
- $self->whine("Unsupported encoding '$encoding': using 'binary'... \n".
- "The entity will have an effective MIME type of \n".
- "application/octet-stream."); ### as per RFC-2045
- $ent->effective_type('application/octet-stream');
- $encoding = 'binary';
- }
my $decoder = new MIME::Decoder $encoding;
-
+ if (!$decoder) {
+ $self->whine("Unsupported encoding '$encoding': using 'binary'... \n".
+ "The entity will have an effective MIME type of \n".
+ "application/octet-stream."); ### as per RFC-2045
+ $ent->effective_type('application/octet-stream');
+ $decoder = new MIME::Decoder 'binary';
+ $encoding = 'binary';
+ }
+
### Data should be stored encoded / as-is?
if ( !$self->decode_bodies ) {
@@ -1089,5 +1043,5 @@
elsif (("$type/$subtype" eq "message/rfc822" ||
"$type/$subtype" eq "message/external-body" ||
- ("$type/$subtype" eq "message/partial" && $head->mime_attr("content-type.number") == 1)) &&
+ ("$type/$subtype" eq "message/partial" && defined($head->mime_attr("content-type.number")) && $head->mime_attr("content-type.number") == 1)) &&
$self->extract_nested_messages) {
$self->debug("attempting to process a nested message");
@@ -1118,5 +1072,7 @@
I<Instance method.>
-Parse a MIME message that's already in core.
+Parse a MIME message that's already in core. This internally creates an "in
+memory" filehandle on a Perl scalar value using PerlIO
+
You may supply the DATA in any of a number of ways...
@@ -1125,14 +1081,23 @@
=item *
-B<A scalar> which holds the message.
+B<A scalar> which holds the message. A reference to this scalar will be used
+internally.
=item *
-B<A ref to a scalar> which holds the message. This is an efficiency hack.
+B<A ref to a scalar> which holds the message. This reference will be used
+internally.
=item *
-B<A ref to an array of scalars.> They are treated as a stream
-which (conceptually) consists of simply concatenating the scalars.
+B<DEPRECATED>
+
+B<A ref to an array of scalars.> The array is internally concatenated into a
+temporary string, and a reference to the new string is used internally.
+
+It is much more efficient to pass in a scalar reference, so please consider
+refactoring your code to use that interface instead. If you absolutely MUST
+pass an array, you may be better off using IO::ScalarArray in the calling code
+to generate a filehandle, and passing that filehandle to I<parse()>
=back
@@ -1153,8 +1118,9 @@
$io = IO::File->new($data, '<:');
} elsif( ref $data eq 'ARRAY' ) {
- # Unfortunately, if they give us an array, we have to keep
- # using it. We don't really want to make a copy.
- # TODO: I think we're stuck keeping this one for now.
- $io = IO::ScalarArray->new($data);
+ # Passing arrays is deprecated now that we've nuked IO::ScalarArray
+ # but for backwards compatability we still support it by joining the
+ # array lines to a scalar and doing scalar IO on it.
+ my $tmp_data = join('', @$data);
+ $io = IO::File->new(\$tmp_data, '<:');
} else {
croak "parse_data: wrong argument ref type: ", ref($data);
@@ -1188,4 +1154,5 @@
local $/ = "\n"; ### just to be safe
+ local $\ = undef; # CPAN ticket #71041
$self->init_parse;
$entity = $self->process_part($in, undef); ### parse!
@@ -1536,26 +1503,30 @@
=item use_inner_files [YESNO]
+I<REMOVED>.
+
I<Instance method.>
-If you are parsing from a handle which supports seek() and tell(),
-then we can avoid tmpfiles completely by using IO::InnerFile, if so
-desired: basically, we simulate a temporary file via pointers
-to virtual start- and end-positions in the input stream.
-If YESNO is false (the default), then we will not use IO::InnerFile.
-If YESNO is true, we use IO::InnerFile if we can.
-With no argument, just returns the current setting.
+MIME::Parser no longer supports IO::InnerFile, but this method is retained for
+backwards compatibility. It does nothing.
-B<Note:> inner files are slower than I<real> tmpfiles,
-but possibly faster than I<in-core> tmpfiles... so your choice for
-this option will probably depend on your choice for
-L<tmp_to_core()|/tmp_to_core> and the kind of input streams you are
-parsing.
+The original reasoning for IO::InnerFile was that inner files were faster than
+"in-core" temp files. At the time, the "in-core" tempfile support was
+implemented with IO::Scalar from the IO-Stringy distribution, which used the
+tie() interface to wrap a scalar with the appropriate IO::Handle operations.
+The penalty for this was fairly hefty, and IO::InnerFile actually was faster.
+
+Nowadays, MIME::Parser uses Perl's built in ability to open a filehandle on an
+in-memory scalar variable via PerlIO. Benchmarking shows that IO::InnerFile is
+slightly slower than using in-memory temporary files, and is slightly faster
+than on-disk temporary files. Both measurements are within a few percent of
+each other. Since there's no real benefit, and since the IO::InnerFile abuse
+was fairly hairy and evil ("writes" to it were faked by extending the size of
+the inner file with the assumption that the only data you'd ever ->print() to
+it would be the line from the "outer" file, for example) it's been removed.
=cut
sub use_inner_files {
- my ($self, $yesno) = @_;
- $self->{MP5_UseInnerFiles} = $yesno if (@_ > 1);
- $self->{MP5_UseInnerFiles};
+ return 0;
}
@@ -1818,19 +1789,4 @@
output_to_core() 0 (will be MUCH faster)
tmp_to_core() 0 (will be MUCH faster)
- use_inner_files() 0 (if tmp_to_core() is 0;
- use 1 otherwise)
-
-B<File I/O is much faster than in-core I/O.>
-Although it I<seems> like slurping a message into core and
-processing it in-core should be faster... it isn't.
-Reason: Perl's filehandle-based I/O translates directly into
-native operating-system calls, whereas the in-core I/O is
-implemented in Perl.
-
-B<Inner files are slower than real tmpfiles, but faster than in-core ones.>
-If speed is your concern, that's why
-you should set use_inner_files(true) if you set tmp_to_core(true):
-so that we can bypass the slow in-core tmpfiles if the input stream
-permits.
B<Native I/O is much faster than object-oriented I/O.>
@@ -1866,8 +1822,4 @@
tmp_to_core is 1)
tmp_to_core() 0 (will use MUCH less memory)
- use_inner_files() *** (no real difference, but set it to 1
- if you *must* have tmp_to_core set to 1,
- so that you avoid in-core tmpfiles)
-
=head2 Maximizing tolerance of bad MIME
@@ -1887,5 +1839,4 @@
output_to_core() *** (doesn't matter)
tmp_to_core() *** (doesn't matter)
- use_inner_files() *** (doesn't matter)
@@ -1905,15 +1856,7 @@
output_to_core() *** (doesn't matter)
tmp_to_core() 1
- use_inner_files() 1
-
-B<If we can use them, inner files avoid most tmpfiles.>
-If you parse from a seekable-and-tellable filehandle, then the internal
-process_to_bound() doesn't need to extract each part into a temporary
-buffer; it can use IO::InnerFile (B<warning:> this will slow down
-the parsing of messages with large attachments).
B<You can veto tmpfiles entirely.>
-If you might not be parsing from a seekable-and-tellable filehandle,
-you can set L<tmp_to_core()|/tmp_to_core> true: this will always
+You can set L<tmp_to_core()|/tmp_to_core> true: this will always
use in-core I/O for the buffering (B<warning:> this will slow down
the parsing of messages with large attachments).
Author: mg
Index: Body.pm
===================================================================
RCS file: /home/cvs/otrs/Kernel/cpan-lib/MIME/Body.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -2 -u -d -r1.13 -r1.14
--- Body.pm 18 Jul 2012 09:46:21 -0000 1.13
+++ Body.pm 29 Jan 2013 14:37:18 -0000 1.14
@@ -142,5 +142,5 @@
### The package version, both in 1.23 style *and* usable by MakeMaker:
-$VERSION = "5.428";
+$VERSION = "5.503";
@@ -334,5 +334,5 @@
my $buf = '';
my $io = $self->open("r") || return undef;
- $fh->print($buf) while ($nread = $io->read($buf, 2048));
+ $fh->print($buf) while ($nread = $io->read($buf, 8192));
$io->close;
return defined($nread); ### how'd we do?
Author: mg
Index: Words.pm
===================================================================
RCS file: /home/cvs/otrs/Kernel/cpan-lib/MIME/Words.pm,v
retrieving revision 1.15
retrieving revision 1.16
diff -2 -u -d -r1.15 -r1.16
--- Words.pm 18 Jul 2012 09:46:21 -0000 1.15
+++ Words.pm 29 Jan 2013 14:37:18 -0000 1.16
@@ -68,4 +68,5 @@
### Pragmas:
use strict;
+use re 'taint';
use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS @ISA);
@@ -94,5 +95,5 @@
### The package version, both in 1.23 style *and* usable by MakeMaker:
-$VERSION = "5.428";
+$VERSION = "5.503";
### Nonprintables (controls + x7F + 8bit):
@@ -107,4 +108,5 @@
sub _decode_Q {
my $str = shift;
+ local $1;
$str =~ s/_/\x20/g; # RFC-1522, Q rule 2
$str =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge; # RFC-1522, Q rule 1
@@ -117,4 +119,5 @@
sub _encode_Q {
my $str = shift;
+ local $1;
$str =~ s{([ _\?\=$NONPRINT])}{sprintf("=%02X", ord($1))}eog;
$str;
@@ -152,5 +155,5 @@
$enc = '=?ISO-8859-1?Q?Keld_J=F8rn_Simonsen?= <[email protected]>';
foreach (decode_mimewords($enc)) {
- print "", ($_[1] || 'US-ASCII'), ": ", $_[0], "\n";
+ print "", ($_->[1] || 'US-ASCII'), ": ", $_->[0], "\n";
}
@@ -174,4 +177,5 @@
my $encstr = shift;
my @tokens;
+ local($1,$2,$3);
$@ = ''; ### error-return
@@ -212,8 +216,8 @@
pos($encstr) = $pos; # reset the pointer.
if ($encstr =~ m{\G # from where we left off...
- ([\x00-\xFF]*? # shortest possible string,
+ (.*? # shortest possible string,
\n*) # followed by 0 or more NLs,
(?=(\Z|=\?)) # terminated by "=?" or EOS
- }xg) {
+ }sxg) {
length($1) or die "MIME::Words: internal logic err: empty token\n";
push @tokens, [$1];
@@ -297,4 +301,5 @@
### worst-case encoding give us no more than 54 + ~10 < 75 characters
my $word;
+ local $1;
# ---
# OTRS
@@ -306,4 +311,5 @@
# $rawstr =~ s{([ a-zA-Z0-9\x7F-\xFF]{1,18})}{ ### get next "word"
$rawstr =~ s{([a-zA-Z0-9\x7F-\xFF]+\s*)}{ ### get next "word"
+# ---
$word = $1;
(($word !~ /(?:[$NONPRINT])|(?:^\s+$)/o)
---------------------------------------------------------------------
OTRS mailing list: cvs-log - Webpage: http://otrs.org/
Archive: http://lists.otrs.org/pipermail/cvs-log
To unsubscribe: http://lists.otrs.org/cgi-bin/listinfo/cvs-log