Text::vFile - Generic module which can read and write "vFile" files such as vCard (RFC 2426) and vCalendar (RFC 2445).

    use Text::vFile;

    my $objects = Text::vCard->load( "foo.vCard", "blort.vCard", "whee.vCard" );

    foreach my $card (@$objects) {
        spam ( $card->email('pref') );
    }

    # OR

    my $reader = Text::vFile->new( source_file => "foo.vCard" );
    while ( my $object = $reader->next ) {
        spam ( $object );
    }

    # OR

    my $reader = Text::vFile->new( source_text => $vcard_data );
    while ( my $vcard = <$reader> ) {
        spam ( $vcard );
    }

   $1 is looked up in classMap; class is loaded; new object of this class is created
   ie/ $Text::vFile::classMap{'VCARD'}="Text::vCard";
       $object=$classMap{'VCARD'}->new;

    n.b. classMap is a package variable for Text::vFile

   Signals that all entry data has been obtained and now the rows of data are processed

    There are some generic handlers for common data types such as simple strings, dates, etc. More
    elaborate data types such as N, ADR, etc. need special treatment and are declared explititly
    in classes as "load_XXX" such as "load_N"

  $VAR1 = bless( {

  'EMAIL' => [
    {
      'attr' => {
        'email' => [
          'HOME'
        ],
        'type' => []
      },
      'sequence' => 1,
      'type' => {
        'internet' => 1
      },
      'value' => 'email\\@domain.com'
    }
  ],
  'TITLE' => {
    'value' => 'Job Title'
  },
  'X-ICQ' => [
    {
      'attr' => {
        'type' => [
          'WORK',
          'pref'
        ]
      },
      'sequence' => 11,
      'type' => {
        'pref' => 1,
        'work' => 1
      },
      'value' => '12341234'
    }
  ],
  '_lines' => [
    'VERSION:2.1',
    'N:Person;Test,Given;;;',
    'FN:Test Person',
    ....
  ] 
  }, "Text::vCard");

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

 Leo - for a very productive exchange on how this should work plus suffering
       through a few growing pains. 

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

package Text::vFile;

use strict;

sub load {

	my $self=shift;
       $self=$self->new unless ref($self);

    my @objects=();

	foreach my $fn (@_) {

        $self->source_file( $fn );
        while ( my $object = $self->next ) {
            push @objects, $object;
        }

    }

    return wantarray ? @objects : \@objects;

}

sub parse {

	my $self=shift;
       $self=$self->new unless ref($self);

    my @objects=();

	foreach my $text (@_) {

        $self->source_text( $text );
        until ( $self->eod ) {
            push @objects, $self->next;
        }

    }

    return wantarray ? @objects : \@objects;

}

sub _open {

    my $self=shift;

    warn "No filename supplied" && return unless $self->{'source_file'};
    
    open ($self->{'fh'}, $self->{'source_file'}) or warn "Cannot open $self->{'source_file'}\n";

}

sub source_file {

    my $self=shift;

    if (@_) {
        $self->{'source_file'} = shift;
        delete $self->{'fh'}; 
        delete $self->{'source_text'}; 
    }

    return $self->{'source_file'};

}

sub source_text {

    my $self=shift;

    if (@_) {
        $self->{'source_text'} = shift;
        delete $self->{'fh'}; 
        delete $self->{'source_file'}; 
    }

    return $self->{'source_text'};

}

# Classes inject their desired mappings
use vars qw(%classMap);
%classMap=(

    VFILE     => "Text::vFile::Base",

    # VCALENDAR => "Text::vCalendar",
    # VALARM    => "Text::vCalendar::vAlarm",
    # VEVENT    => "Text::vCalendar::vEvent",
    # VTODO     => "Text::vCalendar::vTodo",

);

sub new {

	my $class = ref($_[0]) ? ref(shift) : shift;
    my $opts = ref($_[0]) ? $_[0] : {@_};

	my $self = bless {}, $class;

    map { $self->$_( $opts->{$_} ) } keys %$opts;

	return $self;

}

use overload
        '<>' => \&next,
        fallback => 1,
;


sub next {

    my $self=shift;

    if ($self->{'source_file'}) {
        $self->_open unless $self->{'fh'};
    }
    my $fh=$self->{'fh'};

    if ($self->{'source_text'}) {
        $self->{'text'} = [ split (/[\r\n]+/, $self->{'source_text'}) ] unless $self->{'text'};
    }

    return () unless $fh || $self->{'text'};

    # my $parent=shift;
    # $self->{'_parent'}=$parent if ref $parent;

    my $line = $fh ? <$fh> : shift @{$self->{'text'}};
    return if $self->eod;
    
    my $decoder;

    # UTF-16/32 detection
    if ( $line =~ /\000/ ) {

        eval "use Encode;";
        die "Cannot decode this file - need the Encode module; $@\n" if $@;

        if ($line =~ /\000\000\000/) {

            if ($line =~ /^\000/) {
                $decoder=Encode::find_encoding("UTF-32BE");
            } else {
                $decoder=Encode::find_encoding("UTF-32LE");
            }

        } else {

            if ($line =~ /^\000/) {
                $decoder=Encode::find_encoding("UTF-16BE");
            } else {
                $decoder=Encode::find_encoding("UTF-16LE");
            }

        }

    }

    $line = $decoder->decode( $line ) if $decoder;

    # VFILE class detection
    #   - see BEGIN until found or return at EOD contition
    until ( $line =~ /^BEGIN:/i ) {
        $line = $fh ? <$fh> : shift @{$self->{'text'}};
        return if $self->eod;
        $line = $decoder->decode( $line ) if $decoder;
    }

    $line =~ /^BEGIN:(.*)/i;
    my $kind=uc $1;
    my $class=$classMap{ $kind };
    die "In parseable begin tag $line - unknown class\n" unless $class;

    eval "use $class";
    die "Cannot load $class\n" if $@;

    my $varHandler=$class->varHandler;
    my $thing=$class->new;

    my @lines=();
    my $ended=0;
    until ( $self->eod ) {

        $line = $fh ? <$fh> : shift @{$self->{'text'}};

        $line = $decoder->decode($line) if $decoder;
        $line =~ s/[\r\n]+$//;

        # Sub object - like EVENT, etc.
        if ($line =~ /^BEGIN:(.+)/) {
            # $thing=$1;
            # my $subclass= $classMap{uc $thing} || die "Don't know how to load ${thing}s\n";
            # eval "use $subclass"; die $@ if $@;
            # push @{$self->{$thing}}, $subclass->new->load($fh, $self);
            # next;
            die "sub object loading not done\n";
        } 

        if ($line =~ /^END:(.*)/) {
            warn "bad end of data block - found END:$1 instead of END:" . uc $kind . "\n" unless uc $1 eq $kind;
            $ended=1;
            last;
        }

        push @lines, $line;

    }
    warn "premature end of data block - missing end tag\n" unless $ended;

    $thing->{'_lines'}= [ @lines ];

    while ( @lines ) {

        my $line = shift @lines;
        while ( @lines && $lines[0] =~ /^\s(.*)/ ) {
            $line .= $1;
            shift @lines;
        }

        # Non-typed line data 
        if ( $line =~ /^([\w\-]+):(.*)/ ) {

            my ($var, $data)=(uc $1, $2);
            my $h;
            if (UNIVERSAL::can( $thing, "load_$var")) {
                $h="load_$var";
            } else {
                $h="load_singleText";
            }
            $h = "load_$varHandler->{$var}" if exists $varHandler->{$var};

            $thing->$h($var, undef, $data);
            next;
        }

        # ATTR OR Typed line data
        if ( $line =~ /^([\w\-]+);([^:]*):(.*)/ ) { 

            my ($var, $attr_dat, $data)=(uc $1, $2, $3);

            my %attr=();
            map { /([^=]+)=(.*)/; push @{$attr{lc $1}}, $2 } split (/(?<!\\);/, $attr_dat);

            my $h;
            
            if (UNIVERSAL::can( $thing, "load_$var")) {
                $h="load_$var";
            } else {
                $h = exists $attr{'type'} ? "load_singleTextTyped" : "load_singleText";
            }

            $h = "load_$varHandler->{$var}" if exists $varHandler->{$var};

            $thing->$h($var, \%attr, $data);
            next;
        }

        $self->error( $line );

    }

    return $thing;

}

sub eod {

    if ( $_[0]->{'fh'} ) {
        return eof $_[0]->{'fh'};
    }

    return 0 if exists $_[0]->{'text'} && @{$_[0]->{'text'}};
    return 1;

}

sub error  { warn ref($_[0]) . " ERRORLINE: $_[1]\n"; }

1;