1use strict; 2use warnings; 3package Email::Simple::FromHandle; 4{ 5 $Email::Simple::FromHandle::VERSION = '0.054'; 6} 7use Email::Simple 2.004; 8use parent 'Email::Simple'; 9# ABSTRACT: an Email::Simple but from a handle 10 11 12use Carp (); 13use IO::String; 14use Fcntl qw(SEEK_SET); 15 16my $crlf = qr/\x0a\x0d|\x0d\x0a|\x0a|\x0d/; # We are liberal in what we accept. 17 18 19sub handle { $_[0]->{handle} } 20 21 22sub body_pos { $_[0]->{body_pos} } 23 24 25sub _is_seekable { 26 my ($self) = @_; 27 # on solaris, tell($pipe) == -1, and seeking on a pipe appears to discard the 28 # data waiting 29 return unless $self->body_pos >= 0; 30 # on linux, seeking on a pipe is safe and returns '' 31 return unless seek($self->handle, 0, 1); 32 # fall through: it must be seekable 33 return 1; 34} 35 36sub reset_handle { 37 my ($self) = @_; 38 39 # Don't die the first time we try to read from a pipe/socket/etc. 40 # TODO: When reading from something non-seekable, should we 41 # give the option to store data into a temp file, or something similar? 42 return unless $self->_is_seekable || $self->{_seek}++; 43 44 delete $self->{_get_head_lines}; 45 46 seek $self->handle, $self->body_pos, SEEK_SET 47 or Carp::croak "can't seek: $!"; 48} 49 50 51sub getline { 52 my ($self) = @_; 53 unless ($self->{_get_head_lines}) { 54 $self->{_get_head_lines} = [ 55 split(/(?<=\n)/, $self->header_obj->as_string), 56 $self->crlf, 57 ]; 58 } 59 my $handle = $self->handle; 60 return shift @{$self->{_get_head_lines}} || <$handle>; 61} 62 63 64sub _stream_to_print { 65 my $fh = shift; 66 print {$fh} @_ or Carp::croak "can't print buffer: $!"; 67} 68 69sub stream_to { 70 my ($self, $fh, $arg) = @_; 71 $arg ||= {}; 72 $arg->{reset_handle} = 1 unless exists $arg->{reset_handle}; 73 # 65536 is a randomly-chosen magical number that's large enough to be a win 74 # over line-by-line reading but small enough not to impinge very much upon 75 # ram usage -- hdp, 2006-11-27 76 $arg->{chunk_size} ||= 65536; 77 $arg->{write} ||= \&_stream_to_print; 78 $arg->{write}->($fh, $self->header_obj->as_string . $self->crlf); 79 $self->reset_handle if $arg->{reset_handle}; 80 my $buf; 81 while (read($self->handle, $buf, $arg->{chunk_size}) > 0) { 82 $arg->{write}->($fh, $buf); 83 } 84} 85 86#### Methods that override Email::Simple below 87 88sub new { 89 my ($class, $handle, $arg) = @_; 90 91 $arg ||= {}; 92 $arg->{header_class} ||= $class->default_header_class; 93 94 return Email::Simple->new($handle, $arg) unless ref $handle; 95 96 my ($head, $mycrlf) = $class->_split_head_from_body($handle); 97 98 my $self = bless { 99 handle => $handle, 100 body_pos => tell($handle), 101 mycrlf => $mycrlf, 102 }, $class; 103 104 $self->header_obj_set( 105 $arg->{header_class}->new($head, { crlf => $self->crlf }) 106 ); 107 108 return $self; 109} 110 111sub _split_head_from_body { 112 my ($class, $handle) = @_; 113 114 my $text = q{}; 115 116 # XXX it is stupid to use <> if we're really going to have multiple forms 117 # of crlf, but it is expedient to keep doing so for now. -- hdp, 2006-11-28 118 # theoretically, this should be ok, because it will only fail if lines are 119 # terminated with \x0d, which wouldn't be ok for network transport anyway. 120 my $mycrlf; 121 while (<$handle>) { 122 last if $mycrlf and /\A$mycrlf\z/; 123 $text .= $_; 124 ($mycrlf) = /($crlf)\z/; 125 } 126 127 return ($text, $mycrlf || "\n"); 128} 129 130sub body_set { 131 my $self = shift; 132 my $body = shift; 133 134 my $handle = IO::String->new(\$body); 135 $self->{handle} = $handle; 136 $self->{body_pos} = 0; 137} 138 139sub body { 140 my $self = shift; 141 scalar do { 142 local $/; ## no critic Local, Punctuation 143 $self->reset_handle; 144 my $handle = $self->handle; 145 <$handle>; 146 }; 147} 148 149 1501; 151 152__END__ 153 154=pod 155 156=head1 NAME 157 158Email::Simple::FromHandle - an Email::Simple but from a handle 159 160=head1 VERSION 161 162version 0.054 163 164=head1 SYNOPSIS 165 166 use Email::Simple::FileHandle; 167 168 open my $fh, "<", "email.msg"; 169 170 my $email = Email::Simple::FromHandle->new($fh); 171 172 print $email->as_string; 173 # or 174 $email->stream_to(\*STDOUT); 175 176=head1 DESCRIPTION 177 178This is a subclass of Email::Simple which can accept filehandles as the source 179of an email. It will keep a reference to the filehandle and read from it when 180it needs to access the body. It does not load the entire body into memory and 181keep it there. 182 183=head1 METHODS 184 185In addition to the standard L<Email::Simple> interface, the following methods 186are provided: 187 188=head2 handle 189 190This returns the handle given to construct the message. If the message was 191constructed with a string instead, it returns an IO::String object. 192 193=head2 body_pos 194 195This method returns the position in the handle at which the body begins. This 196is used for seeking when re-reading the body. 197 198=head2 reset_handle 199 200This method seeks the handle to the body position and resets the header-line 201iterator. 202 203For unseekable handles (pipes, sockets), this will die. 204 205=head2 getline 206 207 $str = $email->getline; 208 209This method returns either the next line from the headers or the next line from 210the underlying filehandle. It only returns a single line, regardless of 211context. Returns C<undef> on EOF. 212 213=head2 stream_to 214 215 $email->stream_to($fh, [ \%arg ]); 216 217This method efficiently writes the message to the passed-in filehandle. 218 219The second argument may be a hashref of options: 220 221=over 4 222 223=item B<reset_handle:> 224 225Whether or not to call C<< $self->reset_handle >> before reading the message 226(default true). 227 228=item B<chunk_size:> 229 230Number of bytes to read from C<< $self->handle >> at once (default 65536). 231 232=item B<write:> 233 234Coderef to use to print instead of C<print $fh $chunk>. This coderef will 235receive two arguments, the 'filehandle' (which need not be a real filehandle at 236all) and the current chunk of data. 237 238=back 239 240=head1 CREDITS 241 242Ricardo SIGNES wrote Email::Simple. 243 244Numerous improvement, especially streamability the handling of pipes, were made 245by Hans Dieter Pearcey. 246 247=head1 AUTHOR 248 249Ricardo SIGNES <rjbs@cpan.org> 250 251=head1 COPYRIGHT AND LICENSE 252 253This software is copyright (c) 2006 by Ricardo SIGNES. 254 255This is free software; you can redistribute it and/or modify it under 256the same terms as the Perl 5 programming language system itself. 257 258=cut 259