home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / AddrList.pm < prev    next >
Encoding:
Perl POD Document  |  2004-03-29  |  2.4 KB  |  113 lines
  1. package Mail::Field::AddrList;
  2.  
  3. =head1 NAME
  4.  
  5. Mail::Field::AddrList - object representation of e-mail address lists
  6.  
  7. =head1 DESCRIPTION
  8.  
  9. I<Don't use this class directly!> Instead ask Mail::Field for new
  10. instances based on the field name!
  11.  
  12. =head1 SYNOPSIS
  13.  
  14.   use Mail::Field::AddrList;
  15.  
  16.   $to = Mail::Field->new('To');
  17.   $from = Mail::Field->new('From', 'poe@daimi.aau.dk (Peter Orbaek)');
  18.  
  19.   $from->create('foo@bar.com' => 'Mr. Foo', poe => 'Peter');
  20.   $from->parse('foo@bar.com (Mr Foo), Peter Orbaek <poe>');
  21.  
  22.   # make a RFC822 header string
  23.   print $from->stringify(),"\n";
  24.  
  25.   # extract e-mail addresses and names
  26.   @addresses = $from->addresses();
  27.   @names = $from->names();
  28.  
  29.   # adjoin a new address to the list
  30.   $from->set_address('foo@bar.com', 'Mr. Foo');
  31.  
  32. =head1 NOTES
  33.  
  34. Defines parsing and formatting according to RFC822, of the following fields:
  35. To, From, Cc, Reply-To and Sender.
  36.  
  37. =head1 AUTHOR
  38.  
  39. Peter Orbaek <poe@cit.dk> 26-Feb-97
  40. Modified by Graham Barr <gbarr@pobox.com>
  41. Maintained by Mark Overmeer <mailtools@overmeer.net>
  42.  
  43. Copyright (c) 2002-2003 Mark Overmeer. All rights
  44. reserved. This program is free software; you can redistribute it and/or
  45. modify it under the same terms as Perl itself.
  46.  
  47. =cut
  48.  
  49. use strict;
  50. use vars qw(@ISA $VERSION);
  51. use Mail::Field ();
  52. use Carp;
  53. use Mail::Address;
  54.  
  55. @ISA = qw(Mail::Field);
  56. $VERSION = '1.62';
  57.  
  58. # install header interpretation, see Mail::Field
  59. INIT: {
  60.     my $x = bless([]);
  61.  
  62.     $x->register('To');
  63.     $x->register('From');
  64.     $x->register('Cc');
  65.     $x->register('Reply-To');
  66.     $x->register('Sender');
  67. }
  68.  
  69. sub create {
  70.     my ($self, %arg) = @_;  # (email => name, email => realname,...)
  71.     my($e,$n);
  72.     $self->{AddrList} = {};
  73.  
  74.     $self->{AddrList}{$e} = Mail::Address->new($n,$e)
  75.     while(($e,$n) = each %arg);
  76.  
  77.     $self;
  78. }
  79.  
  80. sub parse {
  81.     my ($self, $string) = @_;
  82.     my ($a,$email,$name);
  83.  
  84.     foreach $a (Mail::Address->parse($string)) {
  85.     my $e = $a->address;
  86.     $self->{AddrList}{$e} = $a;
  87.     }
  88.     $self;
  89. }
  90.  
  91. sub stringify {
  92.     my $self = shift;
  93.     my ($x, $email, $name);
  94.  
  95.     join(", ", map { $_->format } values %{$self->{AddrList}});
  96. }
  97.  
  98. sub addresses {
  99.     keys %{shift->{AddrList}};
  100. }
  101.  
  102. sub names {
  103.     map { $_->name } values %{shift->{AddrList}};
  104. }
  105.  
  106. sub set_address {
  107.     my ($self, $email, $name) = @_;
  108.     $self->{AddrList}{$email} = Mail::Address->new($name, $email);
  109.     $self;
  110. }
  111.  
  112. 1;
  113.