Net::vCard - Read and write vCard files (RFC 2426). vCard files hold personal information that you would typically find on a business card. Name, numbers, addresses, and even logos. This module can also serve as a base class for other vFile readers.

  use Net::vCard;

  my $cards=Net::vCard->loadFile( "addresses.vcf" );

  foreach my $card ( @$cards ) {

    print $card->givenName,       " ",  $card->familyName, "\n";
    print $card->ADR->address,    "\n"; 
    print $card->ADR->city,       " ",  $card->ADR->region, "\n";
    print $card->ADR->postalCode, "\n";

    print $card->ADR("home")->address,    "\n"; 
    print $card->ADR("home")->city,       " ",  $card->ADR("home")->region, "\n";
    print $card->ADR("home")->postalCode, "\n";

  }

  - go ahead and access the hash values directly for the time being
  - keep in mind that I will be making a get/set method interface
  - once that is established you will need to use that interface instead

 $card->ADR( type )->field;
 $card->ADR( )->city;           # Default address, city field
 $card->ADR( "home" )->address; # Home address type, address field

 Jay J. Lawrence - jlawrenc@cpan.org
 Infonium Inc., Canada
 http://www.infonium.ca/

 Net::iCal - whose loading code inspired me for mine

package Net::vCard;

use strict;
use warnings;

our $VERSION=0.1;
our $WARN=0;

use base qw(Net::vFile);
use Net::vCard::ADR;

$Net::vFile::classMap{'VCARD'}=__PACKAGE__;

sub familyName { 
    if (exists $_[1]) {
        $_[0]->{'N'}{'familyName'}=$_[1];
    }
    return $_[0]->{'N'}{'familyName'};
};

sub givenName { 
    if (exists $_[1]) {
        $_[0]->{'N'}{'givenName'}=$_[1];
    }
    return $_[0]->{'N'}{'givenName'};
};

sub additionalNames { 
    if (exists $_[1]) {
        $_[0]->{'N'}{'additionalNames'}=$_[1];
    }
    return $_[0]->{'N'}{'additionalNames'};
};

sub suffixes { 
    if (exists $_[1]) {
        $_[0]->{'N'}{'suffixes'}=$_[1];
    }
    return $_[0]->{'N'}{'suffixes'};
};

sub prefixes { 
    if (exists $_[1]) {
        $_[0]->{'N'}{'prefixes'}=$_[1];
    }
    return $_[0]->{'N'}{'prefixes'};
};

sub ADR  {

    my $self=shift;
    my $reqType=shift || $self->{'ADR'}{'_pref'};

    foreach my $type ( $reqType, @{$self->typeDefault->{'ADR'}} ) {
        next unless $type;
        if (exists $self->{'ADR'}{$type}) {
            return $self->{'ADR'}{$type};
        }

        if (exists $self->{'ADR'}{'_alias'}{$type}) {
            return $self->{'ADR'}{'_alias'}{$type};
        }
    }

    warn "No address found\n" if $WARN;
    my $adrPkg=ref($self) . "::ADR";
    return $adrPkg->new;

}

sub FN   { $_[0]->_singleText( "FN", $_[1] ); }
sub BDAY { $_[0]->_singleText( "BDAY", $_[1] ); }

sub varHandler {

    return {
        'FN'          => 'singleText',
        'N'           => 'N',
        'NICKNAME'    => 'multipleText',
        'PHOTO'       => 'singleBinary',
        'BDAY'        => 'singleText',
        'ADR'         => 'ADR',
        'LABEL'       => 'singleTextTyped',
        'TEL'         => 'singleTextTyped',
        'EMAIL'       => 'singleTextTyped',
        'MAILER'      => 'singleText',
        'TZ'          => 'singleText',
        'GEO'         => 'GEO',
        'TITLE'       => 'singleText',
        'ROLE'        => 'singleText',
        'LOGO'        => 'singleBinary',
        'AGENT'       => 'singleText',
        'ORG'         => 'multipleText',
        'CATEGORIES'  => 'multipleText',
        'NOTE'        => 'singleText',
        'PRODID'      => 'singleText',
        'REV'         => 'singleText',
        'SORT-STRING' => 'singleText',
        'SOUND'       => 'singleBinary',
        'UID'         => 'singleText',
        'URL'         => 'singleText',
        'VERSION'     => 'singleText',
        'CLASS'       => 'singleText',
        'KEY'         => 'singleBinary',
    };

}

sub typeDefault {

    return {
        'ADR'     => [ qw(intl postal parcel work) ],
        'LABEL'   => [ qw(intl postal parcel work) ],
        'TEL'     => [ qw(voice) ],
        'EMAIL'   => [ qw(internet) ],
    };

}

sub load_N {

	die "load_N: @_ cannot have attributes\n" if $_[2];
	
    no warnings;
	my @parts = split /(?<!\\);/, $_[3];
	map { s/\\;/;/g; } @parts;

	my @additional = split /(?<!\\),/, $parts[2];
	map { s/\\,/,/g; } @additional;

	my @prefixes = split /(?<!\\),/, $parts[3];
	map { s/\\,/,/g; } @prefixes;

	my @suffixes = split /(?<!\\),/, $parts[4];
	map { s/\\,/,/g; } @suffixes;

	$_[0]->{$_[1]} = {
		familyName      => $parts[0],
		givenName       => $parts[1],
		additionalNames => \@additional,
		suffixes        => \@suffixes,
		prefixes        => \@prefixes,
	};

}

sub load_ADR {

    my $attr=$_[2];

    my %type=();
    map { map { $type{lc $_}=1 } split /,/, $_ } @{$attr->{TYPE}};
    my $typeDefault=$_[0]->typeDefault;
    map { $type{ lc $_ }=1 } @{$typeDefault->{$_[1]}} unless scalar(keys %type);

	my @parts = split /(?<!\\);/, $_[3];
	map { s/\\;/;/g; s/\\n/\n/gs; } @parts;

    my $pref=0;
    if ($type{pref}) {
        delete $type{pref};
        $pref=1;
    }
    my @types=sort keys %type;

	# What to do about comma separated things?

    my $actual=shift @types;
    my $adrPkg = ref($_[0]) . "::ADR";

	$_[0]->{$_[1]}{$actual} = $adrPkg->new( {
		poBox           => $parts[0],
		extendedAddress => $parts[1],
		address         => $parts[2],
		city            => $parts[3],
		region          => $parts[4],
		postalCode      => $parts[5],
		country         => $parts[6],
	});

    $_[0]->{$_[1]}{_pref}=$actual if $pref;
    delete $_[0]->{$_[1]}{_alias}{$actual};
    map { $_[0]->{$_[1]}{_alias}{$_}=$actual unless exists $_[0]->{$_[1]}{$_} } @types;

}

1;