view release on metacpan or  search on metacpan

lib/Email/MIME.pm  view on Meta::CPAN

my %gcache;

sub filename {
  my ($self, $force) = @_;
  return $gcache{$self} if exists $gcache{$self};

  my $dis = $self->header_raw("Content-Disposition") || '';
  my $attrs = parse_content_disposition($dis)->{attributes};
  my $name = $attrs->{filename}
    || $self->{ct}{attributes}{name};
  return $name if $name or !$force;
  return $gcache{$self} = $self->invent_filename(
    $self->{ct}->{type} . "/" . $self->{ct}->{subtype});
}

my $gname = 0;

sub invent_filename {
  my ($self, $ct) = @_;
  require MIME::Types;
  my $type = MIME::Types->new->type($ct);
  my $ext = $type && (($type->extensions)[0]);
  $ext ||= "dat";
  return "attachment-$$-" . $gname++ . ".$ext";
}

sub default_header_class { 'Email::MIME::Header' }

sub header_str {
  my $self = shift;
  $self->header_obj->header_str(@_);
}

sub header_str_set {
  my $self = shift;
  $self->header_obj->header_str_set(@_);
}

sub header_str_pairs {
  my $self = shift;
  $self->header_obj->header_str_pairs(@_);
}

sub header_as_obj {
  my $self = shift;
  $self->header_obj->header_as_obj(@_);
}

#pod =method content_type_set
#pod
#pod   $email->content_type_set( 'text/html' );
#pod
#pod Change the content type. All C<Content-Type> header attributes
#pod will remain intact.
#pod
#pod =cut

sub content_type_set {
  my ($self, $ct) = @_;
  my $ct_header = parse_content_type($self->header('Content-Type'));
  @{$ct_header}{qw[type subtype]} = split m[/], $ct;
  $self->_compose_content_type($ct_header);
  $self->_reset_cids;
  return $ct;
}

#pod =method charset_set
#pod
#pod =method name_set
#pod
#pod =method format_set
#pod
#pod =method boundary_set
#pod
#pod   $email->charset_set( 'UTF-8' );
#pod   $email->name_set( 'some_filename.txt' );
#pod   $email->format_set( 'flowed' );
#pod   $email->boundary_set( undef ); # remove the boundary
#pod
#pod These four methods modify common C<Content-Type> attributes. If set to
#pod C<undef>, the attribute is removed. All other C<Content-Type> header
#pod information is preserved when modifying an attribute.
#pod
#pod =cut

BEGIN {
  foreach my $attr (qw[charset name format]) {
    my $code = sub {
      my ($self, $value) = @_;
      my $ct_header = parse_content_type($self->header('Content-Type'));
      if ($value) {
        $ct_header->{attributes}->{$attr} = $value;
      } else {
        delete $ct_header->{attributes}->{$attr};
      }
      $self->_compose_content_type($ct_header);
      return $value;
    };

    no strict 'refs';  ## no critic strict
    *{"$attr\_set"} = $code;
  }
}

sub boundary_set {
  my ($self, $value) = @_;
  my $ct_header = parse_content_type($self->header('Content-Type'));

  if (length $value) {
    $ct_header->{attributes}->{boundary} = $value;
  } else {
    delete $ct_header->{attributes}->{boundary};
  }
  $self->_compose_content_type($ct_header);

  $self->parts_set([ $self->parts ]) if $self->parts > 1;
}

sub content_type_attribute_set {
  my ($self, $key, $value) = @_;
  $key = lc $key;