- From: Rotan Hanrahan <rotan.hanrahan@mobileaware.com>
- Date: Sun, 17 Feb 2008 19:44:00 -0500
- To: <public-ddwg@w3.org>
Below you will see the output of an early draft of a Perl binding for the DDR Simple API that I have put together. At the beginning is the user code, illustrating how the API would appear to a typical developer. The rest of the code (in package namespaces) would not be seen, as it would normally be in modules. This is an implementation of the API, adhering to the interface specification.
There are several holes in this code, mainly because the weekend is over and I need some sleep. However, much of the implementation is there and (more important) is actually working, as the sample output from running this program shows.
At the end of the Perl code is a package representing the back-end implementation. This is the bit that would normally map to a professional device repository, much like the one we have in MobileAware. However, to illustrate this API without requiring any actual back-end (not even WURFL!) I have hard-coded some device information into the program. It uses a very simple recognition mechanism (i.e. it maps User-Agent headers only) and only a small subset of the Core Vocabulary.
As you know, error checking and exceptions can bulk up a lot of source code, to the point of obfuscating it. Therefore I only have a little bit of error checking in here.
Also, OO programming in Perl is a bit of a subjective art, given that the language provides so much freedom. So I expect to make adjustments to the way this code is structured, without affecting the public interface, which by necessity must adhere to the DDR Simple API specification.
Several interesting issues appeared while I was writing this code, such as what to do with aspect ambiguity, some of which has been mentioned in the latest editors' draft of the API.
---Rotan.
(PS I suspect the W3C email distribution mechanism might mangle this code, so I'll put it somewhere else when I get the chance.)
(PPS Sorry about the poor documentation. If you don't speak Perl, this will all be gobbledegook.)
-------------------- BEGIN SAMPLE EXECUTION -----------------
Getting specific software values for this context:
Browser Display Height : 788
Browser Display Width : 1012
Getting specific hardware values for this context:
Physical Display Height : 800
Physical Display Width : 1024
Getting all values for this context:
displayHeight is 800
displayWidth is 1024
imageFormatSupport is ARRAY(0x1f71c7c)
Getting image format support for this context:
gif89a is supported
jpeg is supported
png is supported
--------------------- END SAMPLE EXECUTION ------------------
################################### SNIP HERE ##############################
# Perl binding to API given in http://www.w3.org/2005/MWI/DDWG/drafts/api/080215
# (c) Rotan Hanrahan 2008
# This code is not guaranteed fit for any purpose whatsoever. Use at your own risk.
# Instantiate new SimpleService
$ss = SimpleService->new();
$ss->initialize('DDRCoreVocabularyIRI'); # Todo : plugin classname for custom impl
# Populate new instance of Evidence
my $e = Evidence->new();
$e->put('User-Agent','Mozthing1.2e (X11; en-US; v12)');
$e->put('Accept','text/html, image/png, image/jpeg, image/gif, image/x-xbitmap, */*');
# Decide on the WebBrowser aspect (we're not interested in the physical aspect)
my $softwareAspect = $ss->newAspectName('WebBrowser');
my $hardwareAspect = $ss->newAspectName('Device');
# Two browser display properties of interest: Height and Width
my $heightPropName = $ss->newPropertyName('displayHeight');
my $widthPropName = $ss->newPropertyName('displayWidth');
my $propArray = [$heightPropName,$widthPropName];
# Get the values for these properties in this aspect given this evidence
print "Getting specific software values for this context:\n";
my $spvsSW = $ss->getPropertyValues($e,$softwareAspect,$propArray);
print " Browser Display Height : " . $spvsSW->getValue($heightPropName) . "\n";
print " Browser Display Width : " . $spvsSW->getValue($widthPropName) . "\n";
# Get the values for these properties in this aspect given this evidence
print "Getting specific hardware values for this context:\n";
my $spvsHW = $ss->getPropertyValues($e,$hardwareAspect,$propArray);
print " Physical Display Height : " . $spvsHW->getValue($heightPropName) . "\n";
print " Physical Display Width : " . $spvsHW->getValue($widthPropName) . "\n";
# Get all known data
print "Getting all values for this context:\n";
my $spvsAll = $ss->getPropertyValues($e);
my @allProperties = @{$spvsAll->getAll()};
foreach my $spv (@allProperties) {
print ' ' . $spv->getPropertyName() . ' is ' . $spv->getString() . "\n";
}
# Get image support information
print "Getting image format support for this context:\n";
my $imgFmtPropName = $ss->newPropertyName('imageFormatSupport');
my $spv = $ss->getPropertyValue($e,$imgFmtPropName);
my @supportedImageFormats = @{$spv->getEnumeration()};
foreach my $imgFmt (@supportedImageFormats) {
print ' ' . $imgFmt . " is supported\n";
}
exit 1;
# ==== END OF USER CODE ====
# ==== START OF API PACKAGES ====
# ------------------------------------------------------------------
package SimpleService;
use Scalar::Util qw(blessed);
# Constructor is not part of SimpleAPI specification
sub new {
my $pkg = shift;
my $this = {};
bless $this, $pkg;
return $this;
}
# [DDR Simple API] public void initialize(String defaultVocabularyIRI, Properties props) throws SystemException; // Vocabulary cannot be 'null'
sub initialize {
my $this = shift;
$this->{DEFAULTVOCABULARY} = shift;
if (@_) {
my $properties = shift; # In Perl, a Properties object is typically a hash
$this->{PROPS} = \$properties;
}
$this->{REPOSITORY} = CustomDDRImplementation->new();
}
# [DDR Simple API] public SimplePropertyValues getPropertyValues(Evidence evidence) throws SystemException;
# [DDR Simple API] public SimplePropertyValues getPropertyValues(Evidence evidence, PropertyName[] properties) throws NameException,SystemException;
# [DDR Simple API] public SimplePropertyValues getPropertyValues(Evidence evidence, AspectName aspect) throws SystemException;
# [DDR Simple API] public SimplePropertyValues getPropertyValues(Evidence evidence, AspectName aspect, PropertyName[] properties) throws NameException,SystemException;
sub getPropertyValues {
my $this = shift;
my $paramCount = @_;
my ($p1,$p2,$p3) = @_;
if ($paramCount == 1 && $p1->isa('Evidence')) {
return _getPropertyValues_Evidence($this,$p1);
}
if ($paramCount == 2) {
if ($p1->isa('Evidence') && !blessed($p2) && ref($p2) == 'ARRAY') {
return _getPropertyValues_Evidence_ARRAY($this,$p1,$p2);
}
if ($p1->isa('Evidence') && $p2->isa('AspectName')) {
return _getPropertyValues_Evidence_AspectName($this,$p1,$p2);
}
}
if ($paramCount == 3 && $p1->isa('Evidence') && $p2->isa('AspectName') && !blessed($p3) && ref($p3) == 'ARRAY') {
return _getPropertyValues_Evidence_AspectName_ARRAY($this,$p1,$p2,$p3);
}
die('Method signature unknown');
}
sub _getPropertyValues_Evidence {
my $this = shift;
my $evidence = shift;
my $spvs = SimplePropertyValues->new();
my @knownvocabularies = @{$this->{REPOSITORY}->getVocabularies()};
foreach my $vocab (@knownvocabularies) {
my @props = @{$this->{REPOSITORY}->getPropertyNames($vocab)};
foreach my $prop (@props) {
# As PropertyName objects don't know the aspect to which they apply,
# this implementation will retrieve properties according to their
# implementation-specific default aspects, where more than one applies.
my $aspect = $this->{REPOSITORY}->getDefaultAspect($prop,$vocab);
my $pn = $this->newPropertyName($prop);
my $aspectName = $this->newAspectName($aspect);
my $propertyValue = $this->{REPOSITORY}->getValue($evidence,$pn,$aspectName);
$spvs->setValue($pn,$propertyValue);
}
}
return $spvs;
}
sub _getPropertyValues_Evidence_ARRAY {
my $this = shift;
my $evidence = shift;
my $propertyNameARRAY = shift;
die 'Not Implemented';
# To Do
}
sub _getPropertyValues_Evidence_AspectName {
my $this = shift;
my $evidence = shift;
my $aspectName = shift;
die 'Not Implemented';
# To Do
}
sub _getPropertyValues_Evidence_AspectName_ARRAY {
my $this = shift;
my $evidence = shift;
my $aspectName = shift;
my $propertyNameARRAY = shift;
my $spvs = SimplePropertyValues->new();
foreach my $pn (@{$propertyNameARRAY}) {
die ('PropertyName[] contained a non-PropertyName element') if !$pn->isa('PropertyName');
my $propertyValue = $this->{REPOSITORY}->getValue($evidence,$pn,$aspectName);
$spvs->setValue($pn,$propertyValue);
}
return $spvs;
}
# [DDR Simple API] public SimplePropertyValue getPropertyValue(Evidence evidence, PropertyName propertyName) throws NameException,SystemException;
# [DDR Simple API] public SimplePropertyValue getPropertyValue(Evidence evidence, AspectName aspect,PropertyName propertyName) throws NameException,SystemException;
sub getPropertyValue {
my $this = shift;
my $paramCount = @_;
my ($evidence,$p2,$p3) = @_;
if ($paramCount == 2) {
$p3 = $p2;
$p2 = $this->{REPOSITORY}->getDefaultAspect($p3->getName(),$this->{DEFAULTVOCABULARY});
$paramCount = 3;
}
if ($paramCount == 3) {
my $propertyValue = $this->{REPOSITORY}->getValue($evidence,$p3,AspectName->new($p2));
my $spv = SimplePropertyValue->new($p3->getName(),$propertyValue);
return $spv;
}
}
# [DDR Simple API] public PropertyName newPropertyName(String localPropertyName) throws NameException;
# [DDR Simple API] public PropertyName newPropertyName(String vocabularyIRI, String localPropertyName) throws NameException;
sub newPropertyName {
my $this = shift;
my $paramCount = @_;
my ($p1,$p2) = @_;
if ($paramCount == 1) {
return PropertyName->new($p1,$this->{DEFAULTVOCABULARY});
}
if ($paramCount == 2) {
return PropertyName->new($p1,$p2);
}
return undef;
}
# [DDR Simple API] public AspectName newAspectName(String aspectIRI) throws NameException;
sub newAspectName { shift; return AspectName->new(shift); }
# [DDR Simple API] public AspectName[] listAspects() throws SystemException;
# [DDR Simple API] public PropertyName[] listProperties(String vocabularyIRI) throws SystemException;
# [DDR Simple API] public String[] listVocabularies() throws SystemException;
# ------------------------------------------------------------------
package Evidence;
# public interface Evidence extends Map { }
# Constructor is not part of SimpleAPI specification
sub new {
my $pkg = shift;
my %map; # an empty hash map
my $evidence = bless { 'map' => %map }, $pkg;
return $evidence;
}
# "put" is an assumed method of Map
sub put {
my ($evidence,$key,$val) = @_;
my $map = \$evidence->{'map'};
$map{$key} = $val;
}
# "get" is an assumed method of Map
sub get {
my ($evidence,$key) = @_;
my $map = \$evidence->{'map'};
return $map{$key};
}
# ------------------------------------------------------------------
package AspectName;
# Constructor is not part of SimpleAPI specification
sub new {
my $pkg = shift;
my $name = shift;
my $this = {};
bless ($this, $pkg);
$this->{NAME} = $name;
return $this;
}
# [DDR Simple API] public String getName();
sub getName {
my $this = shift;
return $this->{NAME};
}
# ------------------------------------------------------------------
package PropertyName;
# Constructor is not part of SimpleAPI specification
sub new {
my $pkg = shift;
my $name = shift;
my $this = {};
bless ($this, $pkg);
$this->{NAME} = $name;
if (@_) {
my $namespace = shift;
$this->{NAMESPACE} = $namespace;
}
else {
$this->{NAMESPACE} = 'DDRCoreVocabularyIRI'; # Seems reasonable, right?
}
return $this;
}
# [DDR Simple API] public String getName()
sub getName {
my $this = shift;
return $this->{NAME};
}
# [DDR Simple API] public String getNamespace()
# Returns the IRI of the vocabulary to which this named property belongs
sub getNamespace {
my $this = shift;
return $this->{NAMESPACE};
}
# ------------------------------------------------------------------
package SimplePropertyValues;
# Constructor is not part of SimpleAPI specification
sub new {
my $pkg = shift;
my $name = shift;
my $this = {};
bless ($this, $pkg);
return $this;
}
# [DDR Simple API] public SimplePropertyValue[] getAll()
sub getAll {
my $this = shift;
my @allPropertyValues = ();
foreach my $propName (sort keys %{$this}) {
my $value = $this->{$propName};
my $spv = SimplePropertyValue->new($propName,$value);
push(@allPropertyValues,$spv);
}
return \@allPropertyValues;
}
# [DDR Simple API] public SimplePropertyValue getValue(PropertyName prop) throws NameException
sub getValue {
my $this = shift;
my $prop = shift; die('Got ' . ref($prop) . ' when expecting PropertyName') if ref($prop) != 'PropertyName';
return $this->{$prop->getName()};
}
# Not part of public interface specification
# Assumed to be implementation dependent and private
sub setValue {
my $this = shift;
my $prop = shift; # assume to be a PropertyName object
my $value = shift; # assume to be a SimplePropertyValue object
$this->{$prop->getName()} = $value;
}
# ------------------------------------------------------------------
package SimplePropertyValue;
# Constructor is not part of official specification
sub new {
my $pkg = shift;
my $name = shift;
my $value = shift;
my $this = {};
bless ($this, $pkg);
$this->{NAME} = $name;
$this->{VALUE} = $value;
return $this;
}
# [DDR Simple API] public String getString() throws ValueException;
sub getString {
my $this = shift;
my $value = $this->{VALUE};
if (defined($value)) {
return '' . $value;
}
else {
die('ValueException: no value exists for this property');
}
}
# [DDR Simple API] public boolean getBoolean() throws ValueException;
sub getBoolean {
my $this = shift;
my $value = $this->{VALUE};
if (defined($value)) {
return $value?1:0; # Perl doesn't have an internal Boolean representation!
}
else {
die('ValueException: no value exists for this property');
}
}
# [DDR Simple API] public int getInteger() throws ValueException;
sub getInteger {
my $this = shift;
my $value = $this->{VALUE};
if (defined($value)) {
return 0 + $value;
}
else {
die('ValueException: no value exists for this property');
}
}
# [DDR Simple API] public String[] getEnumeration() throws ValueException;
sub getEnumeration {
my $this = shift;
my $value = $this->{VALUE};
if (defined($value) && ref($value) eq 'ARRAY') {
return $value;
}
else {
die('ValueException: no appropriate value exists for this property');
}
}
# [DDR Simple API] public float getFloat() throws ValueException;
# To Do
# [DDR Simple API] public double getDouble() throws ValueException;
# To Do
# [DDR Simple API] public long getLong() throws ValueException;
# To Do
# [DDR Simple API] public PropertyName getPropertyName();
sub getPropertyName {
my $this = shift;
return $this->{NAME};
}
# [DDR Simple API] public boolean exists();
sub exists {
my $this = shift;
return defined($this->{VALUE});
}
# CUSTOM REPOSITORY IMPLEMENTATION
# (Barely functional!)
# ------------------------------------------------------------------
package CustomDDRImplementation;
# Intentionally inefficient storage of device descriptions.
# Intentionally poor device recognition.
# If you want professional implementations, make or buy them.
sub new {
my $pkg = shift;
my $this = {};
bless ($this, $pkg);
$this->{VOCABULARIES} = [ 'DDRCoreVocabularyIRI' ];
$this->{ASPECTS} = [ 'Device', 'WebBrowser' ];
$this->{USERAGENTS} = [
'EI-emu (Gekoo; X11; watzit)',
'Mozthing1.2e (X11; en-US; v12)',
'Opella99 (Dash2; en-UK; mod-4; patched) nosuch/1255'
];
$this->{'DDRCoreVocabularyIRI'} = {
'displayHeight' => {
'Device' => [ 260, 800, 140 ],
'WebBrowser' => [ 240, 788, 136 ],
'DEFAULT' => 'Device'
},
'displayWidth' => {
'Device' => [ 180, 1024, 280 ],
'WebBrowser' => [ 160, 1012, 276 ],
'DEFAULT' => 'Device'
},
'imageFormatSupport' => {
'WebBrowser' => [
[ 'gif87', 'gif89a', 'jpeg', 'png', ],
[ 'gif89a', 'jpeg', 'png', ],
[ 'gif87', 'gif89a', 'jpeg', ]
],
'DEFAULT' => 'WebBrowser'
}
};
return $this;
}
sub _getValueDirect {
my $this = shift;
my $useragent = shift; # just an ordinary string
my $vocabulary = shift; # just an ordinary string
my $property = shift; # just an ordinary string
my $aspect = shift; # just an ordinary string
my @agents = @{$this->{USERAGENTS}};
my $lastUAindex = $#agents;
my $i = 0;
while ($i <= $lastUAindex && $agents[$i] ne $useragent) {
$i++;
}
if ($i <= $lastUAindex) {
return $this->{$vocabulary}->{$property}->{$aspect}[$i];
}
return undef;
}
sub getValue {
my $this = shift;
my $evidence = shift;
my $propertyName = shift;
my $aspectName = shift;
my $ua = $evidence->get('User-Agent');
my $voc = $propertyName->getNamespace();
my $prop = $propertyName->getName();
my $asp = $aspectName->getName();
return _getValueDirect($this,$ua,$voc,$prop,$asp);
}
# returns all vocabularies (IRIs) supported by this custom implementation
sub getVocabularies {
my $this = shift;
return $this->{VOCABULARIES};
}
# returns all property names for the given vocabulary IRI
sub getPropertyNames {
my $this = shift;
my $vocabulary = shift;
my %v = %{$this->{$vocabulary}};
my @result = sort keys %v;
return \@result;
}
# returns all aspects supported by this custom implementation
sub getAspects {
my $this = shift;
return $this->{ASPECTS};
}
# returns the default aspect for a named property in the given vocabulary
sub getDefaultAspect {
my $this = shift;
my $property = shift;
my $vocabulary = shift;
return $this->{$vocabulary}->{$property}->{DEFAULT};
}
Received on Monday, 18 February 2008 00:43:24 UTC