File Coverage

blib/lib/XML/FOAFKnows/FromvCard.pm

Criterion	Covered	Total	%
statement	22	24	91.6
branch			n/a
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	30	32	93.7

package XML::FOAFKnows::FromvCard;

use 5.007;
use strict;
use warnings;
use Carp;

use Text::vCard::Addressbook;
use Text::vCard;
use Digest::SHA1 qw(sha1_hex);
use IDNA::Punycode;

use base qw( Text::vCard );

our $VERSION = '0.6';

sub format {
  my $that  = shift;
  my $class = ref($that) || $that;
  my ($text,%config) = @_;
  my $address_book = Text::vCard::Addressbook->new({
      'source_text' => $text,
  });

  my $privstatattrib = $config{attribute} || 'CLASS';
  # Parse and build the fragment
  my $records = '';
  my @urls = ();
  my $counts = 0;
  foreach my $vcard ($address_book->vcards()) {
    my $privacystat = 'PRIVATE'; # The default privacy option if nothing else is set
    if (defined($config{privacy})) {
      $privacystat = uc($config{privacy});
    } elsif (($vcard->get($privstatattrib))[0]) {
      $privacystat = ($vcard->get($privstatattrib))[0]->value; # Check the status and generate full records only for public records
    }
    next if ($privacystat eq 'CONFIDENTIAL');
    my @email = ($vcard->get('EMAIL'));
    my $url = ($vcard->get('URL'))[0];
    next unless ($url || $email[0]); # We need at least an URL or an email to continue
    $counts++;
    $records .= "\n\t
    # TODO: nodeIDs, but how to generate...?
    if (($vcard->get('NICKNAME'))[0]) { # a nodeID on the Person record can be useful
      my $punynick = encode_punycode(($vcard->get('NICKNAME'))[0]->value); # puny-encode any nicks,
      $punynick =~ s/\s/_/gs; # and replace any whitespace with underscores
      $records .= ' rdf:nodeID="' . $punynick . '">'.
	"\n\t\t" . ($vcard->get('NICKNAME'))[0]->value . '';
    } else {
      $records .= ' rdf:nodeID="person'.$counts.'">';
    }

    foreach (@email) {
      next unless (defined($_));
      $records .= "\n\t\t" . sha1_hex('mailto:' . $_->value) . '';
    }
    if ($url) {
      my $tmp = $url->value;
      $tmp =~ s/\\:/:/g; # Some files seem to have colons in URLs escaped
      $records .= "\n\t\t".'';
    }
    my $fullname = '';
    if ($privacystat eq 'PUBLIC') {
      my $name = ($vcard->get('N'))[0];
      if ($name) {
	$records .= "\n\t\t".$name->family.'';
	$fullname = $name->family;
	if ($name->given()) {
	  $records .= "\n\t\t".$name->given.''.
	    "\n\t\t".$name->given.' '.$name->family.'';
	  $fullname = $name->given.' '.$name->family;
	}
      }
      elsif (($vcard->get('FN'))[0]->fullname()) {
	$records .= "\n\t\t".($vcard->get('FN'))[0]->fullname.'';
	$fullname = ($vcard->get('FN'))[0]->fullname;
      }
    }
    # Now we build the URL to be returned by the links method
    if ($vcard->get('URL')) {
      foreach my $url2 ($vcard->get('URL')) {
	my $tmp = $url2->value;
	$tmp =~ s/\\:/:/g;
	push(@urls, {url => $tmp, title => $fullname});
      }
    }
    $records .= "\n\t\n\n";
  }

  my $self = {
	      _out => $records,
	      _urls => \@urls,
	      _config => \%config,
	     };
  bless($self, $class);
  return $self;
}


sub title { return undef }

sub links { return shift->{_urls}; }

sub fragment { return shift->{_out}; }

sub document {
  my ($self,$encoding) = @_;

  my $out = '
  if ($encoding) {
    $out .= ' encoding="'.$encoding.'"';
  }
  $out .= '?>';
  $out .= "\n
   'xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" '.
   'xmlns:rdfs="http://www.w3.org/2000/01/rdf-schema#" '.
   'xmlns:foaf="http://xmlns.com/foaf/0.1/">'.
   "\n

  if ($self->{_config}->{uri}) {
    $out .= ' rdf:about="'.$self->{_config}->{uri}.'">';
  } else {
    $out .= ">\n\n";
  }
  if ($self->{_config}->{email}) {
    $out .= "\n\t" . sha1_hex('mailto:' . $self->{_config}->{email}) . '';
  }
  if ($self->{_config}->{seeAlso}) {
    $out .= "\n\t".''."\n\n";
  }
  return $out . $self->{_out} . "\n\n\n";
}




1;
__END__