Text::SimpleVcard - a package to manage a single vCard

   use Text::SimpleVcard;

   open FH, "< std.vcf";        # 'std.vcf' contains a single vcard-entry
   my $vCard = Text::SimpleVcard->new( join( '', <FH>));
   $vCard->print();
   print "FN=" . $vCard->getSimpleValue( 'FN') . "\n";
   print "fullname=" . $vCard->getFullName() . "\n";
   my %h = $vCard->getValuesAsHash( 'TEL', [qw( WORK HOME)]);

   print "phone-numbers are:\n";
   foreach( keys %h) {
      print "Got number $_ ($h{$_})\n";
   }

   my $vCard = simpleVcard->new( $dat);

   $vCard->print();
   $vCard->sprint();

   $vCard->getSimpleValue( $prop);
   $vCard->getSimpleValue( $prop, $n);

   $vCard->getSimpleValueOfType( $prop, [qw( WORK HOME)]]);
   $vCard->getSimpleValueOfType( $prop, [qw( WORK HOME)]], $n);

   $vCard->getFullName();

   $vCard->getValuesAsHash( 'TEL', [qw( WORK HOME)]]);

    perldoc Text::SimpleVcard

# ===========================================================================
# Text::SimpleVproperty - a package to manage a single vCard-property
# ===========================================================================
package Text::SimpleVproperty;

use warnings;
use strict;

use MIME::QuotedPrint();

# ---------------------------------------------------------------------------
# Check if a value is element of an array
# ---------------------------------------------------------------------------
sub isIn {
   my $val = shift;
   return( scalar grep( /^$val$/, @_) > 0);
}

sub new {
   my( $class, $data) = @_;
   my $self = {};
   my $enc = "";

   my ( $meta, $val) = ( $data =~ /(.*?):(.*)/);
   my @meta = split( /;/, $meta);
   $self->{ name} = uc( shift( @meta));

   foreach( @meta){
      my( $key, $val) = ( "TYPE", $_);
      
      if( $val =~ /=/) {
         ( $key, $val) = split( /\s*=\s*/);
      }
      if( $key eq "ENCODING") {
	 $enc = $val;
	 next;
      }

      if( $key =~ /TYPE/i) {
	 push( @{$self->{ types}}, $val) if( !isIn( $val, @{$self->{ types}}));
      } else {
	 ${ $self->{ param}}{ $key} = $val;
      }
   }
   if( $enc eq "QUOTED-PRINTABLE") {
      $self->{ val} = MIME::QuotedPrint::decode_qp( $val);
   } else {
      $self->{ val} = $val;
   }

   bless( $self, $class);
}

sub hasType {
   my( $class, $typ) = @_;

   return isIn( uc( $typ), @{ $class->{ types}});
}

sub sprint {
   my( $class) = @_;
   my $res = "$class->{ name}";

   foreach( @{ $class->{ types}}) {
      $res .= ";TYPE=$_";
   }
   foreach( keys %{ $class->{ param}}) {
      my $val = ${ $class->{ param}}{ $_};
      $res .= ";$_" . ( defined( $val) ? "=$val" : "");
   }
   $res .= ":$class->{ val}";
   return $res;
}

sub print {
   my( $class, $hdr) = @_;

   print $hdr if( $hdr);
   print $class->sprint() . "\n";
}

# ===========================================================================
# Text::SimpleVcard - a package to manage a single vCard
# ===========================================================================
package Text::SimpleVcard;

use warnings;
use strict;

our $VERSION = '0.05';

sub new {
   my( $class, $data) = @_;
   my $self = {};

   $data =~ s/[\r\n]+ +//gm;            # lines starting with space belong to last line (unfolding)
   my @data = split( /[\r\n]+/, $data);
   my( $fl, $ll) = ( shift( @data), pop( @data));	# chop enclosing BEGIN-, END-lines

   if( $fl ne "BEGIN:VCARD" and $ll ne "END:VCARD") {	# check if they are syntactically correct
      warn "vcard should begin with VCARD:BEGIN and end with VCARD:END";
      return;
   }

   my $vCardCnt = 0;
   foreach( @data) {
      $vCardCnt++ if( /^BEGIN:VCARD/);          #
      $vCardCnt-- if( /^END:VCARD/);            # skip nested vcards
      next if( $vCardCnt != 0 or /^END:VCARD/); #
      my $p = Text::SimpleVproperty->new( $_);  # push new property on the array behind the ...
      push( @{ $self->{ $p->{ name}}}, $p);     # ... hash-value of the key with the property-name
   }
   bless( $self, $class);
}

sub sprint {
   my( $class) = @_;
   my $res = '';

   foreach my $propKey ( keys %$class) {
      foreach my $prop ( @{ $class->{ $propKey}}) {
	 $res .= $prop->sprint() . "\n";
      }
   }
   chomp( $res);
   return $res;
}

sub print {
   my( $class) = @_;

   print $class->sprint() . "\n";
}

sub getSimpleValue {
   my( $class, $prop, $ndx) = ( @_, 0);		# setting ndx=0 if not provided

   my $aryRef = $class->{ uc( $prop)};
   return undef if( ! defined( $aryRef));	# property-name does not exist

   my @ary = @$aryRef;	# using aryRef directly works under perl 5.8 but not under 5.10
   my $propRef = $ary[ $ndx];
   return undef if( ! defined( $propRef));	# no index '$ndx' for the requested property

   return $propRef->{ val};
}

sub getSimpleValueOfType {
   my( $class, $prop, $types, $ndx) = ( @_, 0);	# setting ndx=0 if not provided
   my %h = $class->getValuesAsHash( $prop, $types);

   return ( keys %h)[ $ndx];
}

sub getFullName {
   my( $class) = @_;

   my $fn = $class->getSimpleValue( 'FN');
   $fn =~ s/\\//g if( defined( $fn));
   return $fn;
}

sub getValuesAsHash {
   my( $class, $props, $types) = @_;
   my %res = ();                                        # key=prop-value (e.g. '(07071) 82479')

   foreach my $prop ( @{ $class->{ $props}}) {          # e.g all entries with name='TEL'
      my @types = $types ? @$types : @{ $prop->{ types}};# take all types, if none required
      foreach my $type ( @types) {			# loop over all requested types
	 if( $prop->hasType( uc( $type))) {
	    push( @{ $res{ $prop->{ val}}}, $type);     # push entry in val-part of 'res'
	 }
      }
   }

   foreach ( keys %res) {  	                        # replace arrays with CSV-value (string)
      my $str = "";

      foreach ( @{ $res{ $_}}) {
	 $str .= "$_,";
      }
      chop( $str);
      $res{ $_} = $str;
   }
   return %res;
}

1; # End of Text::SimpleVcard