view release on metacpan or  search on metacpan

lib/XML/SAXDriver/vCard.pm  view on Meta::CPAN

  # END:vCard
  elsif ($ln =~ /^EN/i) {
    $self->_saxify($vcard);

    # We return 0 explicitly since that
    # is the signal to the calling method
    # that %$vcard should be emptied.
    return 0;
  }

  return 1
}

sub start_document {
  my $self = shift;

  $self->SUPER::start_document();
  $self->SUPER::xml_decl({Version=>"1.0"});
  # Add DOCTYPE stuff for X-LABEL here
  $self->start_prefix_mapping({Prefix=>"",NamespaceURI=>NS->{VCARD}});
  $self->SUPER::start_element({Name=>"vCardSet"});
  return 1;
}

sub end_document {
  my $self = shift;

  $self->SUPER::end_element({Name=>"vCardSet"});
  $self->end_prefix_mapping({Prefix=>""});
  $self->SUPER::end_document();
  return 1;
}

sub _saxify {
  my $self  = shift;
  my $vcard = shift;

  # See also : comments in &_parse()

  my $attrs = {
	       "{}version" => {Name=>"version",
			       Value=>VCARD_VERSION},
	       "{}class"=>{Name=>"class",
			   Value=>($vcard->{class} || "PUBLIC")},
	      };

  foreach ("uid","lang","rev","prodid") {
    if (exists($vcard->{$_})) {
      $attrs->{"{}$_"} = {Name=>$_,
			  Value=>$vcard->{$_}};
    }
  }

  #

  $self->SUPER::start_element({Name=>"vCard",Attributes=>$attrs});

  #

  # FN:
  $self->_pcdata({name=>"fn",value=>$vcard->{'fn'}});

  # N:
  $self->SUPER::start_element({Name=>"n"});

  foreach ("family","given","other","prefix","suffix") {
    $self->_pcdata({name=>$_,value=>$vcard->{'n'}{$_}});
  }

  $self->SUPER::end_element({Name=>"n"});

  # NICKNAME:
  if (exists($vcard->{'nickname'})) {
    $self->_pcdata({name=>"nickname",value=>$vcard->{'nickname'}});
  }

  # PHOTO:
  if (exists($vcard->{'photo'})) {
    $self->_media({name=>"photo",%{$vcard->{photo}}});
  }

  # BDAY:
  if (exists($vcard->{'bday'})) {
    $self->_pcdata({name=>"bday",value=>$vcard->{'bday'}});
  }

  # ADR:
  if (ref($vcard->{'adr'}) eq "ARRAY") {
    foreach my $adr (@{$vcard->{'adr'}}) {

      &_munge_type(\$adr->{type});

      $self->SUPER::start_element({Name=>"adr",
				   Attributes=>{"{}del.type"=>{Name=>"del.type",Value=>$adr->{type}}}
				  });

      foreach ("pobox","extadr","street","locality","region","pcode","country") {
	$self->_pcdata({name=>$_,value=>$adr->{$_}});
      }

      $self->SUPER::end_element({Name=>"adr"});
    }
  }

  # LABEL
  # $self->label();

  if (ref($vcard->{'tel'}) eq "ARRAY") {

    foreach my $t (@{$vcard->{'tel'}}) {
      &_munge_type(\$t->{type});

      $self->_pcdata({name=>"tel",value=>$t->{number},
		      attrs=>{"{}tel.type"=>{Name=>"tel.type",Value=>$t->{type}}}
		     });
    }
  }

  # EMAIL:

  if (ref($vcard->{'email'}) eq "ARRAY") {

    foreach my $e (@{$vcard->{'email'}}) {
      &_munge_type(\$e->{type});

      $self->_pcdata({name=>"email",value=>$e->{address},
		      attrs=>{"{}email.type"=>{Name=>"email.type",Value=>$e->{type}}}
		     });
    }
  }

  # MAILER:
  if (exists($vcard->{'mailer'})) {
    $self->_pcdata({name=>"mailer",
		    value=>$vcard->{'mailer'}});
  }

  # TZ:
  if (exists($vcard->{'tz'})) {
    $self->_pcdata({name=>"tz",
		    value=>$vcard->{'tz'}});
  }

  # GEO:
  if (exists($vcard->{'geo'})) {
    $self->SUPER::start_element({Name=>"geo"});
    $self->_pcdata({name=>"lat",value=>$vcard->{'geo'}{'lat'}});
    $self->_pcdata({name=>"lon",value=>$vcard->{'geo'}{'lon'}});
    $self->SUPER::end_element({Name=>"geo"});
  }

  # TITLE:
  if (exists($vcard->{'title'})) {
    $self->_pcdata({name=>"title",value=>$vcard->{'title'}});
  }

  # ROLE
  if (exists($vcard->{'role'})) {
    $self->_pcdata({name=>"role",value=>$vcard->{'role'}});
  }

  # LOGO:
  if (exists($vcard->{'logo'})) {
    $self->_media({name=>"logo",%{$vcard->{'logo'}}});
  }

  # AGENT:
  if (exists($vcard->{agent})) {
    $self->SUPER::start_element({Name=>"agent"});

    if ($vcard->{agent}{uri}) {
      $self->_pcdata({name=>"extref",attrs=>{"{}uri"=>{Name=>"uri",
						       Value=>$vcard->{'agent'}{'uri'}}}
		     });
    }

    else {
      $self->_parse_str($vcard->{agent}{vcard});
    }

    $self->SUPER::end_element({Name=>"agent"});
  }

  # ORG:
  if (exists($vcard->{'org'})) {
    $self->SUPER::start_element({Name=>"org"});
    $self->_pcdata({name=>"orgnam",value=>$vcard->{'org'}{'name'}});
    $self->_pcdata({name=>"orgunit",value=>$vcard->{'org'}{'unit'}});
    $self->SUPER::end_element({Name=>"org"});
  }

  # CATEGORIES:
  if (ref($vcard->{'categories'}) eq "ARRAY") {
    $self->SUPER::start_element({Name=>"categories"});
    foreach (@{$vcard->{categories}}) {
      $self->_pcdata({name=>"item",value=>$_});
    }
    $self->SUPER::end_element({Name=>"categories"});
  }

  # NOTE:
  if (exists($vcard->{'note'})) {
    $self->_pcdata({name=>"note",value=>$vcard->{'note'}});
  }

  # SORT:
  if (exists($vcard->{'sort'})) {
    $self->_pcdata({name=>"sort",value=>$vcard->{'sort'}});
  }

  # SOUND:
  if (exists($vcard->{'sound'})) {
    $self->_media({name=>"sound",%{$vcard->{'sound'}}});
  }

  # URL:
  if (ref($vcard->{'url'}) eq "ARRAY") {
    foreach (@{$vcard->{'url'}}) {
      $self->_pcdata({name=>"url",
		      Attributes=>{"{}uri"=>{Name=>"uri",Value=>$_}}});
    }
  }

  # KEY:
  if (exists($vcard->{'key'})) {
    $self->_media($vcard->{key});
  }

  # $self->xcustom();

  $self->SUPER::end_element({Name=>"vCard"});

  return 1;
}

sub _pcdata {
  my $self = shift;
  my $data = shift;
  $self->SUPER::start_element({Name=>$data->{name},Attributes=>$data->{attrs}});
  $self->SUPER::start_cdata() if ($data->{cdata});
  $self->SUPER::characters({Data=>$data->{value}});
  $self->SUPER::end_cdata() if ($data->{cdata});
  $self->SUPER::end_element({Name=>$data->{name}});
  return 1;
}

sub _media {
  my $self = shift;
  my $data = shift;

  my $attrs = {};

  # as in not 'key' and not something pointing to an 'uri'
  if ((! $data->{name} =~ /^k/) && ($data->{type})) {

    # as in 'photo' or 'logo' and not 'sound'
    my $mime = ($data->{name} =~ /^[pl]/i) ? "img" : "aud";
    $attrs = {"{}$mime.type"=>{Name=>"$mime.type",Value=>$data->{type}}};
  }

  $self->SUPER::start_element({Name=>$data->{name},Attributes=>$attrs});

  if ($data->{url}) {
     $self->_pcdata({name=>"extref",attrs=>{"{}uri"=>{Name=>"uri",
						      Value=>$data->{url}}}
		    });
  }

  else {
    $self->_pcdata({name=>"b64bin",value=>$data->{b64},cdata=>1});
  }

  $self->SUPER::end_element({Name=>$data->{name}});
  return 1;
}

# Convert all type data into a value list

sub _munge_type {
  my $sr_str = shift;
  $$sr_str || return;

  # Remove the leading TYPE=
  # declaration: see also $regexp_type
  $$sr_str =~ s/^TYPE=//i;

  # Remove any subsequent TYPE=
  # thingies and replace them
  # with commas
  $$sr_str =~ s/;TYPE=/,/gi;
}

sub DESTROY {}

=head1 VERSION

0.05

=head1 DATE

February 18, 2003

=head1 AUTHOR

Aaron Straup Cope

=head1 NOTES

=head2 What about representing vCard objects in RDF/XML?

It's not going to happen here.

I might write a pair of vcard-rdfxml <-> vcard-xml filters in the
future. If you're chomping at the bit to do this yourself, please,
go nuts.

=head1 TO DO

=over 4

=item *

Better (proper) support for properties that span multiple lines. See also:

 section 5.8.1.  Line delimiting and folding (RFC 2425)
 section 2.6     Line Delimiting and Folding (RFC 2426)

I<This is planned for version 0.06>

=item *