view release on metacpan or  search on metacpan

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

    $str =~ s!($name_addr(?>$comment*))!$mailboxes{pos($str)} = $1; ',' x length $1!ego
        if $str =~ /$angle_addr/;
    $str =~ s!($addr_spec(?>$comment*))!$mailboxes{pos($str)} = $1; ',' x length $1!ego;
    my @mailboxes = map { $mailboxes{$_} } sort { $a <=> $b } keys %mailboxes;

    my @addrs;
    foreach (@mailboxes) {
      my $original = $_;

      my @comments = /($comment)/go;
      s/$comment//go if @comments;

      my ($user, $host, $com);
      ($user, $host) = ($1, $2) if s/<($local_part)\@($domain)>\s*\z//o;
      if (! defined($user) || ! defined($host)) {
          s/($local_part)\@($domain)//o;
          ($user, $host) = ($1, $2);
      }

      next if $user =~ /\P{ASCII}/;
      next if $host =~ /\P{ASCII}/;

      my ($phrase)       = /($display_name)/o;

      for ( $phrase, $host, $user, @comments ) {
        next unless defined $_;
        s/^\s+//;
        s/\s+$//;
        $_ = undef unless length $_;
      }

      $phrase =~ s/\\(.)/$1/g if $phrase;

      my $new_comment = join q{ }, @comments;
      push @addrs,
        $class->new($phrase, "$user\@$host", $new_comment, $original);
      $addrs[-1]->[_IN_CACHE] = [ \$line, $#addrs ]
    }

    $class->__cache_parse($line, \@addrs);
    return @addrs;
}

#pod =item new
#pod
#pod   my $address = Email::Address->new(undef, 'casey@local');
#pod   my $address = Email::Address->new('Casey West', 'casey@local');
#pod   my $address = Email::Address->new(undef, 'casey@local', '(Casey)');
#pod
#pod Constructs and returns a new C<Email::Address> object. Takes four
#pod positional arguments: phrase, email, and comment, and original string.
#pod
#pod The original string should only really be set using C<parse>.
#pod
#pod =cut

sub new {
  my ($class, $phrase, $email, $comment, $orig) = @_;
  $phrase =~ s/\A"(.+)"\z/$1/ if $phrase;

  bless [ $phrase, $email, $comment, $orig ] => $class;
}

#pod =item purge_cache
#pod
#pod   Email::Address->purge_cache;
#pod
#pod One way this module stays fast is with internal caches. Caches live
#pod in memory and there is the remote possibility that you will have a
#pod memory problem. On the off chance that you think you're one of those
#pod people, this class method will empty those caches.
#pod
#pod I've loaded over 12000 objects and not encountered a memory problem.
#pod
#pod =cut

sub purge_cache {
    %NAME_CACHE   = ();
    %FORMAT_CACHE = ();
    %PARSE_CACHE  = ();
}

#pod =item disable_cache
#pod
#pod =item enable_cache
#pod
#pod   Email::Address->disable_cache if memory_low();
#pod
#pod If you'd rather not cache address parses at all, you can disable (and
#pod re-enable) the Email::Address cache with these methods.  The cache is enabled
#pod by default.
#pod
#pod =cut

sub disable_cache {
  my ($class) = @_;
  $class->purge_cache;
  $NOCACHE = 1;
}

sub enable_cache {
  $NOCACHE = undef;
}

#pod =back
#pod
#pod =head2 Instance Methods
#pod
#pod =over 4
#pod
#pod =item phrase
#pod
#pod   my $phrase = $address->phrase;
#pod   $address->phrase( "Me oh my" );
#pod
#pod Accessor and mutator for the phrase portion of an address.
#pod
#pod =item address
#pod
#pod   my $addr = $address->address;
#pod   $addr->address( "me@PROTECTED.com" );