File Coverage

blib/lib/XML/Generator/vCard/RDF.pm
Criterion Covered Total %
statement 347 418 83.0
branch 51 106 48.1
condition 6 15 40.0
subroutine 52 57 91.2
pod 6 7 85.7
total 462 603 76.6


line stmt bran cond sub pod time code
1             # $Id: RDF.pm,v 1.24 2004/12/28 21:50:27 asc Exp $
2 2     2   2120 use strict;
  2         4  
  2         183  
3              
4             package XML::Generator::vCard::RDF;
5 2     2   10 use base qw (XML::Generator::vCard::Base);
  2         4  
  2         2243  
6              
7             $XML::Generator::vCard::RDF::VERSION = '1.4';
8              
9             =head1 NAME
10              
11             XML::Generator::vCard::RDF - generate RDF/XML SAX2 events for vCard 3.0
12              
13             =head1 SYNOPSIS
14              
15             use XML::SAX::Writer;
16             use XML::Generator::vCard::RDF;
17              
18             my $writer = XML::SAX::Writer->new();
19             my $driver = XML::Generator::vCard::RDF->new(Handler=>$writer);
20              
21             $driver->parse_files("test.vcf");
22              
23             =head1 DESCRIPTION
24              
25             Generate RDF/XML SAX2 events for vCard 3.0
26              
27             =head1 DOCUMENT FORMAT
28              
29             SAX2 events map to the I
30             W3C note:
31              
32             http://www.w3.org/TR/2001/NOTE-vcard-rdf-20010222/
33              
34             Additionally, an extra description will be added for each unique
35             email address. Each description will be identified by the value of
36             SHA1 digest of the address and simply point back to the vCard
37             description.
38              
39             For example, the test file for this package contains the email
40             address I which will cause the following
41             description to be added to the final output :
42              
43            
44            
45            
46            
47              
48            
49              
50            
51            
52            
53            
54              
55             This is done to facilitate merging vCard data with RDF representations
56             of email messages, using XML::Generator::RFC822::RDF. For example :
57              
58            
59              
60            
61            
62            
63            
64              
65            
66             Senzala Restaurant
67             senzala@example.com
68            
69              
70            
71              
72             =cut
73              
74 2     2   88180 use Encode;
  2         5  
  2         149  
75 2     2   1710 use MIME::Base64;
  2         475341  
  2         325  
76 2     2   2796 use Text::vCard::Addressbook;
  2         114467  
  2         25  
77 2     2   72 use Memoize;
  2         3  
  2         121  
78 2     2   1845 use Digest::SHA1 qw (sha1_hex);
  2         1732  
  2         8711  
79              
80             sub import {
81 2     2   27 my $pkg = shift;
82 2         23 $pkg->SUPER::import(@_);
83              
84 2         606 &memoize("_prepare_mbox");
85 2         325 return 1;
86             }
87              
88             =head1 PACKAGE METHODS
89              
90             =cut
91              
92             =head2 __PACKAGE__->new(%args)
93              
94             This method inherits from I
95              
96             =cut
97              
98             sub new {
99 1     1 1 1204 my $pkg = shift;
100 1         17 my $self = $pkg->SUPER::new(@_);
101              
102 1 50       100 if (! $self) {
103 0         0 return undef;
104             }
105              
106 1         3 $self->{'__uri'} = "#";
107 1         2 $self->{'__current'} = 0;
108              
109 1         3 $self->{'__files'} = [];
110 1         3 $self->{'__mboxes'} = {};
111              
112 1         4 return bless $self, $pkg;
113             }
114              
115             =head1 OBJECT METHODS
116              
117             =cut
118              
119             =head1 OBJECT METHODS
120              
121             =cut
122              
123             sub base {
124 3     3 0 4 my $self = shift;
125 3         5 my $uri = shift;
126              
127 3 100       8 if ($uri) {
128 1         8 $self->{'__uri'} = $self->prepare_uri($uri);
129             }
130              
131 3   50     158 return ($self->{'__uri'} || "#");
132             }
133              
134             =head2 $pkg->parse_files(@files)
135              
136             Generate SAX2 events for one, or more, vCard files.
137              
138             Returns true or false.
139              
140             =cut
141              
142             =head2 $pkg->parse_files(@files)
143              
144             =cut
145              
146             sub parse_files {
147 1     1 1 441 my $self = shift;
148 1         3 my @files = @_;
149              
150 1         2 my $book = undef;
151              
152 1         2 eval {
153 1         11 $book = Text::vCard::Addressbook->load(\@files);
154             };
155              
156 1 50       7278 if ($@) {
157 0         0 warn $@;
158 0         0 return 0;
159             }
160              
161 1         4 $self->{'__files'} = \@files;
162 1         3 $self->{'__current'} = 0;
163              
164 1         5 return $self->_render_doc([ $book->vcards() ]);
165             }
166              
167             =head1 PRIVATE METHODS
168              
169             Private methods are documented below in case you need to subclass
170             this package to tweak its output.
171              
172             =cut
173              
174             =head2 $obj->_render_doc(\@vcards)
175              
176             =cut
177              
178             sub _render_doc {
179 1     1   13 my $self = shift;
180 1         2 my $cards = shift;
181              
182 1         5 $self->start_document();
183              
184 1         5 $self->start_element({Name => "rdf:RDF"});
185            
186 1         29 foreach my $vcard (@$cards) {
187              
188 1         5 $self->base($self->{'__files'}->[$self->{'__current'} ++]);
189 1         4 $self->_render_card($vcard);
190             }
191              
192             # Now render rdf:Description blocks for all
193             # the email addresses we've collected that
194             # point back to the current document using
195             # rdf:seeAlso
196              
197 1         6 $self->_render_foaf_mboxes();
198            
199 1         6 $self->end_element({Name => "rdf:RDF"});
200            
201 1         13 $self->end_document();
202 1         42 return 1;
203             }
204              
205             =head2 $obj->_render_card(Text::vCard)
206              
207             =cut
208              
209             sub _render_card {
210 1     1   2 my $self = shift;
211 1         1 my $vcard = shift;
212              
213 1         4 $self->start_element({Name => "rdf:Description",
214             Attributes => {"{}about" => {Name => "rdf:about",
215             Value => $self->base()}}});
216            
217             #
218              
219 1   50     13 $self->_pcdata({Name => "vCard:CLASS",
220             Value => ($vcard->class() || "PUBLIC")});
221              
222 1         2 foreach my $prop ("uid", "rev", "prodid") {
223              
224 3 50       54 if (my $value = $vcard->$prop()) {
225 0         0 $self->_pcdata({Name => sprintf("vCard:%s",uc($prop)),
226             Value => $value});
227             }
228             }
229              
230             #
231              
232 1         22 $self->_render_fn($vcard);
233 1         4 $self->_render_n($vcard);
234 1         3 $self->_render_nickname($vcard);
235 1         3 $self->_render_photo($vcard);
236 1         3 $self->_render_bday($vcard);
237 1         3 $self->_render_adrs($vcard);
238 1         3 $self->_render_labels($vcard);
239 1         34 $self->_render_tels($vcard);
240 1         6 $self->_render_emails($vcard);
241 1         4 $self->_render_instantmessaging($vcard);
242 1         5 $self->_render_mailer($vcard);
243 1         4 $self->_render_tz($vcard);
244 1         4 $self->_render_geo($vcard);
245 1         4 $self->_render_org($vcard);
246 1         4 $self->_render_title($vcard);
247 1         3 $self->_render_role($vcard);
248 1         3 $self->_render_logo($vcard);
249             # AGENT
250 1         3 $self->_render_categories($vcard);
251 1         2 $self->_render_note($vcard);
252             # SORT
253 1         7 $self->_render_sound($vcard);
254 1         6 $self->_render_url($vcard);
255 1         5 $self->_render_key($vcard);
256 1         5 $self->_render_custom($vcard);
257              
258 1         5 $self->end_element({Name=>"rdf:Description"});
259              
260 1         15 return 1;
261             }
262              
263             =head2 $obj->_render_fn(Text::vCard)
264              
265             =cut
266              
267             sub _render_fn {
268 1     1   3 my $self = shift;
269 1         1 my $vcard = shift;
270              
271 1         5 $self->_pcdata({Name => "vCard:FN",
272             Value => $vcard->fn()});
273            
274 1         2 return 1;
275             }
276              
277             =head2 $obj->_render_n(Text::vCard)
278              
279             =cut
280              
281             sub _render_n {
282 1     1   1 my $self = shift;
283 1         2 my $vcard = shift;
284              
285 1         3 my $n = $vcard->get({"node_type" => "name"});
286              
287 1 50       17 if (! $n) {
288 0         0 return 1;
289             }
290              
291 1         2 $n = $n->[0];
292              
293             #
294              
295 1 50 33     7 if (($n->family()) || ($n->given())) {
296              
297 0         0 $self->start_element({Name => "vCard:N",
298             Attributes => {"{}parseType"=>{Name => "rdf:parseType",
299             Value => "Resource"}},});
300            
301 0 0       0 if (my $f = $n->family()) {
302 0         0 $self->_pcdata({Name => "vCard:Family",
303             Value => $n->family()});
304             }
305              
306 0 0       0 if (my $g = $n->given()) {
307 0         0 $self->_pcdata({Name => "vCard:Given",
308             Value => $n->given()});
309             }
310            
311 0 0       0 if (my $o = $n->middle()) {
312 0         0 $self->_pcdata({Name => "vCard:Other",
313             Value => $o});
314             }
315            
316 0 0       0 if (my $p = $n->prefixes()) {
317 0         0 $self->_pcdata({Name => "vCard:Prefix",
318             Value => $p});
319             }
320            
321 0 0       0 if (my $s = $n->suffixes()) {
322 0         0 $self->_pcdata({Name => "vCard:Suffix",
323             Value => $s});
324             }
325            
326 0         0 $self->end_element({Name => "vCard:N"});
327             }
328            
329 1         40 return 1;
330             }
331              
332             =head2 $obj->_render_nickname(Text::vCard)
333              
334             =cut
335              
336             sub _render_nickname {
337 1     1   1 my $self = shift;
338 1         2 my $vcard = shift;
339              
340 1 50       4 if (my $nick = $vcard->nickname()) {
341 0         0 $self->_pcdata({Name => "vCard:NICKNAME",
342             Value => $nick});
343             }
344              
345 1         16 return 1;
346             }
347              
348             =head2 $obj->_render_photo(Text::vCard)
349              
350             =cut
351              
352             sub _render_photo {
353 1     1   1 my $self = shift;
354 1         2 my $vcard = shift;
355              
356 1         4 my $photos = $vcard->get({"node_type" => "photo"});
357              
358 1         14 $self->_renderlist_mediaitems("vCard:PHOTO",
359             $photos);
360 1         1 return 1;
361             }
362              
363              
364             =head2 $obj->_render_bday(Text::vCard)
365              
366             =cut
367              
368             sub _render_bday {
369 1     1   2 my $self = shift;
370 1         2 my $vcard = shift;
371              
372 1 50       7 if (my $bday = $vcard->bday()) {
373 0         0 $self->_pcdata({Name => "vCard:BDAY",
374             Value => $bday});
375             }
376              
377 1         16 return 1;
378             }
379              
380             =head2 $obj->_render_adrs(Text::vCard)
381              
382             =cut
383              
384             sub _render_adrs {
385 1     1   2 my $self = shift;
386 1         2 my $vcard = shift;
387              
388 1         3 my $addresses = $vcard->get({"node_type" => "addresses"});
389              
390             #
391              
392             $self->_renderlist("vCard:ADR",
393             $addresses,
394             sub {
395 1     1   2 my $self = shift;
396 1         1 my $adr = shift;
397            
398 1 50       9 if (my $p = $adr->po_box()) {
399 0         0 $self->_pcdata({Name => "vCard:pobox",
400             Value => $p});
401             }
402            
403 1 50       15 if (my $e = $adr->extended()) {
404 0         0 $self->_pcdata({Name => "vCard:extadr",
405             Value => $e});
406             }
407            
408 1 50       16 if (my $s = $adr->street()) {
409 1         11 $self->_pcdata({Name => "vCard:Street",
410             Value => $s});
411             }
412            
413 1 50       8 if (my $c = $adr->city()) {
414 1         18 $self->_pcdata({Name => "vCard:Locality",
415             Value => $c});
416             }
417            
418 1 50       8 if (my $r = $adr->region()) {
419 1         14 $self->_pcdata({Name => "vCard:Region",
420             Value => $r});
421             }
422            
423 1 50       8 if (my $p = $adr->post_code()) {
424 0         0 $self->_pcdata({Name => "vCard:Pcode",
425             Value => $p});
426             }
427            
428 1 50       15 if (my $c = $adr->country()) {
429 1         12 $self->_pcdata({Name => "vCard:Country",
430             Value => $c});
431             }
432 1         25 });
433 1         7 return 1;
434             }
435              
436             =head2 $obj->_render_labels(Text::vCard)
437              
438             =cut
439              
440             sub _render_labels {
441 1     1   2 my $self = shift;
442 1         1 my $vcard = shift;
443              
444 1         5 my $labels = $vcard->get({"node_type" => "labels"});
445              
446             #
447              
448             $self->_renderlist("vCard:LABEL",
449             $labels,
450             sub {
451 0     0   0 my $self = shift;
452 0         0 my $label = shift;
453              
454 0         0 $self->_pcdata({Name => "rdf:value",
455             Value => $label->value(),
456             Attributes => {$self->_parsetype("Literal")},
457             CDATA => 1,});
458 1         17 });
459 1         5 return 1;
460             }
461              
462             =head2 $obj->_render_tels(Text::vCard)
463              
464             =cut
465              
466             sub _render_tels {
467 1     1   2 my $self = shift;
468 1         2 my $vcard = shift;
469              
470 1         10 my $tels = $vcard->get({'node_type' => 'tel'});
471              
472             $self->_renderlist("vCard:TEL",
473             $tels,
474             sub {
475 1     1   2 my $self = shift;
476 1         4 my $tel = shift;
477              
478 1         8 $self->_pcdata({Name => "rdf:value",
479             Value => $tel->value()});
480 1         21 });
481 1         4 return 1;
482             }
483              
484             =head2 $obj->_render_emails(Text::vCard)
485              
486             =cut
487              
488             sub _render_emails {
489 1     1   1 my $self = shift;
490 1         2 my $vcard = shift;
491              
492 1         6 my $addresses = $vcard->get({"node_type" => "email"});
493              
494             $self->_renderlist("vCard:EMAIL",
495             $addresses,
496             sub {
497 1     1   2 my $self = shift;
498 1         2 my $email = shift;
499              
500 1         7 $self->_pcdata({Name => "rdf:value",
501             Value => $email->value()});
502 1         20 });
503              
504             # Keep track of email addresses for
505             # dumping by '_render_foaf_mboxes'
506              
507 1         5 my $base = $self->base();
508              
509 1         2 foreach my $email (@$addresses) {
510 1         6 my $mbox = &_prepare_mbox($email->value());
511            
512 1   50     40 $self->{'__mboxes'}->{$mbox} ||= [];
513 1         1 push @{$self->{'__mboxes'}->{$mbox}}, $base;
  1         5  
514             }
515              
516 1         2 return 1;
517             }
518              
519             =head2 $obj->_render_instantmessaging(Text::vCard)
520              
521             =cut
522              
523             sub _render_instantmessaging {
524 1     1   1 my $self = shift;
525 1         2 my $vcard = shift;
526              
527 1         14 my $im_list = $self->_im_services();
528              
529 1         147 foreach my $service (sort {$a cmp $b} keys %$im_list) {
  6         13  
530              
531 5         28 my $addresses = $vcard->get({"node_type" => "x-$service"});
532            
533 5         89 $self->_render_im_service($im_list->{$service},
534             $addresses);
535             }
536            
537 1         4 return 1;
538             }
539              
540             sub _render_im_service {
541 5     5   8 my $self = shift;
542 5         7 my $service = shift;
543 5         6 my $accounts = shift;
544              
545 5 50       14 if (! $accounts) {
546 5         167 return 1;
547             }
548              
549             $self->_renderlist($service,
550             $accounts,
551             sub {
552 0     0   0 my $self = shift;
553 0         0 my $im = shift;
554              
555 0         0 $self->_pcdata({Name => "rdf:value",
556             Value => $im->value()});
557 0         0 });
558              
559 0         0 return 1;
560             }
561              
562             =head2 $obj->_render_mailer(Text::vCard)
563              
564             =cut
565              
566             sub _render_mailer {
567 1     1   2 my $self = shift;
568 1         1 my $vcard = shift;
569              
570 1 50       5 if (my $m = $vcard->mailer()) {
571 0         0 $self->_pcdata({Name => "vCard:MAILER",
572             Value => $m});
573             }
574              
575 1         18 return 1;
576             }
577              
578             =head2 $obj->_render_tz(Text::vCard)
579              
580             =cut
581              
582             sub _render_tz {
583 1     1   1 my $self = shift;
584 1         2 my $vcard = shift;
585              
586 1 50       5 if (my $tz = $vcard->tz()) {
587 0         0 $self->_pcdata({Name => "vCard:TZ",
588             Value => $tz});
589             }
590              
591 1         24 return 1;
592             }
593              
594             =head2 $obj->_render_geo(Text::vCard)
595              
596             =cut
597              
598             sub _render_geo {
599 1     1   2 my $self = shift;
600 1         1 my $vcard = shift;
601              
602 1         5 my $geo = $vcard->get({'node_type' => "geo"});
603              
604 1 50       24 if (! $geo) {
605 0         0 return 1;
606             }
607              
608 1         2 $geo = $geo->[0];
609              
610             #
611              
612 1         7 $self->start_element({Name => "vCard:GEO",
613             Attributes => {"{}parseType"=>{Name => "rdf:parseType",
614             Value => "Resource"}},});
615            
616 1         16 $self->_pcdata({Name => "geo:lat",
617             Value => $geo->lat()});
618              
619 1         9 $self->_pcdata({Name => "geo:lon",
620             Value => $geo->long()});
621            
622 1         5 $self->end_element({Name=>"vCard:GEO"});
623              
624 1         6 return 1;
625             }
626              
627             =head2 $obj->_render_org(Text::vCard)
628              
629             =cut
630              
631             sub _render_org {
632 1     1   2 my $self = shift;
633 1         2 my $vcard = shift;
634              
635 1         4 my $orgs = $vcard->get({'node_type' => "org"});
636              
637 1 50       16 if (! $orgs) {
638 0         0 return 1;
639             }
640              
641 1         2 my $org = $orgs->[0];
642              
643 1 0 33     15 if ((! $org->name()) && ((! $org->unit()))) {
644 0         0 return 1;
645             }
646              
647 1         13 my %parsetype = $self->_parsetype("Resource");
648              
649 1         4 $self->start_element({Name => "vCard:ORG",
650             Attributes => \%parsetype});
651            
652 1 50       11 if (my $n = $org->name()) {
653 1         14 $self->_pcdata({Name => "vCard:Orgnam",
654             Value => $n});
655             }
656              
657 1 50       7 if (my $u = $org->unit()) {
658              
659 1         13 my @units = grep { /\w/ } @$u;
  2         9  
660 1         2 my $count = scalar(@units);
661              
662 1 50       6 if ($count == 1) {
    50          
663 0         0 $self->_pcdata({Name => "vCard:Orgunit",
664             Value => $units[0]});
665             }
666              
667             elsif ($count) {
668 1         5 $self->start_element({Name => "vCard:Orgunit"});
669 1         10 $self->start_element({Name => "rdf:Seq"});
670              
671 2         7 map {
672 1         8 $self->_pcdata({Name => "rdf:li",
673             Value => $_});
674             } @units;
675              
676 1         4 $self->end_element({Name => "rdf:Seq"});
677 1         10 $self->end_element({Name => "vCard:Orgunit"});
678             }
679              
680             else {}
681             }
682              
683 1         17 $self->end_element({Name=>"vCard:ORG"});
684 1         7 return 1;
685             }
686              
687             =head2 $obj->_render_title(Text::vCard)
688              
689             =cut
690              
691             sub _render_title {
692 1     1   1 my $self = shift;
693 1         3 my $vcard = shift;
694              
695 1 50       3 if (my $t = $vcard->title()) {
696 0         0 $self->_pcdata({Name => "vCard:TITLE",
697             Value => $t});
698             }
699              
700 1         17 return 1;
701             }
702              
703             =head2 $obj->_render_role(Text::vCard)
704              
705             =cut
706              
707             sub _render_role {
708 1     1   2 my $self = shift;
709 1         2 my $vcard = shift;
710              
711 1 50       4 if (my $r = $vcard->role()) {
712 0         0 $self->_pcdata({Name => "vCard:ROLE",
713             Value => $r});
714             }
715              
716 1         24 return 1;
717             }
718              
719             =head2 $obj->_render_logo(Text::vCard)
720              
721             =cut
722              
723             sub _render_logo {
724 1     1   2 my $self = shift;
725 1         3 my $vcard = shift;
726              
727 1         5 my $logos = $vcard->get({"node_type" => "logo"});
728              
729 1         16 $self->_renderlist_mediaitems("vcard:LOGO",
730             $logos);
731              
732 1         1 return 1;
733             }
734              
735             =head2 $obj->_render_categories(Text::vCard)
736              
737             =cut
738              
739             sub _render_categories {
740 1     1   3 my $self = shift;
741 1         1 my $vcard = shift;
742              
743 1   33     5 my $cats = $vcard->get({'node_type' => 'categories'}) ||
744             $vcard->get({'node_type' => 'category'});
745              
746 1 50       44 if (! $cats) {
747 0         0 return 1;
748             }
749              
750             # we don't call '_renderlist' since it
751             # generates rdf:Bags and we need a 'Seq'
752             # here
753              
754 1         4 $self->start_element({Name => "vCard:CATEGORIES"});
755 1         11 $self->start_element({Name => "rdf:Seq"});
756              
757 1         8 foreach my $c (@$cats) {
758 1         7 $self->_pcdata({Name => "rdf:li",
759             Value => $c->value()});
760             }
761            
762 1         5 $self->end_element({Name => "rdf:Seq"});
763 1         8 $self->end_element({Name => "vCard:CATEGORIES"});
764              
765 1         7 return 1;
766             }
767              
768             =head2 $obj->_render_note(Text::vCard)
769              
770             =cut
771              
772             sub _render_note {
773 1     1   2 my $self = shift;
774 1         3 my $vcard = shift;
775              
776 1         4 my $notes = $vcard->get({"node_type" => "note"});
777            
778 1 50       15 if (! $notes) {
779 0         0 return 1;
780             }
781            
782 1         3 $self->_pcdata({Name => "vCard:NOTE",
783             Attributes => {$self->_parsetype("Literal")},
784             CDATA => 1,
785             Value => $notes->[0]->value()});
786 1         11 return 1;
787             }
788              
789             =head2 $self->_render_sound(Text::vCard)
790              
791             =cut
792              
793             sub _render_sound {
794 1     1   3 my $self = shift;
795 1         3 my $vcard = shift;
796              
797 1         14 my $snds = $vcard->get({'node_type' => 'sound'});
798              
799 1         31 $self->_renderlist_mediaitems("vCard:SOUND",
800             $snds);
801 1         3 return 1;
802             }
803              
804             =head2 $self->_render_url(Text::vCard)
805              
806             =cut
807              
808             sub _render_url {
809 1     1   3 my $self = shift;
810 1         2 my $vcard = shift;
811              
812 1 50       7 if (my $url = $vcard->url()) {
813 0         0 $self->_pcdata({Name => "vCard:URL",
814             Attributes => {"{}resource" => {Name => "rdf:resource",
815             Value => $url}}});
816             }
817            
818 1         38 return 1;
819             }
820              
821             =head2 $obj->_render_key(Text::vCard)
822              
823             =cut
824              
825             sub _render_key {
826 1     1   3 my $self = shift;
827 1         2 my $vcard = shift;
828              
829 1         7 my $keys = $vcard->get({'node_type' => 'key'});
830              
831 1         21 $self->_renderlist_mediaitems("vCard:KEY",
832             $keys);
833 1         2 return 1;
834             }
835              
836             =head2 $obj->_render_custom(Text::vCard)
837              
838             By default this method does nothing. It is here to
839             be subclassed.
840              
841             =cut
842              
843 1     1   10 sub _render_custom { }
844              
845             =head2 $obj->_im_services()
846              
847             Returns a hash ref mapping an instant messaging service
848             type to an XML element. Default is :
849              
850             {"aim" => "foaf:aimChatID",
851             "yahoo" => "foaf:yahooChatID",
852             "msn" => "foaf:msnChatID",
853             "jabber" => "foaf:JabberID",
854             "icq" => "foaf:icqChatId"}
855              
856             This is called by the I<_render_instantmessaging> method.
857              
858             =cut
859              
860             sub _im_services {
861 1     1   6 return {"aim" => "foaf:aimChatID",
862             "yahoo" => "foaf:yahooChatID",
863             "msn" => "foaf:msnChatID",
864             "jabber" => "foaf:JabberID",
865             "icq" => "foaf:icqChatID"};
866             }
867              
868             sub _pcdata {
869 16     16   154 my $self = shift;
870 16         16 my $data = shift;
871              
872 16         28 $self->start_element($data);
873              
874 16 100       161 if ($data->{CDATA}) {
875 1         639 $self->start_cdata();
876             }
877              
878 16 100       94 if ($data->{Value}) {
879 15         46 $self->characters({Data => encode_utf8($data->{Value})});
880             }
881              
882 16 100       225 if ($data->{CDATA}) {
883 1         13 $self->end_cdata();
884             }
885              
886 16         85 $self->end_element($data);
887 16         128 return 1;
888             }
889              
890             sub _media {
891 0     0   0 my $self = shift;
892 0         0 my $obj = shift;
893              
894              
895 0         0 return 1;
896             }
897              
898             sub _types {
899 3     3   65 my $self = shift;
900            
901 3         7 my $ns = $self->namespaces();
902              
903 3 50       9 foreach my $type (grep { defined($_) && $_ =~ m/\w/ } @_) {
  7         43  
904            
905 7         65 $self->start_element({Name => "rdf:type",
906             Attributes => {"{}resource" => {Name => "rdf:resource",
907             Value => $ns->{vCard}.$type}}
908             });
909 7         78 $self->end_element({Name => "rdf:type"});
910             }
911              
912 3         28 return 1;
913             }
914              
915             sub _parsetype {
916 6     6   8 my $self = shift;
917 6         6 my $resource = shift;
918              
919 6         27 return ("{}parseType" => {Name => "rdf:parseType",
920             Value => $resource});
921             }
922              
923             sub start_document {
924 1     1 1 3 my $self = shift;
925              
926 1         17 $self->SUPER::start_document();
927              
928 1         66 $self->xml_decl({Version => "1.0",
929             Encoding => "UTF-8"});
930              
931 1         47 my $ns = $self->namespaces();
932              
933 1         8 foreach my $prefix (keys %$ns) {
934 5         79 $self->start_prefix_mapping({Prefix => $prefix,
935             NamespaceURI => $ns->{$prefix}});
936             }
937            
938 1         8 return 1;
939             }
940              
941             sub end_document {
942 1     1 1 2 my $self = shift;
943              
944 1         2 foreach my $prefix (keys %{$self->namespaces()}) {
  1         6  
945 5         139 $self->end_prefix_mapping({Prefix => $prefix});
946             }
947              
948 1         37 $self->SUPER::end_document();
949 1         44 return 1;
950             }
951              
952             sub start_element {
953 36     36 1 43 my $self = shift;
954 36         38 my $data = shift;
955              
956 36         100 my $name = $self->prepare_qname($data->{Name});
957 36         2035 my $attrs = $self->prepare_attrs($data->{Attributes});
958              
959 36         1622 $self->SUPER::start_element({ %$name, %$attrs });
960             }
961              
962             sub end_element {
963 36     36 1 46 my $self = shift;
964 36         47 my $data = shift;
965              
966 36         98 my $name = $self->prepare_qname($data->{Name});
967              
968 36         2299 $self->SUPER::end_element($name);
969             }
970              
971             sub _renderlist {
972 4     4   6 my $self = shift;
973 4         7 my $el = shift;
974 4         11 my $list = shift;
975 4         5 my $sub = shift;
976              
977 4 100       9 if (! $list) {
978 1         10 return 1;
979             }
980              
981 3 50       12 my $bag = (scalar(@$list) > 1) ? 1 : 0;
982              
983             #
984              
985 3         8 my %parsetype = $self->_parsetype("Resource");
986 3 50       10 my %attrs = ($bag) ? (): %parsetype;
987              
988 3         10 $self->start_element({Name => $el,
989             Attributes => \%attrs});
990            
991 3 50       30 if ($bag) {
992 0         0 $self->start_element({Name => "rdf:Bag"});
993             }
994              
995 3         7 foreach my $obj (@$list) {
996              
997 3 50       7 if ($bag) {
998 0         0 $self->start_element({Name => "rdf:li",
999             Attributes => {%parsetype}});
1000             }
1001              
1002 3         10 $self->_types($obj->types());
1003              
1004 3         8 &$sub($self,$obj);
1005              
1006 3 50       13 if ($bag) {
1007 0         0 $self->end_element({Name=>"rdf:li"});
1008             }
1009             }
1010              
1011 3 50       7 if ($bag) {
1012 0         0 $self->end_element({Name => "rdf:Bag"});
1013             }
1014              
1015 3         9 $self->end_element({Name => $el});
1016 3         23 return 1;
1017             }
1018              
1019             sub _renderlist_mediaitems {
1020 4     4   9 my $self = shift;
1021 4         6 my $el = shift;
1022 4         6 my $list = shift;
1023              
1024 4 100       11 if (! $list) {
1025 3         8 return 1;
1026             }
1027              
1028 1 50       5 my $bag = (scalar(@$list) > 1) ? 1 : 0;
1029              
1030             #
1031              
1032 1         3 my %parsetype = $self->_parsetype("Resource");
1033 1 50       4 my %attrs = ($bag) ? (): %parsetype;
1034              
1035             # aside from the normal hoop jumping
1036             # involved in bags/single items we
1037             # also need to contend with whether an
1038             # item has data or is simply a reference
1039             # to another resource
1040              
1041 1 50       4 if (! $bag) {
1042              
1043 1         2 my $obj = $list->[0];
1044              
1045 1 50       3 if (! $obj->is_type("base64")) {
1046 1         13 $self->_mediaref($el,$obj);
1047             }
1048              
1049             else {
1050 0         0 $self->start_element({Name => $el,
1051             Attributes => {$self->_parsetype("Resource")}});
1052 0         0 $self->_mediaobj($obj);
1053 0         0 $self->end_element({Name => $el});
1054             }
1055              
1056 1         5 return 1;
1057             }
1058              
1059             # bag
1060              
1061 0         0 $self->start_element({Name => $el,
1062             Attributes => \%attrs});
1063            
1064 0         0 $self->start_element({Name => "rdf:Bag"});
1065            
1066 0         0 foreach my $obj (@$list) {
1067            
1068 0 0       0 if (! $obj->is_type("base64")) {
1069 0         0 %attrs = ("{}resource" => {Name => "rdf:resource",
1070             Value => $obj->value()});
1071             }
1072            
1073             else {
1074 0         0 %attrs = %parsetype;
1075             }
1076              
1077             #
1078            
1079 0         0 $self->start_element({Name => "rdf:li",
1080             Attributes => \%attrs});
1081            
1082 0 0       0 if ($obj->is_type("base64")) {
1083 0         0 $self->_mediaobj($obj);
1084             }
1085            
1086 0         0 $self->end_element({Name => "rdf:li"});
1087             }
1088              
1089             #
1090              
1091 0         0 $self->end_element({Name => "rdf:Bag"});
1092 0         0 $self->end_element({Name => $el});
1093              
1094 0         0 return 1;
1095             }
1096              
1097             sub _mediaref {
1098 1     1   1 my $self = shift;
1099 1         2 my $el = shift;
1100 1         2 my $obj = shift;
1101              
1102 1         5 $self->_pcdata({Name => $el,
1103             Attributes => {"{}resource" => {Name => "rdf:resource",
1104             Value => $obj->value()}}});
1105             }
1106              
1107             sub _mediaobj {
1108 0     0   0 my $self = shift;
1109 0         0 my $obj = shift;
1110              
1111 0         0 $self->_types($obj->types());
1112              
1113 0         0 $self->_pcdata({Name => "vCard:ENCODING",
1114             Value => "b"});
1115              
1116 0         0 $self->_pcdata({Name => "rdf:value",
1117             Attributes => {$self->_parsetype("Literal")},
1118             Value => encode_base64($obj->value()),
1119             CDATA => 1});
1120              
1121 0         0 return 1;
1122             }
1123              
1124             # memoized
1125              
1126             sub _prepare_mbox {
1127             my $email_addr = shift;
1128             return encode_utf8(sprintf("%smbox_sha1sum#%s",
1129             __PACKAGE__->namespaces()->{foaf},
1130             sha1_hex($email_addr)));
1131             }
1132              
1133             sub _render_foaf_mboxes {
1134 1     1   4 my $self = shift;
1135              
1136 1         2 foreach my $mbox (keys %{$self->{'__mboxes'}}) {
  1         7  
1137              
1138 1         12 $self->start_element({Name => "rdf:Description",
1139             Attributes => {"{}rdf:about" => {Name => "rdf:about",
1140             Value => $mbox}}});
1141 1         16 foreach my $uri (@{$self->{'__mboxes'}->{$mbox}}) {
  1         5  
1142              
1143 1         9 $self->start_element({Name => "rdfs:seeAlso",
1144             Attributes => {"{}rdf:resource" => {Name => "rdf:resource",
1145             Value => $uri}}});
1146 1         16 $self->end_element({Name => "rdfs:seeAlso"});
1147             }
1148              
1149 1         14 $self->end_element({Name => "rdf:Description"});
1150             }
1151              
1152 1         13 return 1;
1153             }
1154              
1155 0     0     sub DESTROY {}
1156              
1157             =head1 NAMESPACES
1158              
1159             This package generates SAX events using the following XML
1160             namespaces :
1161              
1162             =over 4
1163              
1164             =item * B
1165              
1166             http://www.w3.org/2001/vcard-rdf/3.0#
1167              
1168             =item * B
1169              
1170             http://www.w3.org/1999/02/22-rdf-syntax-ns#
1171              
1172             =item * B
1173              
1174             http://xmlns.com/foaf/0.1/
1175              
1176             =item * B
1177              
1178             http://www.w3.org/2003/01/geo/wgs84_pos#
1179              
1180             =back
1181              
1182             =cut
1183              
1184             =head1 VERSION
1185              
1186             1.4
1187              
1188             =head1 DATE
1189              
1190             $Date: 2004/12/28 21:50:27 $
1191              
1192             =head1 AUTHOR
1193              
1194             Aaron Straup Cope Eascope@cpan.orgE
1195              
1196             =head1 SEE ALSO
1197              
1198             L
1199              
1200             L
1201              
1202             L
1203              
1204             =head1 BUGS
1205              
1206             vCards containg binary PHOTO images may cause Perl to segfault on
1207             Mac OSX and come flavours of Linux (but not FreeBSD.) The source of
1208             this problem has been traced, I think, to a regular expression issue
1209             in the Perl Text::ParseWords library. A bug report has been filed.
1210              
1211             Please report all other bugs via http://rt.cpan.org
1212              
1213             =head1 LICENSE
1214              
1215             Copyright (c) 2004, Aaron Straup Cope. All Rights Reserved.
1216              
1217             This is free software, you may use it and distribute it
1218             under the same terms as Perl itself.
1219              
1220             =cut
1221              
1222             return 1;