Text::vCard::Addressbook - a package to parse, edit and create multiple vCards (RFC 2426)

  use Text::vCard::Addressbook;

  my $address_book = Text::vCard::Addressbook->new({
	'source_file' => '/path/to/address.vcf',
  });

  foreach my $vcard ($address_book->vcards()) {
	print "Got card for " . $vcard->fullname() . "\n";
  }

  use Text::vCard::Addressbook;

  # Read in from a list of files
  my $address_book = Text::vCard::Addressbook->load( ['foo.vCard', 'Addresses.vcf']);

  $address_book->import_data($value);

  # Read in from just one file
  my $address_book = Text::vCard::Addressbook->new({
	'source_file' => '/path/to/address.vcf',
  });

  # File already in a string
  my $address_book = Text::vCard::Addressbook->new({
	'source_text' => $source_text,
  });

  # Create a new address book
  my $address_book = Text::vCard::Addressbook->new();

  foreach my $vcard ($address_book->vcards()) {
	$vcard->...;
  }

  my $vcard = $address_book->add_vcard();

  my $vcards = $address_book->vcards();
  my @vcards = $address_book->vcards();

  $address_book->add_vcard('utf-8');

  my $vcf_file = $address_book->export()

package Text::vCard::Addressbook;

use Carp;
use strict;
use File::Slurp;
use Text::vFile::asData;
use Text::vCard;

# See this module for your basic parser functions
use base qw(Text::vFile::asData);

sub load {
    my ( $proto, $files ) = @_;

    my $self = __PACKAGE__->new();

    foreach my $file ( @{$files} ) {
        croak "Unable to read file $file" unless -r $file;
        $self->import_data( scalar read_file($file) );
    }

    return $self;

}

sub import_data {
    my ( $self, $value ) = @_;

    $self->_process_text($value);
}

sub new {
    my ( $proto, $conf ) = @_;
    my $class = ref($proto) || $proto;
    my $self = {};

    if ( defined $conf->{'source_file'} ) {

        # Need to read in source file
        croak "Unable to read file $conf->{'source_file'}\n"
            unless -r $conf->{'source_file'};
        $conf->{'source_text'} = read_file( $conf->{'source_file'} );
    }

    # create some where to store out individual vCard objects
    my @cards;
    $self->{'cards'} = \@cards;

    bless( $self, $class );

    # Process the text if we have it.
    $self->_process_text( $conf->{'source_text'} )
        if defined $conf->{'source_text'};

    return $self;
}

sub add_vcard {
    my $self  = shift;
    my $vcard = Text::vCard->new();
    push( @{ $self->{cards} }, $vcard );
    return $vcard;
}

sub vcards {
    my $self = shift;
    return wantarray ? @{ $self->{cards} } : $self->{cards};
}

sub set_encoding {
    my ( $self, $coding ) = @_;
    $self->{'encoding'} |= '';
    $self->{'encoding'} = ";charset=$coding" if ( defined $coding );
    return $self->{'encoding'};
}

sub export {
    my $self = shift;
    my @lines;
    foreach my $vcard ( $self->vcards() ) {
        push @lines, 'BEGIN:VCARD';
        while ( my ( $node_type, $nodes ) = each %{ $vcard->{nodes} } ) {

            # Make sure all the nodes values are up to date
            my @export_nodes;
            foreach my $node ( @{$nodes} ) {
                my $name = $node_type;
                if ( $node->group() ) {

                    # Add the group in to the name
                    $name = $node->group() . '.' . $node_type;
                }

                my $param;
                $param = join( ',', ( $node->types() ) ) if $node->types();
                $name .= $self->set_encoding();
                $name .= ";TYPE=$param" if $param;
                push( @lines, "$name:" . $node->export_data );
            }
        }
        push @lines, 'END:VCARD';
    }
    my $vcf_file = join( "\r\n", @lines );
    return $vcf_file;
}

# PRIVATE METHODS

# Process a chunk of text, create Text::vCard objects and store in the address book
sub _process_text {
    my ( $self, $text ) = @_;

    # As data may handle \r - must ask richard
    $text =~ s/\r//g;

    if($text =~ /quoted-printable/i) {
        # Edge case for 2.1 version

        my $joinline = 0;

        my $out;
        foreach my $line (split( "\n", $text )) {
            chomp($line);

            if ($joinline) {
                if ( $line =~ /=$/ ) {
                    $line =~ s/=$//;
                    $out .= $line;
                } else {
                    $joinline = 0;
                    $out .= $line . "\n";
                }
                next;
            }

            # find continued QP lines - could be done better
            if ( $line =~ /ENCODING=QUOTED-PRINTABLE/i && $line =~ /=$/ ) {

                $joinline = 1;    # join lines...

                $line =~ s/=$//;
                $out .= $line;
            } else {

                # add regular line;
                $out .= $line . "\n";
            }
        }
        $text = $out;

    }

    # Add error checking here ?
    my $asData = Text::vFile::asData->new;
    $asData->preserve_params(1);

    my $data = $asData->parse_lines( split( "\n", $text ) );
    foreach my $card ( @{ $data->{'objects'} } ) {

        # Run through each card in the data
        if ( $card->{'type'} =~ /VCARD/i ) {
            my $vcard = Text::vCard->new(
                { 'asData_node' => $card->{'properties'}, } );
            push( @{ $self->{'cards'} }, $vcard );
        } else {
            carp
                "This file contains $card->{'type'} data which was not parsed";
        }
    }

}

1;