view release on metacpan or  search on metacpan

lib/E/Mail/Acme.pm  view on Meta::CPAN

    unless ($self->{'content-type'}->[0] =~ qr{boundary="(?:[^"]+)"}) {
      $self->{'content-type'}->[0] .= qq{; boundary="$self->[@$self+1]"};
    }
  }

  join(
    $CRLF,
    $self->{''},
    join($CRLF, @{ $_[0] }, '')
    . (
      @{ $_[0]->[ @{ $_[0] } ] }
      ? "$CRLF--$_[0]->[ @{ $_[0] } + 1 ]$CRLF"
        . join("--$_[0]->[ @{ $_[0] } + 1 ]$CRLF", @{ $_[0]->[ @{ $_[0] } ] })
        . "--$_[0]->[ @{ $_[0] } + 1 ]--$CRLF"
      : ''
    )
  );
};

use overload '&{}' => sub {
  my ($self) = @_;
  sub {
    my ($program) =  @_;
    $program = 'sendmail' unless defined $program and length $program;

    if ($program !~ m{[/\\]}) {
      path: for my $dir (split /:/, $ENV{PATH}) {
        if ( -x "$dir/program" ) {
          $program = "$dir/program";
          last path;
        }
      }
    }

    open  $self, "| $program -t -oi -f $self->{from}->[0]" or die;
    print $self $self or die;
    close $self  or die;
  }
};

use overload '@{}' => sub {
  tie @{*{$_[0]}}, q<E'Mail::Acme::Body> unless @{*{$_[0]}};#'
  return \@{*{$_[0]}};
};

use Scalar::Util qw(refaddr); # XXX

use overload '%{}' => sub {
  tie %{*{$_[0]}}, q<E'Mail::Acme::Header> unless %{*{$_[0]}};#'
  return \%{*{$_[0]}};
};

use overload fallback => 1;

{
  package E'Mail::Acme::HeaderFieldValues;
  our @ISA = qw(E'Mail::Acme::Base);

  sub TIEARRAY {
    my ($class, $name, $gutter) = @_;
    bless [ $name, $gutter ] => $class;
  }

  sub FETCHSIZE {
    my ($self) = @_;
  
    my $gut = $self->[1]->();

    my $hits = 0;
    i: for (my $i = 0; $i < $#$gut; $i += 2) {
      lc $gut->[ $i ] eq lc $self->_idx(0) and $hits++;
    }

    return $hits;
  }

  sub EXISTS {
    my ($self, $idx) = @_;
    return $idx <= $self->FETCHSIZE;
  }

  sub FETCH {
    my ($self, $idx) = @_;

    my $gut = $self->_idx(1)->();

    i: for (my $i = 0; $i < $#$gut; $i += 2) {
      lc $gut->[ $i ] eq lc $self->_idx(0) or next i;
      return $gut->[ $i + 1 ] if $idx == 0;
      $idx--;
    }

    return;
  }

  sub DELETE {
    my ($self, $idx) = @_;
    $self->SPLICE($idx, 1);
  }

  sub CLEAR {
    my ($self) = @_;
    $self->SPLICE(0, $self->FETCHSIZE);
  }

  sub EXTEND { }

  sub SPLICE {
    my ($self, $idx, $length, @new) = @_;

    if ($idx >= $self->FETCHSIZE) {
      return $self->PUSH(@new);
    }

    my $gut = $self->_idx(1)->();

    i: for (my $i = 0; $i < $#$gut; $i += 2) {
      lc $gut->[ $i ] eq lc $self->_idx(0) or next;
      if ($idx == 0) {
        if ($length == 0) {
          splice @$gut, $i, 0, map { $self->_idx(0), $_ } @new;