Server IP : 85.214.239.14 / Your IP : 3.147.69.25 Web Server : Apache/2.4.62 (Debian) System : Linux h2886529.stratoserver.net 4.9.0 #1 SMP Tue Jan 9 19:45:01 MSK 2024 x86_64 User : www-data ( 33) PHP Version : 7.4.18 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : OFF | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : OFF Directory : /proc/3/root/usr/share/perl5/MIME/Decoder/ |
Upload File : |
package MIME::Decoder::QuotedPrint; use strict; use warnings; =head1 NAME MIME::Decoder::QuotedPrint - encode/decode a "quoted-printable" stream =head1 SYNOPSIS A generic decoder object; see L<MIME::Decoder> for usage. =head1 DESCRIPTION A MIME::Decoder subclass for the C<"quoted-printable"> encoding. The name was chosen to jibe with the pre-existing MIME::QuotedPrint utility package, which this class actually uses to translate each line. =over 4 =item * The B<decoder> does a line-by-line translation from input to output. =item * The B<encoder> does a line-by-line translation, breaking lines so that they fall under the standard 76-character limit for this encoding. =back B<Note:> just like MIME::QuotedPrint, we currently use the native C<"\n"> for line breaks, and not C<CRLF>. This may need to change in future versions. =head1 SEE ALSO L<MIME::Decoder> =head1 AUTHOR Eryq (F<eryq@zeegee.com>), ZeeGee Software Inc (F<http://www.zeegee.com>). All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut use vars qw(@ISA $VERSION); use MIME::Decoder; use MIME::QuotedPrint; @ISA = qw(MIME::Decoder); # The package version, both in 1.23 style *and* usable by MakeMaker: $VERSION = "5.510"; #------------------------------ # If we have MIME::QuotedPrint 3.03 or later, use the three-argument # version. If we have an earlier version of MIME::QuotedPrint, we # may get the wrong results. However, on some systems (RH Linux, # for example), MIME::QuotedPrint is part of the Perl package and # upgrading it separately breaks their magic auto-update tools. # We are supporting older versions of MIME::QuotedPrint even though # they may give incorrect results simply because it's too painful # for many people to upgrade. # The following code is horrible. I know. Beat me up. --dfs BEGIN { if (!defined(&encode_qp_threearg)) { if ($::MIME::QuotedPrint::VERSION >= 3.03) { eval 'sub encode_qp_threearg ( $$$ ) { encode_qp(shift, shift, shift); }'; } else { eval 'sub encode_qp_threearg ( $$$ ) { encode_qp(shift); }'; } } } #------------------------------ # # encode_qp_really STRING TEXTUAL_TYPE_FLAG # # Encode QP, and then follow guideline 8 from RFC 2049 (thanks to Denis # N. Antonioli) whereby we make things a little safer for the transport # and storage of messages. WARNING: we can only do this if the line won't # grow beyond 76 characters! # sub encode_qp_really { my $enc = encode_qp_threearg(shift, undef, not shift); if (length($enc) < 74) { $enc =~ s/^\.\n/=2E\n/g; # force encoding of /^\.$/ $enc =~ s/^From /=46rom /g; # force encoding of /^From / } $enc; } #------------------------------ # # decode_it IN, OUT # sub decode_it { my ($self, $in, $out) = @_; my $init = 0; my $badpdf = 0; local $_; while (defined($_ = $in->getline)) { # # Dirty hack to fix QP-Encoded PDFs from MS-Outlook. # # Check if we have a PDF file and if it has been encoded # on Windows. Unix encoded files are fine. If we have # one encoded CR after the PDF init string but are missing # an encoded CR before the newline this means the PDF is broken. # if (!$init) { $init = 1; if ($_ =~ /^%PDF-[0-9\.]+=0D/ && $_ !~ /=0D\n$/) { $badpdf = 1; } } # # Decode everything with decode_qp() except corrupted PDFs. # if ($badpdf) { my $output = $_; $output =~ s/[ \t]+?(\r?\n)/$1/g; $output =~ s/=\r?\n//g; $output =~ s/(^|[^\r])\n\Z/$1\r\n/; $output =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge; $out->print($output); } else { $out->print(decode_qp($_)); } } 1; } #------------------------------ # # encode_it IN, OUT # sub encode_it { my ($self, $in, $out, $textual_type) = @_; local $_; while (defined($_ = $in->getline)) { $out->print(encode_qp_really($_, $textual_type)); } 1; } #------------------------------ 1;