xapian-applications/omega/vcard2text.in

   1 #!@PERL@
   2 # @configure_input@
   3 # @file
   4 # @brief Extract text from a vCard file
   5 #
   6 # Copyright (C) 2016,2017 Olly Betts
   7 #
   8 # Permission is hereby granted, free of charge, to any person obtaining a copy
   9 # of this software and associated documentation files (the "Software"), to
  10 # deal in the Software without restriction, including without limitation the
  11 # rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
  12 # sell copies of the Software, and to permit persons to whom the Software is
  13 # furnished to do so, subject to the following conditions:
  14 #
  15 # The above copyright notice and this permission notice shall be included in
  16 # all copies or substantial portions of the Software.
  17 #
  18 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  19 # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  20 # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  21 # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  22 # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  23 # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
  24 # IN THE SOFTWARE.
  25
  26 use strict;
  27 eval {
  28     require Text::vCard::Addressbook;
  29     require Text::vCard;
  30 };
  31 if ($@) {
  32     print STDERR $@;
  33     # Exit with code 127 which omindex interprets as "filter not installed"
  34     # and won't try further .msg files.
  35     exit 127;
  36 }
  37
  38 if (@ARGV > 0) {
  39     foreach my $file (@ARGV) {
  40         dump_vcf($file);
  41     }
  42 } else {
  43     dump_vcf('/dev/stdin');
  44 }
  45
  46 sub dump_vcf {
  47     my $file = $_[0];
  48     my $address_book = Text::vCard::Addressbook->new({
  49             'source_file' => $file
  50         });
  51     foreach my $vcard ($address_book->vcards()) {
  52         dump_vcard($vcard);
  53     }
  54 }
  55
  56 my $sep;
  57
  58 sub dump_vcard {
  59     my $vcard = shift;
  60     print $sep if defined $sep;
  61     $sep = '\f';
  62     # Simple fields
  63     foreach my $field (qw(
  64         FN BDAY MAILER TZ TITLE ROLE NOTE PRODID REV SORT-STRING UID URL CLASS
  65         EMAIL TEL NICKNAME)) {
  66         # Ignore PHOTO for now.
  67         # LABEL is in the sample in the EDRM set, but isn't handled properly
  68         # by the perl module.
  69         foreach my $node ($vcard->get($field)) {
  70             defined $node or next;
  71             print $field;
  72             my @types = grep {defined $_} $node->types();
  73             if (@types > 0) {
  74                 print "(", join(", ", @types), ")";
  75             }
  76             print ": ", $node->value(), "\n";
  77         }
  78     }
  79     # Non-simple fields
  80     foreach my $field (qw(ADR N GEO ORG)) {
  81         foreach my $node ($vcard->get($field)) {
  82             defined $node or next;
  83             foreach my $method (@{ $Text::vCard::lookup{$field} }) {
  84                 my $res = $node->$method();
  85                 next unless defined $res;
  86                 if (ref($res) eq 'ARRAY') {
  87                     my @a = grep {$_ ne ''} @$res;
  88                     print "$field.$method: ", join("; ", @a) unless @a == 0;
  89                 } else {
  90                     print "$field.$method: ", $res, "\n" unless $res eq '';
  91                 }
  92             }
  93         }
  94     }
  95 }