Beta Shell v2.0

File Manager

~ /usr/share/perl5/vendor_perl/Mail/Message/Body

Name	Size	Perms	Modified	Actions
[ .. / .. ]
Construct.pm	3.49 KB	-rw-r--r--	2019-02-11 11:31:02	Edit Del
Construct.pod	4.8 KB	-rw-r--r--	2019-02-11 11:31:05	Edit Del
Delayed.pm	2.47 KB	-rw-r--r--	2019-10-04 15:36:31	Edit Del
Delayed.pod	4.75 KB	-rw-r--r--	2019-10-04 15:36:37	Edit Del
Encode.pm	8.54 KB	-rw-r--r--	2019-02-11 11:31:02	Edit Del
Encode.pod	6.61 KB	-rw-r--r--	2019-02-11 11:31:05	Edit Del
File.pm	5.07 KB	-rw-r--r--	2019-02-11 11:31:03	Edit Del
File.pod	11.76 KB	-rw-r--r--	2019-02-11 11:31:05	Edit Del
Lines.pm	2.89 KB	-rw-r--r--	2019-02-11 11:31:02	Edit Del
Lines.pod	11.41 KB	-rw-r--r--	2019-02-11 11:31:05	Edit Del
Multipart.pm	10.81 KB	-rw-r--r--	2019-02-11 11:31:02	Edit Del
Multipart.pod	16.86 KB	-rw-r--r--	2019-02-11 11:31:05	Edit Del
Nested.pm	3.39 KB	-rw-r--r--	2019-02-11 11:31:02	Edit Del
Nested.pod	12.43 KB	-rw-r--r--	2019-02-11 11:31:05	Edit Del
String.pm	2.91 KB	-rw-r--r--	2019-02-11 11:31:02	Edit Del
String.pod	11.47 KB	-rw-r--r--	2019-02-11 11:31:05	Edit Del

Editing: Construct.pm (3.49 KB)

# Copyrights 2001-2019 by [Mark Overmeer <markov@cpan.org>].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# This code is part of distribution Mail-Message.  Meta-POD processed with
# OODoc into POD and HTML manual-pages.  See README.md
# Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.

package Mail::Message::Body;
use vars '$VERSION';
$VERSION = '3.008';

# Mail::Message::Body::Construct adds functionality to Mail::Message::Body

use strict;
use warnings;

use Carp;
use Mail::Message::Body::String;
use Mail::Message::Body::Lines;


sub foreachLine($)
{   my ($self, $code) = @_;
    my $changes = 0;
    my @result;

    foreach ($self->lines)
    {   my $becomes = $code->();
        if(defined $becomes)
        {   push @result, $becomes;
            $changes++ if $becomes ne $_;
        }
        else {$changes++}
    }
      
    $changes
        or return $self;

    ref($self)->new
      ( based_on => $self
      , data     => \@result
      );
}

#------------------------------------------


sub concatenate(@)
{   my $self = shift;

    return $self
        if @_==1;

    my @unified;
    foreach (@_)
    {   next unless defined $_;
        push @unified
         , !ref $_           ? $_
         : ref $_ eq 'ARRAY' ? @$_
         : $_->isa('Mail::Message')       ? $_->body->decoded
         : $_->isa('Mail::Message::Body') ? $_->decoded
         : carp "Cannot concatenate element ".$_;
    }

    ref($self)->new
      ( based_on  => $self
      , mime_type => 'text/plain'
      , data      => join('', @unified)
      );
}

#------------------------------------------


sub attach(@)
{   my $self  = shift;

    my @parts;
    push @parts, shift while @_ && ref $_[0];

    return $self unless @parts;
    unshift @parts,
      ( $self->isNested    ? $self->nested
      : $self->isMultipart ? $self->parts
      : $self
      );

    return $parts[0] if @parts==1;
    Mail::Message::Body::Multipart->new(parts => \@parts, @_);
}

#------------------------------------------


# tests in t/51stripsig.t

sub stripSignature($@)
{   my ($self, %args) = @_;

    return $self if $self->mimeType->isBinary;

    my $pattern = !defined $args{pattern} ? qr/^--\s?$/
                : !ref $args{pattern}     ? qr/^\Q${args{pattern}}/
                :                           $args{pattern};
 
    my $lines   = $self->lines;   # no copy!
    my $stop    = defined $args{max_lines}? @$lines - $args{max_lines}
                : exists $args{max_lines} ? 0 
                :                           @$lines-10;

    $stop = 0 if $stop < 0;
    my ($sigstart, $found);
 
    if(ref $pattern eq 'CODE')
    {   for($sigstart = $#$lines; $sigstart >= $stop; $sigstart--)
        {   next unless $pattern->($lines->[$sigstart]);
            $found = 1;
            last;
        }
    }
    else
    {   for($sigstart = $#$lines; $sigstart >= $stop; $sigstart--)
        {   next unless $lines->[$sigstart] =~ $pattern;
            $found = 1;
            last;
        }
    }
 
    return $self unless $found;
 
    my $bodytype = $args{result_type} || ref $self;

    my $stripped = $bodytype->new
      ( based_on => $self
      , data     => [ @$lines[0..$sigstart-1] ]
      );

    return $stripped unless wantarray;

    my $sig      = $bodytype->new
      ( based_on => $self
      , data     => [ @$lines[$sigstart..$#$lines] ]
      );
      
    ($stripped, $sig);
}

#------------------------------------------

1;