$title

#!/usr/bin/perl ######### # vcard.cgi # # Created 11/29/97 by Michael Heydasch # Modified 8/26/99 by Mrh to include Netscape compatibility ######### # Get the Date for Entry $date = `date +"%A, %B %d, %Y at %T (%Z)"`; chop($date); $shortdate = `date +"%D %T %Z"`; chop($shortdate); $fdatem = `date +"%Y%m%dT%T"`; chop($fdatem); $fdatem =~ s/\://g ; # $tdatem = `date +"%t %h%m%s"`; # chop($tdatem); # $totaldate = $fdatem . 'T' . $tdatem; ######### # Get the CGI input variables %in= &getcgivars ; ######### # Print an HTML response to the user print <
EOF

#########
# Print each CGI variable received by the script, one per line.

foreach (keys %in) {

    # If a field has newlines, it's probably a block of text; indent it.
    if ($in{$_}=~ /\n/) {
#        $in{$_}= "\n" . $in{$_} ;
        $in{$_}=~ s/\r/=0D=0A=\r/g ;

        if($in{'netsc'} eq 'No') { $in{$_}=~ s/\n/\n    /g ; }
        else { $in{$_}=~ s/\n/\n/g ; }
        
#        $in{$_}.= "\n" ;
    }

    # comma-separate multiple selections
    $in{$_}=~ s/\0/, /g ;
}

# Print fields according to vCard specs v2.1
# print "$_ : $in{$_}\n";

print "BEGIN:VCARD\n";
if ($in{'MName'}) { $in{'MName'}.= ' '; }

if($in{'netsc'} eq 'No') { print "   FN:$in{'Prefix'} $in{'FName'} $in{'MName'}$in{'LName'}"; }
else { print "FN:$in{'Prefix'} $in{'FName'} $in{'MName'}$in{'LName'}"; }

if ($in{'Suffix'}) { print ", $in{'Suffix'}"; }
print "\n";

if($in{'netsc'} eq 'No') { print "   TITLE:$in{'Title'}\n"; }
else { print "TITLE:$in{'Title'}\n"; }

if($in{'netsc'} eq 'No') { print "   ORG:$in{'Org'}"; }
else { print "ORG:$in{'Org'}"; }

if ($in{'Div'}) { print ";$in{'Div'}"; }
if ($in{'Dept'}) { print ";$in{'Dept'}"; }
print "\n";
if ($in{'Addr1Line1'}) {

   if($in{'netsc'} eq 'No') { print "   ADR"; }
   else { print "ADR"; }
   
   if ($in{'Addr1Type1'} eq 'DOM') { print ";DOM"; }
   print ";$in{'Addr1Type2'};$in{'Addr1Type3'}:";

   if ($in{'Addr1Line3'}) {
        print "$in{'Addr1Line1'};$in{'Addr1Line2'};$in{'Addr1Line3'};";
        print "$in{'Addr1City'};$in{'Addr1State'};$in{'Addr1Zip'};";
        if($in{'Addr1Type1'} ne 'DOM') { print "$in{'Addr1Country'}"; }
        print "\n";
   } elsif ($in{'Addr1Line2'}) {
        print ";$in{'Addr1Line1'};$in{'Addr1Line2'}";
        print ";$in{'Addr1City'};$in{'Addr1State'};$in{'Addr1Zip'};";
        if($in{'Addr1Type1'} ne 'DOM') { print "$in{'Addr1Country'}"; }
        print "\n";
   } else {
        print ";;$in{'Addr1Line1'}";
        print ";$in{'Addr1City'};$in{'Addr1State'};$in{'Addr1Zip'};";
        if($in{'Addr1Type1'} ne 'DOM') { print "$in{'Addr1Country'}"; }
        print "\n";
   }
}
if ($in{'Addr1Label'}) {

   if($in{'netsc'} eq 'No') { print "   LABEL"; }
   else { print "LABEL"; }
   
   if ($in{'Addr1LblType1'} eq 'DOM') {
      print ";DOM";
      $in{'Addr1Label'} =~ s/=0D=0A=(\r*\n* *)U.S.A.(\r*\n* *)//ge ;
      $in{'Addr1Label'} =~ s/=0D=0A=(\r*\n* *)USA(\r*\n* *)//ge ;
      $in{'Addr1Label'} =~ s/=0D=0A=(\r*\n* *)U.S.(\r*\n* *)//ge ;
      $in{'Addr1Label'} =~ s/=0D=0A=(\r*\n* *)US(\r*\n* *)//ge ;
   } else {
      while (($in{'Addr1Label'}[length($in{'Addr1Label'})-1] eq '\r' ) ||
             ($in{'Addr1Label'}[length($in{'Addr1Label'})-1] eq '\n' ) ||
             ($in{'Addr1Label'}[length($in{'Addr1Label'})-1] eq ' ' )) {
         $in{'Addr1Label'}[length($in{'Addr1Label'})-1] = ' ';
      }
   }
   print ";$in{'Addr1LblType2'};$in{'Addr1LblType3'};ENCODING=QUOTED-PRINTABLE:";
   print "$in{'Addr1Label'}\n";
}
if ($in{'Addr2Line1'}) {

   if($in{'netsc'} eq 'No') { print "   ADR"; }
   else { print "ADR"; }
   
   if ($in{'Addr2Type1'} eq 'DOM') { print ";DOM"; }
   print ";$in{'Addr2Type2'};$in{'Addr2Type3'}:";

   if ($in{'Addr2Line3'}) {
        print "$in{'Addr2Line1'};$in{'Addr2Line2'};$in{'Addr2Line3'};";
        print "$in{'Addr2City'};$in{'Addr2State'};$in{'Addr2Zip'};";
        if($in{'Addr2Type1'} ne 'DOM') { print "$in{'Addr2Country'}"; }
        print "\n";
   } elsif ($in{'Addr2Line2'}) {
        print ";$in{'Addr2Line1'};$in{'Addr2Line2'}";
        print ";$in{'Addr2City'};$in{'Addr2State'};$in{'Addr2Zip'};";
        if($in{'Addr2Type1'} ne 'DOM') { print "$in{'Addr2Country'}"; }
        print "\n";
   } else {
        print ";;$in{'Addr2Line1'}";
        print ";$in{'Addr2City'};$in{'Addr2State'};$in{'Addr2Zip'};";
        if($in{'Addr2Type1'} ne 'DOM') { print "$in{'Addr2Country'}"; }
        print "\n";
   }
}
if ($in{'Addr2Label'}) {

   if($in{'netsc'} eq 'No') { print "   LABEL"; }
   else { print "LABEL"; }
   
   if ($in{'Addr2LblType1'} eq 'DOM') {
      print ";DOM";
      $in{'Addr2Label'} =~ s/=0D=0A=(\r*\n* *)U.S.A.(\r*\n* *)//ge ;
      $in{'Addr2Label'} =~ s/=0D=0A=(\r*\n* *)USA(\r*\n* *)//ge ;
      $in{'Addr2Label'} =~ s/=0D=0A=(\r*\n* *)U.S.(\r*\n* *)//ge ;
      $in{'Addr2Label'} =~ s/=0D=0A=(\r*\n* *)US(\r*\n* *)//ge ;
   } else {
      while (($in{'Addr2Label'}[length($in{'Addr2Label'})-1] eq '\r' ) ||
             ($in{'Addr2Label'}[length($in{'Addr2Label'})-1] eq '\n' ) ||
             ($in{'Addr2Label'}[length($in{'Addr2Label'})-1] eq ' ' )) {
         $in{'Addr2Label'}[length($in{'Addr2Label'})-1] = ' ';
      }
   }
   print ";$in{'Addr2LblType2'};$in{'Addr2LblType3'};ENCODING=QUOTED-PRINTABLE:";
   print "$in{'Addr2Label'}\n";
}
if ($in{'Tel1'}) {

   if($in{'netsc'} eq 'No') { print "   TEL;$in{'Tel1Type'}"; }
   else { print "TEL;$in{'Tel1Type'}"; }
   
   if ($in{'Tel1Voice'}) { print ";VOICE"; }
   if ($in{'Tel1Fax'}) { print ";FAX"; }
   if ($in{'Tel1Mesg'}) { print ";MESG"; }
   if ($in{'Tel1Pref'}) { print ";PREF"; }
   print ":$in{'Tel1'}\n";
}
if ($in{'Tel2'}) {

   if($in{'netsc'} eq 'No') { print "   TEL;$in{'Tel2Type'}"; }
   else { print "TEL;$in{'Tel2Type'}"; }
   
   if ($in{'Tel2Voice'}) { print ";VOICE"; }
   if ($in{'Tel2Fax'}) { print ";FAX"; }
   if ($in{'Tel2Mesg'}) { print ";MESG"; }
   if ($in{'Tel2Pref'}) { print ";PREF"; }
   print ":$in{'Tel2'}\n";
}
if ($in{'Tel3'}) {

   if($in{'netsc'} eq 'No') { print "   TEL;$in{'Tel3Type'}"; }
   else { print "TEL;$in{'Tel3Type'}"; }
   
   if ($in{'Tel3Voice'}) { print ";VOICE"; }
   if ($in{'Tel3Fax'}) { print ";FAX"; }
   if ($in{'Tel3Mesg'}) { print ";MESG"; }
   if ($in{'Tel3Pref'}) { print ";PREF"; }
   print ":$in{'Tel3'}\n";
}
if ($in{'Tel4'}) {

   if($in{'netsc'} eq 'No') { print "   TEL;$in{'Tel4Type'}"; }
   else { print "TEL;$in{'Tel4Type'}"; }
   
   if ($in{'Tel4Voice'}) { print ";VOICE"; }
   if ($in{'Tel4Fax'}) { print ";FAX"; }
   if ($in{'Tel4Mesg'}) { print ";MESG"; }
   if ($in{'Tel4Pref'}) { print ";PREF"; }
   print ":$in{'Tel4'}\n";
}
if ($in{'Tel5'}) {

   if($in{'netsc'} eq 'No') { print "   TEL;$in{'Tel5Type'}"; }
   else { print "TEL;$in{'Tel5Type'}"; }
   
   if ($in{'Tel5Voice'}) { print ";VOICE"; }
   if ($in{'Tel5Fax'}) { print ";FAX"; }
   if ($in{'Tel5Mesg'}) { print ";MESG"; }
   if ($in{'Tel5Pref'}) { print ";PREF"; }
   print ":$in{'Tel5'}\n";
}

if($in{'netsc'} eq 'No') { print "   EMAIL;$in{'EmailType'}:$in{'Email'}\n"; }
else { print "EMAIL;$in{'EmailType'}:$in{'Email'}\n"; }

if ($in{'URL'}) {

   if($in{'netsc'} eq 'No') { print "   URL:$in{'URL'}\n";
                              print "   UID:$in{'URL'}\n"; }
   else { print "URL:$in{'URL'}\n";
          print "UID:$in{'URL'}\n"; }
}

if ($in{'TZ'}) {
   if($in{'netsc'} eq 'No') { print "   TZ:$in{'TZ'}\n"; }
   else { print "TZ:$in{'TZ'}\n"; }
}

if ($in{'BDay'}) {
   if($in{'netsc'} eq 'No') { print "   BDAY:$in{'BDay'}\n"; }
   else { print "BDAY:$in{'BDay'}\n"; }
}

if($in{'netsc'} eq 'No') { print "   REV:$fdatem\n"; }
else { print "REV:$fdatem\n"; }

if($in{'netsc'} eq 'No') { print "   VERSION:2.1\n"; }
else { print "VERSION:2.1\n"; }

print "END:VCARD\n";

print <


EOF

exit ;


#-------------- start of &getcgivars() module, copied in -------------

#########
# Read all CGI vars into an associative array.
# If multiple input fields have the same name, they are concatenated into
#   one array element and delimited with the \0 character.
# Currently only supports Content-Type of application/x-www-form-urlencoded.
sub getcgivars {
    local($in, %in) ;
    local($name, $value) ;


    # First, read entire string of CGI vars into $in
    if ($ENV{'REQUEST_METHOD'} eq 'GET') {
        $in= $ENV{'QUERY_STRING'} ;

    } elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
        if ($ENV{'CONTENT_TYPE'}=~ m#^application/x-www-form-urlencoded$#i) {
            $ENV{'CONTENT_LENGTH'}
                || &HTMLdie("No Content-Length sent with the POST request.") ;
            read(STDIN, $in, $ENV{'CONTENT_LENGTH'}) ;

        } else { 
            &HTMLdie("Unsupported Content-Type: $ENV{'CONTENT_TYPE'}") ;
        }

    } else {
        &HTMLdie("Script was called with unsupported REQUEST_METHOD.") ;
    }
    
    # Resolve and unencode name/value pairs into %in
    foreach (split('&', $in)) {
        s/\+/ /g ;
        ($name, $value)= split('=', $_, 2) ;
        $name=~ s/%(..)/sprintf("%c",hex($1))/ge ;
        $value=~ s/%(..)/sprintf("%c",hex($1))/ge ;
        $in{$name}.= "\0" if defined($in{$name}) ;  # concatenate multiple vars
        $in{$name}.= $value ;
    }

    return %in ;

}


#########
# Die, outputting HTML error page
# If no $title, use a default title
sub HTMLdie {
    local($msg,$title)= @_ ;
    $title || ($title= "CGI Error") ;
    print <

$title


$title
$msg


EOF

    exit ;
}

#-------------- end of &getcgivars() module --------------------------