# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- # Copyright ©2004 W3C® (MIT, INRIA, Keio University), #Last update $Date: 2004/12/30 00:30:00 $ by $Author: eric $. $Revision: 1.4 $ use strict; my $MID = "http://www.w3.org/mid/"; my $REFMARK = ";reference"; my %VCALTypes = ('Fax' => 'FAX,WORK', 'Home' => 'VOICE,HOME', 'Home Office' => 'VOICE,WORK', 'Main' => 'VOICE,PREF', 'Mobile' => 'CELL', 'Office' => 'VOICE,WORK', 'Other' => 'VOICE', 'Skype' => 'VOICE,INTERNET'); package PresenterException; @PresenterException::ISA = qw(W3C::Util::Exception); @PresenterException::REVISION = '$Id: ContactPresenter.pm,v 1.4 2004/12/30 00:30:00 eric Exp $ '; package Presenter; use CGI qw/:standard/; sub new { my ($proto, $sessionId, $queryList) = @_; my $class = ref($proto) || $proto; my $self = {SESSION_ID => $sessionId, BUFFER => '', QueryList => $queryList}; bless ($self, $class); return $self; } # Utility functions used by subclasses sub print { my ($self, @printables) = @_; $self->{BUFFER} .= join('', @printables); } sub OKHeader { my ($self) = @_; $self->print(header( -Cache_Control => 'max-age=3600', Content_Type => $self->getContentType, Content_Language => 'en', Status => '200 OK')); } sub flush {$_[0]->{BUFFER}} sub xmlEncode { my ($d, $a) = @_; $a =~ s/\&/\&/g; $a =~ s/\"/\"/g; $a =~ s/\/\>/g; return $a; } sub splitAddrEncode { my ($self, $fullAddr) = @_; my ($name, $addr) = (undef, $self->xmlEncode($fullAddr)); if ($fullAddr =~ m/^\s*\"?\s*([^\"\<]+)\s*\"?\s*\<([^\>]+)\>\s*/) { ($name, $addr) = ($1, $self->xmlEncode($2)); $name =~ s/\s*$//; $name = $self->xmlEncode($name); } return ($name, $addr); } # some default presentation functions: sub getContentType {'text/plain'} # N3 and RDF don't have a rendering for these at present as no clients would # know how to deal with an RDF form. sub print_simple_form {} sub print_adv_form {} use Date::Manip; BEGIN{&Date_Init("TZ=GMT")}; sub dateISO { my ($self, $str) = @_; if (my $d = &ParseDateString($str)) { return &UnixDate(&Date_ConvTZ($d, 'GMT'), "%Y-%m-%dT%H:%M:%SZ") } else { return undef; } } package VCardPresenter; # per RFC2426 @VCardPresenter::ISA = qw(Presenter); sub getContentType {'text/x-vcard; charset=utf-8'} # Per RFC2425 sub print_header { my ($self) = @_; } sub print_foot { my ($self) = @_; } # Omitted Evolution fields: #X-EVOLUTION-FILE-AS:$family\, $given #ADR;TYPE=HOME:;;35\, rue Nationale;Paris;;75013;France #ADR;TYPE=WORK:;;35\, rue Nationale;Paris;;75013;France #LABEL;TYPE=HOME:35\, rue Nationale\nParis\n75013\nFrance #LABEL;TYPE=WORK:35\, rue Nationale\nParis\n75013\nFrance #X-EVOLUTION-LAST-USE:2004-12-22 #X-EVOLUTION-USE-SCORE:132.142181 #X-MOZILLA-HTML:FALSE #UID:pas-id-41CC6D0200000323 #TITLE: #ROLE: #X-EVOLUTION-MANAGER: #X-EVOLUTION-ASSISTANT: #X-EVOLUTION-SPOUSE: #NOTE: #X-EVOLUTION-BLOG-URL: #CALURI: #FBURL: #X-EVOLUTION-VIDEO-URL: #EMAIL;TYPE=WORK; -->X-EVOLUTION-UI-SLOT=1<-- :$email #TEL;TYPE=$type; -->X-EVOLUTION-UI-SLOT=$uislot<-- :$number\n sub showMatches { my ($self, $results) = @_; foreach my $result (@$results) { my ($userId, $family, $given, $teamPage, $org, $title, $bday, $nick, $email, $altEmail, $phones, $domains, $bio, $image, $peoplePage) = @$result; my $guessHost = ''; for (my $i = 0; $i < @$phones; $i++) { my $phone = $phones->[$i]; my ($phoneId, $number, $phonemeta, $host, $site, $note) = @$phone; if ($host ne 'Other' && $host ne '') { $guessHost = $host; last; } } my $domainList = join(',', map {$_->[0]} @$domains); $self->print("BEGIN:VCARD VERSION:3.0 FN:$given $family N:$family;$given;;; URL:$teamPage ORG:$org/$guessHost;$domainList TITLE:$title CATEGORIES:$guessHost BDAY:$bday PHOTO;VALUE=uri:$image NICKNAME:$nick EMAIL;TYPE=WORK:$email EMAIL;TYPE=OTHER:$altEmail\n"); for (my $i = 0; $i < @$phones; $i++) { my $phone = $phones->[$i]; my ($phoneId, $number, $phonemeta, $host, $site, $note) = @$phone; my $type = $VCALTypes{$phonemeta} || '???'; $self->print("TEL;TYPE=$type:$number\n"); } $self->print("END:VCARD\n\n"); } } sub print_Exception { my ($self, $exception) = @_; my $message = $self->xmlEncode($exception->getMessage); $self->print("X-Exception:\"$message\". "); } sub print_warning { my ($self, $message) = @_; $message = $self->xmlEncode($message); $self->print("X-Warning:\"$message\". "); } sub print_resultCount { my ($self, $count) = @_; } package N3Presenter; @N3Presenter::ISA = qw(Presenter); sub getContentType {'application/vnd.w3c.n3'} sub print_header { my ($self) = @_; $self->print("\@prefix email: . \@prefix log: . \@prefix rdf: . \@prefix VCard: . \@prefix session: . <> session:id \"$self->{SESSION_ID}\". "); } sub print_foot { my ($self) = @_; } sub showMatches { my ($self, $results) = @_; foreach my $result (@$results) { my ($userId, $family, $given, $teamPage, $org, $title, $bday, $nick, $email, $altEmail, $phones, $domains, $bio, $image, $peoplePage) = @$result; my $guessHost = ''; my $prefix = undef; for (my $i = 0; $i < @$phones; $i++) { my $phone = $phones->[$i]; my ($phoneId, $number, $phonemeta, $host, $site, $note) = @$phone; if ($host ne 'Other' && $host ne '') { $guessHost = $host; last; } } my $domainList = join(',', map {$_->[0]} @$domains); $self->print("[ VCard:FN \"$given $family\" ; VCard:N [ VCard:Family \"$family\" ; VCard:Given \"$given\" "); if ($prefix) { $self->print(";\n VCard:Prefix \"$prefix\""); } $self->print("] ; VCard:URL <$teamPage> ; VCard:ORG \"$org/$guessHost;$domainList\" ; VCard:TITLE \"$title\" ; VCard:CATEGORIES \"$guessHost\" ; VCard:BDAY \"$bday\" ; VCard:PHOTO <$image> ; VCard:NICKNAME \"$nick\" ; VCard:EMAIL [ VCard:TYPE VCard:WORK ; rdf:value ] ; VCard:EMAIL [ VCard:TYPE VCard:WORK ; rdf:value ]"); for (my $i = 0; $i < @$phones; $i++) { my $phone = $phones->[$i]; my ($phoneId, $number, $phonemeta, $host, $site, $note) = @$phone; my $type = $VCALTypes{$phonemeta} || '???'; $self->print(" ; VCard:TEL [ rdf:value ; VCard:TYPE \"$type\" ]"); } $self->print(" ] .\n"); } } sub print_Exception { my ($self, $exception) = @_; my $message = $self->xmlEncode($exception->getMessage); $self->print("<> search:exception \"$message\". "); } sub print_warning { my ($self, $message) = @_; $message = $self->xmlEncode($message); $self->print("<> search:exception \"$message\". "); } sub print_resultCount { my ($self, $count) = @_; $self->print(" $count "); } package RDFPresenter; @RDFPresenter::ISA = qw(Presenter); sub getContentType {'application/rdf+xml'} sub print_header { my ($self) = @_; $self->print(" "); $self->print_RDFElement; $self->print(" {SESSION_ID}\"/>\n\n"); } sub print_RDFElement { my ($self) = @_; $self->print(" "); } sub print_foot { my ($self) = @_; $self->print(' '); } sub showMatches { my ($self, $count, $begin, $end, $perPage, $scriptInvocation, $keyword, $results) = @_; foreach my $result (@$results) { my $tauth = $result->[5]; my ($ordinal, $mid, $subject, $score, $bytes, $author, $date, $access, $trimlist, $rmailNo, $uri, $sample, $replto, $refs) = map {$self->xmlEncode($_)} @$result; my ($authorName, $authorAddr) = $self->splitAddrEncode($result->[5]); my $authorNameStr = $authorName ? " $authorName;\n": ''; my $isoDate = $self->dateISO($date); my $isoDateStr = $isoDate ? " $isoDate\n" : ''; $self->print(" $date $isoDateStr $subject $authorNameStr $authorAddr $trimlist\@w3.org\n"); if ($replto) { $self->print(" \n"); } if (@$refs) { $self->print(" \n"); for (my $i = 0; $i < @$refs; $i++) { $self->print(" [$i]${REFMARK}\"/>\n"); } $self->print(" \n"); } for (my $i = 0; $i < @$refs; $i++) { $self->print(" [$i]${REFMARK}\"/>\n"); } $self->print(" \n\n"); } } sub print_Exception { my ($self, $exception) = @_; my $message = $self->xmlEncode($exception->getMessage); $self->print(" $message "); } sub print_warning { my ($self, $message) = @_; $message = $self->xmlEncode($message); $self->print(" $message "); } sub print_resultCount { my ($self, $count) = @_; $self->print(" $count "); } package SOAPPresenter; @SOAPPresenter::ISA = qw(RDFPresenter); sub getContentType {'application/soap+xml'} sub print_header { my ($self) = @_; $self->print(" $self->{SESSION_ID} "); $self->print_RDFElement; } sub print_foot { my ($self) = @_; $self->SUPER::print_foot; $self->print(' '); } sub print_Exception { my ($self, $exception) = @_; my $message = $self->xmlEncode($exception->getMessage); $self->print(" $message "); } sub print_warning { my ($self, $message) = @_; $message = $self->xmlEncode($message); $self->print(" $message "); } sub print_resultCount { my ($self, $count) = @_; $self->print(" $count "); } package XHTMLPresenter; @XHTMLPresenter::ISA = qw(Presenter); use POSIX qw(ceil); use CGI qw/:standard/; use W3C::Util::Exception; sub getContentType {'text/html'} sub _readTemplate { my ($self, $template) = @_; open (H, $template) || &throw(new W3C::Util::FileOperationException(-filename => $template, -operation => 'open')); local $/ = undef; foreach my $line () { $self->print($line); } close (H); } sub print_header { my ($self) = @_; my $title = $self->{QueryList} ? 'Contact Info for '.join(',', @{$self->{QueryList}}) : 'The Global Team at Work: The W3C Team Directory'; $self->print(" $title
\"Team\"

$title

\n"); if (!$self->{QueryList}) { $self->print("

See also:

"); } $self->{Table} = []; $self->{Index} = []; } sub print_foot { my ($self) = @_; if (@{$self->{Index}} > 1) { my $count = @{$self->{Index}}; $self->print("

$count Team Members

\n"); map {$self->print("$_ ")} @{$self->{Index}}; $self->print("
\n"); } if (@{$self->{Table}}) { $self->print(" "); map {$self->print("$_ ")} @{$self->{Table}}; } else { $self->print("

bad news: there's noone left on the team

\n"); } if ($self->{QueryList}) { my $idStr = '$Id: ContactPresenter.pm,v 1.4 2004/12/30 00:30:00 eric Exp $'; $self->print("
Family, Given
Email		 Phone Note
Renaud and the webmaster team <webreq\@w3.org>
see also: w3m 10 Feb 1999
made with PHP Source code
$idStr
"); } else { $self->_readTemplate("contactFoot.xhtml"); } } sub print_Exception { my ($self, $exception) = @_; my $m = $self->xmlEncode($exception->getMessage); $self->print("

$m

\n"); } sub print_warning { my ($self, $message) = @_; $message = $self->xmlEncode($message); $self->print("
Warning: $message
\n"); } use HTML::Entities; sub showMatches { my ($self, $results) = @_; foreach my $result (@$results) { my ($userId, $family, $given, $teamPage, $org, $title, $bday, $nick, $email, $altEmail, $phones, $domains, $bio, $image, $peoplePage) = @$result; my $domainList = join(',', map {$_->[0]} @$domains); my $rowspan = @$phones; my $shortEmail = $email; $shortEmail =~ s/\@w3.org//; my $akaStr = $nick ? "(a.k.a $nick)" : ''; push (@{$self->{Index}}, "$family"); push (@{$self->{Table}}, " $family,$given $akaStr<$shortEmail>
Alt Email<$email>"); $self->renderPhone($phones->[0]); push (@{$self->{Table}}, " "); for (my $i = 1; $i < @$phones; $i++) { push (@{$self->{Table}}, " "); $self->renderPhone($phones->[$i]); push (@{$self->{Table}}, " "); } } } sub renderPhone { my ($self, $phone) = @_; my ($phoneId, $number, $phonemeta, $host, $site, $note) = @$phone; # Figure out the best URI scheme (if any) for the "phone" number. my $numberStr = $number; if ($phonemeta =~ m/skype/i) { # leave alone } elsif ($phonemeta =~ m/(sms|mms)/i) { $numberStr = "$number"; } elsif ($number =~ m/^\+[0-9\.\-]+$/) { if ($phonemeta =~ m/fax/i) { $numberStr = "$number"; } else { $numberStr = "$number"; } } my $hostStr = $host eq 'Other' || $host eq '' ? '' : "$host"; my $siteColon = $hostStr && $site ? ':' : ''; push (@{$self->{Table}}, " $phonemeta:$numberStr
$hostStr$siteColon$site $note
[edit] "); }