# Perl binding to API given in http://www.w3.org/TR/2008/WD-DDR-Simple-API-20080404/
# (c) Rotan Hanrahan 2008 under authority from MobileAware
# This code is not guaranteed fit for any purpose whatsoever. Use at your own risk.

# Core Vocabulary: http://www.w3.org/TR/2008/NOTE-ddr-core-vocabulary-20080414/
# Core Vocabulary IRI: http://www.w3.org/2008/01/ddr-core-vocabulary


################################################################################
## Part 1                                                                      #
## This section shows how a Perl programmer would use the DDR Simple API       #
## Demonstrates:                                                               #
##   - Use of Service methods to interact with DDR.                            #
##   - Getting single property value and collections of property values.       #
##   - Use of property term names and aspect names.                            #
##   - Catching exceptions thrown by the DDR.                                  #
################################################################################

eval { # TRY
  local $SIG{'__DIE__'};

  # Instantiate new Service
  $ss = Service->new();
  $ss->initialize('http://www.w3.org/2008/01/ddr-core-vocabulary',undef);

  print 'Using API (' . $ss->getImplementationVersion() . ') with Repository (' . $ss->getDataVersion() . ")\n";

  # Populate new instance of Evidence
  my $e = $ss->newHTTPEvidence(); #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, */*');

  print "Evidence from the delivery context:\n";
  print '  User-Agent: ' . $e->get('User-Agent') . "\n";
  print '  Accept:'      . $e->get('Accept')     . "\n";

  # Names of the aspects in which we are interested (aspect IRI is same as property IRI)
  my $softwareAspect = 'webBrowser';
  my $hardwareAspect = 'device';

  # Two display properties of interest: Height and Width
  my $heightPropName = $ss->newPropertyName('displayHeight');
  my $widthPropName = $ss->newPropertyName('displayWidth');

  # The two properties in the software aspect
  my $heightPropRefSW = $ss->newPropertyRef($heightPropName,$softwareAspect);
  my $widthPropRefSW = $ss->newPropertyRef($widthPropName,$softwareAspect);
  my $propRefArraySW = [ $heightPropRefSW, $widthPropRefSW ];

  # The two properties in the hardware aspect
  my $heightPropRefHW = $ss->newPropertyRef($heightPropName,$hardwareAspect);
  my $widthPropRefHW = $ss->newPropertyRef($widthPropName,$hardwareAspect);
  my $propRefArrayHW = [ $heightPropRefHW, $widthPropRefHW ];

  # 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,$propRefArraySW);
  print "  Browser Display Height : " . $spvsSW->getValue($heightPropRefSW)->getInteger() . "\n";
  print "  Browser Display Width  : " . $spvsSW->getValue($widthPropRefSW)->getInteger() . "\n";

  # Get the values for these properties in this aspect given this evidence
  # This demonstrates exception catching for case where one or both properties are not available
  eval { # TRY
    local $SIG{'__DIE__'};
    print "Getting specific hardware values for this context:\n";
    my $spvsHW = $ss->getPropertyValues($e,$propRefArrayHW);
    print "  Physical Display Height : " . $spvsHW->getValue($heightPropRefHW)->getInteger() . "\n";
    print "  Physical Display Width  : " . $spvsHW->getValue($widthPropRefHW)->getInteger() . "\n";
  };
  if ($@) { # CATCH
    if ($@->isa('NameException')) {
      print ' * * Caught expected NameException: [(' . $@->getCode() . ') ' . $@->getMessage() . "]\n";
    }
  }

  # Get all known data
  print "Getting all values for this context:\n";
  my $pvsAll = $ss->getPropertyValues($e);
  my @allProperties = $pvsAll->getAll();
  foreach my $pv (@allProperties) {
    my $pRef =$pv->getPropertyRef();
    print '  ' . $pRef->getLocalPropertyName() . ' is ' . $pv->getString() . "\n";   # Have to assume String, no way to tell!
  }

  # 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";
  }

  # All-in-one: get the physical height of the device
  print "Getting information via Simple API methods only:\n";
  print "  Device Height = " . $ss->getPropertyValue($e,$ss->newPropertyRef($ss->newPropertyName('displayHeight'),'device'))->getString() . "\n";
  print "Getting information via implementation specific constructor:\n";
  print "  Device Height = " . $ss->getPropertyValue($e,PropertyRef->new('displayHeight','device'))->getString() . "\n";
  # Most likely convenience method we will be asked for:
  # print "  Device Height = " . $ss->getPropertyValue($e,'displayHeight','Device')->getString() . "\n";

  # Using the PropertyRef proposal
  print "Getting information via PropertyRef:\n";
  my $pr = PropertyRef->new('displayHeight','webBrowser');
  print '  Browser height = ' . $ss->getPropertyValue($e,$pr)->getInteger() . "\n";

};
if ($@) { # CATCH
  local $SIG{'__DIE__'};
  if ($@->isa('BaseException')) {
    print 'UNEXPECTED: Caught Exception: [' . $@->getCode() . ' ' . $@->getMessage() . "]\n";
    die 'Stopping because of unexpected exception';
  }
  else {
    die $@;
  }
}

################################################################################
## Part 2                                                                      #
## Shows how a typical Perl programmer might wrap the DDR Simple API to make   #
## use of the defaults, and pre-populate common parameters for re-use.         #
## Two subroutines are defined: convenienceInit() and getPropVal(e,a,p)        #
################################################################################

# The way Perl hackers might do this using convenience methods
eval { # TRY
  local $SIG{'__DIE__'};
  convenienceInit();
  my $e = $ss->newHTTPEvidence();
  $e->put('User-Agent','Mozthing1.2e (X11; en-US; v12)');
  $e->put('Accept','text/html, image/png, image/jpeg, image/gif, image/x-xbitmap, */*');
  print "Getting information via custom convenience methods:\n";
  print "  Device Height = " . getPropVal($e,'displayHeight','device')->getInteger() . "\n";
  print "  Device Width  = " . getPropVal($e,'displayWidth','device')->getInteger()  . "\n";
  print "  Image formats = " . join(',',getPropVal($e,'imageFormatSupport','webBrowser')->getEnumeration()) . "\n";
};
if ($@) { # CATCH
  local $SIG{'__DIE__'};
  if ($@->isa('BaseException')) {
    print 'UNEXPECTED: Caught Exception: [' . $@->getCode() . ' ' . $@->getMessage() . "]\n";
    die 'Stopping because of unexpected exception';
  }
  else {
    die $@;
  }
}

################################################################################
## Part 3                                                                      #
## Standard DDR Simple API tests, derived from the implementation test class   #
################################################################################

eval { # TRY
  local $SIG{'__DIE__'};
  print "BEGIN Standard API tests ------------------------------------------\n";
  my $s = Service->new();
  $s->initialize('http://www.w3.org/2008/01/ddr-core-vocabulary',undef);
  my $e = $ss->newHTTPEvidence(); #my $e = Evidence->new();
  $e->put('User-Agent','FakeDevice');
  DDRSimpleAPItest::initTest(
    $s, $e,
    'http://www.w3.org/2008/01/ddr-core-vocabulary','webBrowser', 'device', 11,
    'vendor', 'model', 'device', 'device', 'Acme Co.',
    'displayWidth', 'device', 120,
    'cookieSupport', 'webBrowser', 1,   # 1 = true
    'markupSupport', 'webBrowser', @{[ 'xhtmlBasic10', 'xhtmlMP10' ]}
  );
  %r = DDRSimpleAPItest::getReport();
  foreach $k (sort keys %r) {
    print "  $k = " . $r{$k} . "\n";
  }
  print "END   Standard API tests ------------------------------------------\n";
};
if ($@) { # CATCH
  if ($@->isa('BaseException')) {
    print 'UNEXPECTED: Caught Exception: [' . $@->getCode() . ' ' . $@->getMessage() . "]\n";
    die 'Stopping because of unexpected exception';
  }
  else {
    die $@;
  }
}


exit 1;



# These convenience methods might be hidden away in a custom Perl module
sub convenienceInit {
  $ddrSrv = Service->new();
  $ddrSrv->initialize('http://www.w3.org/2008/01/ddr-core-vocabulary');
  $DDRNullPropRef = PropertyRef->new('NULL','');
  $DDRNullValue = PropertyValue->new($DDRNullPropRef,'000000');
}
sub getPropVal {
  my ($ev,$p,$a) = @_;
  my $result;
  eval { # TRY
    local $SIG{'__DIE__'};
    $result = $ddrSrv->getPropertyValue($ev,$p,$a,'http://www.w3.org/2008/01/ddr-core-vocabulary');
  };
  if ($@) { # CATCH
    if ($@->isa('BaseException')) {
      print 'UNEXPECTED: Caught Exception: [' . $@->getCode() . ' ' . $@->getMessage() . "]\n";
      die 'Stopping because of unexpected exception';
    }
    else {
      die $@;
    }
  }
  if (!$result->exists()) { return $DDRNullValue; }
  return $result;
}

# ==== END OF USER CODE ====





################################################################################
## Part 4                                                                      #
## This is a set of Perl packages that implement the DDR Simple API.           #
## Public methods are marked thus in comments: [DDR Simple API]                #
################################################################################



# ==== START OF API PACKAGES ====

# ------------------------------------------------------------------
package Service;

use Scalar::Util qw(blessed);
use Carp;

# Constructor is not part of Simple API specification
sub new {
  my $pkg = shift;
  my $this = {};
  bless $this, $pkg;
  return $this;
}

# [DDR Simple API]  Service public String getImplementationVersion()
sub getImplementationVersion {
  return "1.1.0 http://www.w3.org/TR/2008/WD-DDR-Simple-API-20080404/";
}

# [DDR Simple API]  Service public String getDataVersion()
sub getDataVersion {
  my $this = shift;
  return $this->{REPOSITORY}->getDataVersion();
}

# [DDR Simple API] Service public PropertyRef[] listPropertyRefs()
sub listPropertyRefs {
  my $this = shift;
  my $repository = $this->{REPOSITORY};
  my @knownVocabularyIRIs = @{$this->{REPOSITORY}->getVocabularies()};
  my @propertyRefs = ();
  for my $vocabIRI (@knownVocabularyIRIs) {
    my @propertyNames = @{$repository->getPropertyNames($vocabIRI)};
    for my $propertyName (@propertyNames) {
      my @supportedAspects = @{$repository->getSupportedAspects($vocabIRI,$propertyName)};
      for my $aspectName (@supportedAspects) {
        push(@propertyRefs,PropertyRef->new(PropertyName->new($propertyName,$vocabIRI),$aspectName));
      }
    }
  }
  return \@propertyRefs;
}

# [DDR Simple API]  Service 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
    if (defined $properties) {
      $this->{PROPS} = \$properties;
    }
  }
  $this->{REPOSITORY} = CustomDDRImplementation->new();
}

# [DDR Simple API]  Service public PropertyValues getPropertyValues(Evidence evidence)
# [DDR Simple API]  Service public PropertyValues getPropertyValues(Evidence evidence, String localAspectName)
# [DDR Simple API]  Service public PropertyValues getPropertyValues(Evidence evidence, String localAspectName, String vocabularyIRI)
# [DDR Simple API]  Service public PropertyValues getPropertyValues(Evidence evidence, PropertyRef[] propertyRefs)
sub getPropertyValues {
  my $this = shift;
  my $paramCount = @_;
  my ($p1,$p2,$p3) = @_;
  if ($paramCount == 1 && $p1->isa('Evidence')) {                                   # getPropertyValues(Evidence)
    return _getPropertyValues_Evidence($this,$p1);
  }
  if ($paramCount == 2) {
    if ($p1->isa('Evidence') && !blessed($p2) && ref($p2) eq 'ARRAY') {             # getPropertyValues(Evidence, PropertyRef[])
      return _getPropertyValues_Evidence_ARRAY($this,$p1,$p2);
    }
    else {                                                                          # getPropertyValues(Evidence, String)
      return _getPropertyValues_Evidence_LocalAspectName($this,$p1,$p2);
    }
  }
  if ($paramCount == 3) {                                                           # getPropertyValues(Evidence, String, String)
    return _getPropertyValues_Evidence_LocalAspectName_AspectIRI($this,$p1,$p2,$p3);
  }
  die('Method signature unknown');
}

sub _getPropertyValues_Evidence {
  my $this     = shift;
  my $evidence = shift;
  my $pvs = PropertyValues->new();
  my @knownVocabularyIRIs = @{$this->{REPOSITORY}->getVocabularies()};
  foreach my $vocabularyIRI (@knownVocabularyIRIs) {
    my @localPropertyNames = @{$this->{REPOSITORY}->getPropertyNames($vocabularyIRI)};
    foreach my $localPropertyName (@localPropertyNames) {
      my $defaultAspectForProperty = $this->{REPOSITORY}->getDefaultAspect($localPropertyName,$vocabularyIRI);
      my $propertyName = $this->newPropertyName($localPropertyName);
      my $propertyRef = $this->newPropertyRef($propertyName,$defaultAspectForProperty);
      my $actualPropertyValue = $this->{REPOSITORY}->getValue($evidence,$localPropertyName,$defaultAspectForProperty,$vocabularyIRI);
      if (defined $actualPropertyValue) {
        my $propertyValue = PropertyValue->new($propertyRef,$actualPropertyValue);
        $pvs->setValue($propertyRef,$propertyValue);
      }
    }
  }
  return $pvs;
}

sub _getPropertyValues_Evidence_ARRAY {
  my $this             = shift;
  my $evidence         = shift;
  my $propertyRefARRAY = shift;
  my $vocabularyIRI    = $this->{DEFAULTVOCABULARY};
  my $pvs = PropertyValues->new();
  foreach my $pRef (@{$propertyRefARRAY}) {
    if (!$pRef->isa('PropertyRef')) {
      die SystemException->new('PropertyRef[] contained a non-PropertyRef element');
    }
    my $localPropertyName = $pRef->getLocalPropertyName();
    my $aspect = $pRef->getAspectName();
    if (!defined($aspect) || $aspect eq '') {
      my $aspect = $this->{REPOSITORY}->getDefaultAspect($localPropertyName,$vocabularyIRI);
    }
    my $namespace = $pRef->getNamespace();
    my $actualPropertyValue = $this->{REPOSITORY}->getValue($evidence,$localPropertyName,$aspect,$namespace);
    if (defined $actualPropertyValue) {
      my $propertyValue = PropertyValue->new($pRef,$actualPropertyValue);
      $pvs->setValue($pRef,$propertyValue);
    }
  }
  return $pvs;
}

sub _getPropertyValues_Evidence_LocalAspectName {  # gets all values
  my $this            = shift;
  my $evidence        = shift;
  my $localAspectName = shift;
  my $aspectIRI       = $this->{DEFAULTVOCABULARY}; # In Simple API, aspect IRI defaults to the property IRI
  return $this->_getPropertyValues_Evidence_LocalAspectName_AspectIRI($evidence,$localAspectName,$aspectIRI);
}

sub _getPropertyValues_Evidence_LocalAspectName_AspectIRI { # gets all values
  my $this            = shift;
  my $evidence        = shift;
  my $localAspectName = shift;
  my $aspectIRI       = shift;
  
  my $pvs = PropertyValues->new();
  my @knownVocabularyIRIs = @{$this->{REPOSITORY}->getVocabularies()};
  foreach my $vocabularyIRI (@knownVocabularyIRIs) {
    my @localPropertyNames = @{$this->{REPOSITORY}->getPropertyNames($vocabularyIRI)};
    foreach my $localPropertyName (@localPropertyNames) {
      my $defaultAspectForProperty = $this->{REPOSITORY}->getDefaultAspect($localPropertyName,$vocabularyIRI);
      my $propertyName = $this->newPropertyName($localPropertyName);
      my $propertyRef = $this->newPropertyRef($propertyName,$defaultAspectForProperty);
      my $actualPropertyValue = $this->{REPOSITORY}->getValue($evidence,$localPropertyName,$defaultAspectForProperty,$vocabularyIRI);
      if (defined $actualPropertyValue) {
        my $propertyValue = PropertyValue->new($propertyRef,$actualPropertyValue);
        $pvs->setValue($propertyRef,$propertyValue);
      }
    }
  }
  return $pvs;
  
}

# [DDR Simple API]  Service public PropertyValue getPropertyValue(Evidence evidence, PropertyRef propertyRef) throws NameException,SystemException;
# [DDR Simple API]  Service public PropertyValue getPropertyValue(Evidence evidence, PropertyName propertyName) throws NameException,SystemException;
# [DDR Simple API]  Service public PropertyValue getPropertyValue(Evidence evidence, String localPropertyName) throws NameException,SystemException;
# [DDR Simple API]  Service public PropertyValue getPropertyValue(Evidence evidence, String localPropertyName, String localAspectName, String vocabularyIRI) throws NameException;
sub getPropertyValue {
  my $this = shift;
  my ($evidence,$p2,$p3,$p4) = @_;
  my $localAspectName = undef;
  my $localPropertyName = undef;
  my $propertyRef = undef;
  my $vocabIRI = undef;
  if (ref($p2) eq 'PropertyName') {                                             # getPropertyValue(Evidence, PropertyName)
    $localAspectName = $this->{REPOSITORY}->getDefaultAspect($p2->getLocalPropertyName(),$this->{DEFAULTVOCABULARY});
    $localPropertyName = $p2->getLocalPropertyName();
    $propertyRef = $this->newPropertyRef($p2,$localAspectName);
    $vocabIRI = $propertyRef->getNamespace();
  }
  elsif (ref($p2) eq 'PropertyRef') {                                           # getPropertyValue(Evidence, PropertyRef)
    $localAspectName = $p2->getAspectName();
    $localPropertyName = $p2->getLocalPropertyName();
    $propertyRef = $p2;
    $vocabIRI = $propertyRef->getNamespace();
  }
  else {
    if (!defined($p3)) {                                                        # getPropertyValue(Evidence, String)
      $vocabIRI = $this->{DEFAULTVOCABULARY};
      $localAspectName = $this->{REPOSITORY}->getDefaultAspect($p2,$vocabIRI);
    }
    else {                                                                      # getPropertyValue(Evidence, String, String, String)
      $localAspectName = $p3;
      $vocabIRI = $p4;
    }
    $localPropertyName = $p2;
    $propertyRef = $this->newPropertyRef($this->newPropertyName($localPropertyName,$vocabIRI),$localAspectName);
  }
  my $actualPropertyValue = $this->{REPOSITORY}->getValue($evidence,$localPropertyName,$localAspectName,$vocabIRI);
  my $pv = PropertyValue->new($propertyRef,$actualPropertyValue);
  return $pv;
}

# [DDR Simple API]  Service public PropertyName newPropertyName(String localPropertyName) throws NameException;
# [DDR Simple API]  Service 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]  Service public PropertyRef newPropertyRef()
# [DDR Simple API]  Service public PropertyRef newPropertyRef(PropertyName propertyName)
# [DDR Simple API]  Service public PropertyRef newPropertyRef(PropertyName propertyName, String localAspectName)
sub newPropertyRef {
  my $this = shift;
  my ($localPropertyName,$localAspectName) = @_;
  if (defined $localPropertyName) {
    if (defined $localAspectName) {
      return PropertyRef->new($localPropertyName,$localAspectName);
    }
    else {
      return PropertyRef->new($localPropertyName,$PropertyRef::NULL_ASPECT);
    }
  }
  die "Unknown factory signature for newPropertyRef";
}

# [DDR Simple API]  Service public Evidence newHTTPEvidence()
# [DDR Simple API]  Service public Evidence newHTTPEvidence(Map map)    # Must pass 'map' by reference rather than by value
sub newHTTPEvidence {
  my $this = shift;
  my %hmap = %{(shift)};
  if (%hmap) {
    return HTTPEvidence->new(\%hmap);
  }
  else {
    return HTTPEvidence->new();
  }
}

# ------------------------------------------------------------------
package Evidence;

# Constructor is not part of the DDR Simple API specification
sub new {
  my $pkg = shift;
  my $name = shift;
  my $evidence = {};
  bless ($evidence, $pkg);
  $evidence->{'map'} = ();
  return $evidence;
}

# [DDR Simple API]  Evidence public Boolean exists()
sub exists {
  my ($evidence,$key) = @_;
  return defined($evidence->{'map'}{$key});
}

# [DDR Simple API]  Evidence public String get(String)
sub get {
  my ($evidence,$key) = @_;
  return $evidence->{'map'}{$key};
}

# [DDR Simple API]  Evidence public void put(String key, String value)
sub put {
  my ($evidence,$key,$val) = @_;
  $evidence->{'map'}{$key} =  $val;
}


# ------------------------------------------------------------------
package HTTPEvidence;    # This is NOT part of the DDR Simple API
BEGIN { @HTTPEvidence::ISA = qw( Evidence ); }

# public interface Evidence extends Map { }
# Constructor is not part of SimpleAPI specification
sub new {
  my $pkg = shift;
  my %initialhmap = %{(shift)};
  my %hmap;
  if (defined(%initialhmap)) {
    %hmap = %initialhmap;
  }
  else {
    %hmap = ();
  }
  my $evidence = {};
  bless ($evidence, $pkg);
  %{$evidence->{'map'}} = %hmap;
  return $evidence;
}

# ------------------------------------------------------------------
package PropertyName;

# Constructor is not part of SimpleAPI specification
sub new {
  my $pkg = shift;
  my $name = shift;
  my $this = {};
  bless ($this, $pkg);
  $this->{LOCALNAME} = $name;
  if (@_) {
    my $namespace = shift;
    $this->{NAMESPACE} = $namespace;
  }
  else {
    $this->{NAMESPACE} = 'http://www.w3.org/2008/01/ddr-core-vocabulary';
  }
  return $this;
}

# [DDR Simple API]  PropertyName public String getLocalPropertyName()
sub getLocalPropertyName {
  my $this = shift;
  return $this->{LOCALNAME};
}

# [DDR Simple API]  PropertyName public String getNamespace()
# Returns the IRI of the vocabulary to which this named property belongs
sub getNamespace {
  my $this = shift;
  return $this->{NAMESPACE};
}

# Implementation-specific method
sub _hash {
  my $this = shift;
  return $this->{NAMESPACE} . ':' . $this->{LOCALNAME};
}

# ------------------------------------------------------------------
package PropertyRef;

# Constructor is not part of SimpleAPI specification
sub new {
  my $pkg      = shift;
  my $property = shift;
  my $aspect   = shift;
  my $this = bless {}, $pkg;
  if (ref($property) eq 'PropertyName') {
    $this->{PROPERTYNAME} = $property;
  }
  else {
    $this->{PROPERTYNAME} = PropertyName->new($property);
  }
  # In an advanced version, aspect would be a special class
  $this->{LOCALASPECTNAME} = $aspect;
  return $this;
}

# [DDR Simple API]  PropertyRef public String getLocalPropertyName()
sub getLocalPropertyName {
  my $this = shift;
  return $this->{PROPERTYNAME}->getLocalPropertyName();
}

# [DDR Simple API]  PropertyRef public String getAspectName()
sub getAspectName {
  my $this = shift;
  return $this->{LOCALASPECTNAME};
}

# [DDR Simple API]  PropertyRef public String getNamespace()
sub getNamespace {
  my $this = shift;
  my $namespace = $this->{PROPERTYNAME}->getNamespace();
  if (!defined($namespace)) {
    return $PropertyRef::NULL_ASPECT;
  }
  else {
    return $namespace;
  }
}

# [DDR Simple API]
$PropertyRef::NULL_ASPECT = '__NULL__';

# Implementation-specific method
sub _hash {
  my $this = shift;
  return $this->{PROPERTYNAME}->_hash() . '::' . $this->{LOCALASPECTNAME};
}

# ------------------------------------------------------------------
package PropertyValues;

# 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]  PropertyValues public PropertyValue[] getAll()
sub getAll {
  my $this = shift;
  my @allPropertyValues = ();
  foreach my $hash (sort keys %{$this}) { # sorting is an arbitrary implementation decision. Not necessary according to the spec.
    my $propertyValue = $this->{$hash};
    push(@allPropertyValues,$propertyValue);
  }
  return @allPropertyValues;
}

# [DDR Simple API]  PropertyValues public PropertyValue getValue(PropertyRef prop) throws NameException
sub getValue {
  my $this = shift;
  my $pRef = shift; die('Got ' . ref($pRef) . ' when expecting PropertyRef') if ref($pRef) ne 'PropertyRef';
  my $hash = $pRef->_hash();
  my $value = $this->{$hash};
  if (!defined $value) {
    my $vocabIRI = $pRef->getNamespace();
    my $aspectName = $pRef->getAspectName();
    my $propname = $pRef->getLocalPropertyName();
    die NameException->new($NameException::PROPERTY_NOT_RECOGNIZED,"NameException: $vocabIRI:$aspectName:$propname not found." );
  }
  return $value;
}

# Not part of public interface specification
# Assumed to be implementation dependent and private
sub setValue {
  my $this  = shift;
  my $pRef  = shift; # assume to be a PropertyRef object
  my $value = shift; # assume to be a PropertyValue object
  $this->{$pRef->_hash()} = $value;
}

# ------------------------------------------------------------------
package PropertyValue;

# Constructor is not part of official specification
sub new {
  my $pkg         = shift;
  my $pRef        = shift;
  my $actualValue = shift;
  my $this = {};
  bless ($this, $pkg);
  $this->{PROPERTYREF} = $pRef;
  $this->{VALUE} = $actualValue;
  return $this;
}

# [DDR Simple API]  PropertyValue public String getString() throws ValueException;
sub getString {
  my $this = shift;
  my $value = $this->{VALUE};
  if (defined($value)) {
    return '' . $value; # Always return some string, even if it's actually a representation of a non-string
  }
  else {
    my $propName = $this->{PROPERTYREF}->getLocalPropertyName();
    my $propAspect = $this->{PROPERTYREF}->getAspectName();
    die ValueException->new($ValueException::NOT_KNOWN,"ValueException: no value exists for the $propAspect:$propName property");
  }
}

# [DDR Simple API]  PropertyValue 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, so use Perl magic
  }
  else {
    my $propName = $this->{PROPERTYREF}->getLocalPropertyName();
    my $propAspect = $this->{PROPERTYREF}->getAspectName();
    die ValueException->new($ValueException::NOT_KNOWN,"ValueException: no value exists for the $propAspect:$propName property");
  }
}

# [DDR Simple API]  PropertyValue public int getInteger() throws ValueException;
sub getInteger {
  my $this = shift;
  my $value = $this->{VALUE};
  if (defined($value)) {
    if ($value =~ /^\d+$/) {
      return $value;
    }
    else {
      my $propName = $this->{PROPERTYREF}->getLocalPropertyName();
      my $propAspect = $this->{PROPERTYREF}->getAspectName();
      die ValueException->new($ValueException::INCOMPATIBLE_TYPES,"ValueException: the $propAspect:$propName property is not an integer");
    }
  }
  else {
    my $propName = $this->{PROPERTYREF}->getLocalPropertyName();
    my $propAspect = $this->{PROPERTYREF}->getAspectName();
    die ValueException->new($ValueException::NOT_KNOWN,"ValueException: no value exists for the $propAspect:$propName property");
  }
}

# [DDR Simple API]  PropertyValue public String[] getEnumeration() throws ValueException;
sub getEnumeration {
  my $this = shift;
  my $value = $this->{VALUE};
  if (defined($value)) {
    if (ref($value) eq 'ARRAY') {
      return @{$value};
    }
    else {
      return [ $value ]; # put single value into a single-cell array
    }
  }
  else {
    my $propName = $this->{PROPERTYREF}->getLocalPropertyName();
    my $propAspect = $this->{PROPERTYREF}->getAspectName();
    die ValueException->new($ValueException::NOT_KNOWN,"ValueException: no value exists for the $propAspect:$propName property");
  }
}
# [DDR Simple API]  PropertyValue public float getFloat() throws ValueException;
# To Do
# [DDR Simple API]  PropertyValue public double getDouble() throws ValueException;
# To Do
# [DDR Simple API]  PropertyValue public long getLong() throws ValueException;
# To Do

# [DDR Simple API]  PropertyValue public PropertyName getPropertyName();
sub getPropertyRef {
  my $this = shift;
  return $this->{PROPERTYREF};
}

# [DDR Simple API]  PropertyValue public boolean exists();
sub exists {
  my $this = shift;
  return defined($this->{VALUE});
}

################################################################################
## Part 5                                                                      #
## Exceptions thrown by various DDR Simple API methods.                        #
################################################################################


# = = = = = = EXCEPTION CLASSES = = = = = = = = = = = = = = = = = = =

# ------------------------------------------------------------------
# BaseException is implementation-specific. (Not part of DDR API)
package BaseException;

sub new {
  my $pkg = shift;
  my $message = shift;
  my $self = bless { MESSAGE => $message }, $pkg;
  return $self;
}

sub getMessage {
  my $this = shift;
  return $this->{MESSAGE};
}

# ------------------------------------------------------------------
package DDRException;
BEGIN { @DDRException::ISA = qw( BaseException ); }

use Carp;

# DDRException()
# DDRException(int code, String message)
# DDRException(int code, Throwable thr)    // Throwable is not a Perl type
sub new {
  my $pkg = shift;
  my $self = bless { }, $pkg;
  if (@_) {
    my $code = shift;
    $self->{CODE} = $code;
    if (@_) {
      my $message = shift;      # assume a message string. Throwable not supported.
      $self->{MESSAGE} = $message;
    }
  }
  ($cpkg, $cfile, $cline) = caller;
  #print "$pkg created by $cpkg at line $cline. (" . $self{MESSAGE} . ")\n";
  #confess();
  return $self;
}

# [DDR Simple API]  DDRException public int getCode()
sub getCode {
  my $this = shift;
  return $this->{CODE};
}

# [DDR Simple API]  DDRException public String getMessage()
sub getMessage {
  my $this = shift;
  return $this->{MESSAGE};
}

# ------------------------------------------------------------------
package NameException;
BEGIN {
  @NameException::ISA = qw( DDRException );
  # [DDR Simple API]
  $ASPECT_NOT_RECOGNIZED     = 800;
  $PROPERTY_NOT_RECOGNIZED   = 100;
  $VOCABULARY_NOT_RECOGNIZED = 200;
}

# ------------------------------------------------------------------
package SimpleException;
BEGIN { @SimpleException::ISA = qw( DDRException ); }

# ------------------------------------------------------------------
package ValueException;
BEGIN {
  @ValueException::ISA = qw( DDRException );
  # [DDR Simple API]
  $INCOMPATIBLE_TYPES =  600;
  $MULTIPLE_VALUES    = 1000;
  $NOT_KNOWN          =  900;
}

# ------------------------------------------------------------------
package SystemException;
BEGIN {
  @SystemException::ISA = qw( BaseException );
  # [DDR Simple API]
  $CANNOT_PROCEED = 500;
  $INITIALIZATION = 400;
}

use Carp;

# SystemException()
# SystemException(int code, String message)
# SystemException(int code, Throwable thr)    // Throwable is not a Perl type
sub new {
  my $pkg = shift;
  my $self = bless { }, $pkg;
  if (@_) {
    my $code = shift;
    $self->{CODE} = $code;
    if (@_) {
      my $message = shift;      # assume a message string. Throwable not supported.
      $self->{MESSAGE} = $message;
    }
  }
  ($cpkg, $cfile, $cline) = caller;
  #print "$pkg created by $cpkg at line $cline. (" . $self{MESSAGE} . ")\n";
  #confess();
  return $self;
}

# [DDR Simple API]  SystemException public int getCode()
sub getCode {
  my $this = shift;
  return $this->{CODE};
}

# [DDR Simple API]  SystemException public String getMessage()
sub getMessage {
  my $this = shift;
  return $this->{MESSAGE};
}


################################################################################
## Part 6                                                                      #
## A custom implementation of the back-end logic that retrieves actual data.   #
## Actual implementations of this part would probably interact with a database #
## or expert system, or fuzzy logic or some other proprietary system.          #
## This example hard-codes the data in-situ and does not connect elsewhere.    #
## Only a few of the DDR Core Vocabulary property terms are represented here.  #
## Context recognition depends solely on matching the User-Agent evidence.     #
## Some pseudo-devices are hard-coded in this collection of device data.       #
## Unknown/unavailable data are represented as 'undef'.                        #
################################################################################



# 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->{DATAVERSION} = '080715';
  $this->{VOCABULARIES} = ([ 'http://www.w3.org/2008/01/ddr-core-vocabulary' ]);  # This repository only knows the Core Vocab
  $this->{ASPECTS} = ([ 'device', 'webBrowser' ]);                                # All of the aspects known to the repository
  $this->{USERAGENTS} = ([                                                        # There are 4 devices known to this repository
    'EI-emu (Gekoo; X11; watzit)',
    'Mozthing1.2e (X11; en-US; v12)',
    'Opella99 (Dash2; en-UK; mod-4; patched) nosuch/1255',
    'FakeDevice'
  ]);
  $this->{'http://www.w3.org/2008/01/ddr-core-vocabulary'} = {
    'vendor' => {
      'device'     => [ undef, undef, undef, 'Acme Co.' ],           # only the vendor of FakeDevice is known
      'webBrowser' => [ undef, undef, undef, undef ],
      'DEFAULT'    => 'device'
    },
    'model' => {                                                     # no information regarding models is known
      'device'     => [ undef, undef, undef, undef ],
      'webBrowser' => [ undef, undef, undef, undef ],
      'DEFAULT'    => 'device'
    },
    'displayHeight' => {                                             # some information about the display height is known
      'device'     => [ 260, 800, 140, undef ],
      'webBrowser' => [ 240, 788, 136, undef ],
      'DEFAULT'    => 'device'                       # device takes precedence over webBrowser in the Core Vocab
    },
    'displayWidth' => {
      'device'     => [ 180, undef, 280, 120 ],
      'webBrowser' => [ 160, 1012,  276, undef ],
      'DEFAULT'    => 'device'                       # device takes precedence over webBrowser in the Core Vocab
    },
    'imageFormatSupport' => {
      'webBrowser' => [
        [ 'gif87',  'gif89a', 'jpeg', 'png', ],
        [ 'gif89a', 'jpeg',   'png',         ],
        [ 'gif87',  'gif89a', 'jpeg',        ],
        undef                                        # repository does not know about the image support for FakeDevice
      ],
      'DEFAULT'    => 'webBrowser'
    },
    'cookieSupport' => {
      'webBrowser' => [ undef, undef, undef, 1 ],
      'DEFAULT'    => 'webBrowser'
    },
    'markupSupport' => {
      'webBrowser' => [ undef, undef, undef, [ 'xhtmlBasic10', 'xhtmlMP10' ] ],
      '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 $localPropertyName = shift;
  my $localAspectName   = shift;
  my $namespace         = shift;
  my $ua = $evidence->get('User-Agent');
  return _getValueDirect($this,$ua,$namespace,$localPropertyName,$localAspectName);
}

# 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;
}

# return all supported aspects for a given named property in a given vocabulary
# (Note: this is implemented by scanning the available data)
sub getSupportedAspects {
  my $this       = shift;
  my $vocabulary = shift;
  my $propName   = shift;
  my %repository = %{$this->{$vocabulary}};
  my %entries = %{$repository{$propName}};
  my @aspects = ();
  foreach my $a (keys %entries) {
    if ($a ne 'DEFAULT') { push(@aspects,$a); }
  }
  return \@aspects;
}

# returns all aspects supported by this custom implementation
# This is implemented by reading a previously stored summary from the repository
sub getAllAspects {
  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};
}

# returns the version of the data that is available from the repository
sub getDataVersion {
  my $this = shift;
  return $this->{DATAVERSION};
}

################################################################################
# Part 7                                                                       #
# The test methods derived from the published Java test class                  #
################################################################################

# ------------------------------------------------------------------
package DDRSimpleAPItest;

my $vocabularyIRI;
my $aspect1;
my $aspect2;
my $totalPropertRefsInService;

my $localPropertyKnownString;
my $localPropertyUnknownString;
my $localAspectKnownString;
my $localAspectUnknownString;
my $localKnownStringValue;

my $localPropertyKnownInteger;
my $localAspectKnownInteger;
my $localKnownIntegerValue;

my $localPropertyKnownBoolean;
my $localAspectKnownBoolean;
my $localKnownBooleanValue;

my $localPropertyKnownEnumeration;
my $localAspectKnownEnumeration;
my @localKnownEnumerationValue;

my %report;

my $s;
my $e;

sub initTest {
  $s                             = shift;
  $e                             = shift;
  $vocabularyIRI                 = shift;
  $aspect1                       = shift;
  $aspect2                       = shift;
  $totalPropertRefsInService     = shift;
  $localPropertyKnownString      = shift;
  $localPropertyUnknownString    = shift;
  $localAspectKnownString        = shift;
  $localAspectUnknownString      = shift;
  $localKnownStringValue         = shift;
  $localPropertyKnownInteger     = shift;
  $localAspectKnownInteger       = shift;
  $localKnownIntegerValue        = shift;
  $localPropertyKnownBoolean     = shift;
  $localAspectKnownBoolean       = shift;
  $localKnownBooleanValue        = shift;
  $localPropertyKnownEnumeration = shift;
  $localAspectKnownEnumeration   = shift;
  @localKnownEnumerationValue    = @_; # remaining parameters are the array of the test enumeration
  Clear();
}

sub setReport {
  my $status = shift;
  my $testID = shift;
  $report{$testID} = $status?'Pass':'FAIL';
}

sub Clear {
  my $testID = shift;
  if (defined($testID)) {
    $report{$testID} = '????';
  }
  else {
    %report = ();
  }
}

sub getReport {
    Clear();
    Clear('#sec-Evidence');
    Clear('#sec-Evidence-get');
    Clear('#sec-Evidence-exists');
    Clear('#sec-Evidence-put');

    Clear('#sec-PropertyName');
    Clear('#sec-PropertyName-getLocalPropertyName');
    Clear('#sec-PropertyName-getNamespace');

    Clear('#sec-PropertyRef');
    Clear('#sec-PropertyRef-getLocalPropertyName');
    Clear('#sec-PropertyRef-getAspectName');
    Clear('#sec-PropertyRef-getNamespace');

    Clear('#sec-PropertyValue');
    Clear('#sec-PropertyValue-getXXX Double');       # Untested
    Clear('#sec-PropertyValue-getXXX Long');         # Untested
    Clear('#sec-PropertyValue-getXXX String');
    Clear('#sec-PropertyValue-getXXX Boolean');
    Clear('#sec-PropertyValue-getXXX Integer');
    Clear('#sec-PropertyValue-getXXX Enumeration');
    Clear('#sec-PropertyValue-getXXX Float');        # Untested
    Clear('#sec-PropertyValue-exists');
    Clear('#sec-PropertyValue-getPropertyRef');

    Clear('#sec-PropertyValues');
    Clear('#sec-PropertyValues-getAll');
    Clear('#sec-PropertyValues-getValue');

    Clear('#sec-Service');
    Clear('#sec-Service-newHTTPEvidence-1');
    Clear('#sec-Service-newHTTPEvidence-2');
    Clear('#sec-Service-newPropertyName-1');
    Clear('#sec-Service-newPropertyName-2');
    Clear('#sec-Service-newPropertyRef-1');
    Clear('#sec-Service-newPropertyRef-2');
    Clear('#sec-Service-newPropertyRef-3');
    Clear('#sec-Service-getPropertyValues-1');
    Clear('#sec-Service-getPropertyValues-2');
    Clear('#sec-Service-getPropertyValues-3');
    Clear('#sec-Service-getPropertyValues-4');
    Clear('#sec-Service-getPropertyValue-1');
    Clear('#sec-Service-getPropertyValue-2');
    Clear('#sec-Service-getPropertyValue-3');
    Clear('#sec-Service-getPropertyValue-4');
    Clear('#sec-Service-getImplementationVersion');
    Clear('#sec-Service-getDataVersion');
    Clear('#sec-Service-listPropertyRefs');
    Clear('#sec-Service-initialize');
    
    eval { # TRY
      local $SIG{'__DIE__'};
    
      # Service tests included in other tests
      my $factoryCreatedEvidence = 0; #false
      my $factoryCreatedPropertyName = 0; #false
      my $factoryCreatedPropertyRef = 0; #false
      my $obtainedPropertyValueInstance = 0; #false
      my $obtainedPropertyValuesInstance = 0; #false

      # Evidence
      {
        my $putCausedNoException = 0; #false
        my $getReturnedCorrectValue = 0; #false
        my $getDoesNotKnowUnputs = 0; #false
        my $existsWorks = 0; #false

        my $evidence = $s->newHTTPEvidence();
        $factoryCreatedEvidence = (defined($evidence) && $evidence->isa(Evidence));
        $evidence->put('TestHeader', 'TestHeaderValue');
        $putCausedNoException = 1; #true
        $getReturnedCorrectValue = $evidence->get('TestHeader') eq 'TestHeaderValue';
        $existsWorks = $evidence->exists('TestHeader') && !$evidence->exists('UnknownHeader');
        eval {
          $getDoesNotKnowUnputs = (!defined($evidence->get('UnknownHeader')) || '' eq $evidence->get('UnknownHeader'));
        };
        if ($@) {
          $getDoesNotKnowUnputs = 1; #true # Throwing an exception is also a valid response to not finding the header
        }
        
        setReport($factoryCreatedEvidence, '#sec-Service-newHTTPEvidence-1');
        setReport($putCausedNoException,'#sec-Evidence-put'); # Only need to be sure put() didn't cause an exception
        setReport($getReturnedCorrectValue && $getDoesNotKnowUnputs,'#sec-Evidence-get');
        setReport($existsWorks,'#sec-Evidence-exists');
        setReport($putCausedNoException && $getReturnedCorrectValue && $getDoesNotKnowUnputs && $existsWorks,'#sec-Evidence');
      }

      # PropertyName
      {
        my $knowsName = 0; #false
        my $knowsNamespace = 0; #false

        my $propertyName = $s->newPropertyName($localPropertyKnownString, $vocabularyIRI);
        $factoryCreatedPropertyName = 1; #true
        $knowsName = $localPropertyKnownString eq $propertyName->getLocalPropertyName();
        $knowsNamespace = $vocabularyIRI eq $propertyName->getNamespace();

        setReport($factoryCreatedPropertyName,'#sec-Service-newPropertyName-2');
        setReport($knowsName, '#sec-PropertyName-getLocalPropertyName');
        setReport($knowsNamespace, '#sec-PropertyName-getNamespace');
        setReport($knowsName && $knowsNamespace, '#sec-PropertyName');
      }

      # PropertyRef
      {
        my $knowsName = 0; #false
        my $knowsNamespace = 0; #false
        my $knowsAspect = 0; #false

        my $propertyRef = $s->newPropertyRef($s->newPropertyName($localPropertyKnownString, $vocabularyIRI), $localAspectKnownString);
        $factoryCreatedPropertyRef = defined($propertyRef) && $propertyRef->isa(PropertyRef);
        $knowsName = $localPropertyKnownString eq $propertyRef->getLocalPropertyName();
        $knowsAspect = $localAspectKnownString eq $propertyRef->getAspectName();
        $knowsNamespace = $vocabularyIRI eq $propertyRef->getNamespace();

        setReport($factoryCreatedPropertyRef, '#sec-Service-newPropertyRef-3');
        setReport($knowsName, '#sec-PropertyRef-getLocalPropertyName');
        setReport($knowsAspect, '#sec-PropertyRef-getAspectName');
        setReport($knowsNamespace, '#sec-PropertyRef-getNamespace');
        setReport($knowsName && $knowsAspect && $knowsNamespace,'#sec-PropertyRef');
      }

      # PropertyValue
      {
        my $obtainedExistingValue = 0; #false
        my $detectedUnknownValue = 0; #false
        my $gotSomeStringRepresentation = 0; #false
        my $gotPropertyRef = 0; #false
        my $gotCorrectString = 0; #false
        my $gotCorrectInteger = 0; #false
        my $gotCorrectBoolean = 0; #false
        my $gotCorrectEnumeration = 0; #false

        my $propertyValue = $s->getPropertyValue($e, $localPropertyKnownString, $localAspectKnownString, $vocabularyIRI);
        $obtainedPropertyValueInstance = defined($propertyValue) && $propertyValue->isa(PropertyValue);
        $obtainedExistingValue = $propertyValue->exists();
        eval { # TRY
          my $propertyValueBad = $s->getPropertyValue($e, $localPropertyUnknownString, $localAspectUnknownString, $vocabularyIRI);
        };
        if ($@) {
          if ($@->isa(NameException)) {
            $detectedUnknownValue = 1; #true # Implementations are free to use alternative codes, so just check for the exception
          }
          else {
            die $@;
          }
        }
        my $stringRepresentation = $propertyValue->getString();
        $gotSomeStringRepresentation = defined($stringRepresentation) && $stringRepresentation ne '';
        $gotCorrectString = defined($stringRepresentation) && $stringRepresentation eq $localKnownStringValue;
        my $propertyRef = $propertyValue->getPropertyRef();
        $gotPropertyRef = (
            defined($propertyRef) && $propertyRef->isa(PropertyRef) &&
            $localPropertyKnownString eq $propertyRef->getLocalPropertyName() &&
            $localAspectKnownString eq $propertyRef->getAspectName() &&
            $vocabularyIRI eq $propertyRef->getNamespace()
          );
        my $propertyValueInteger = $s->getPropertyValue($e, $localPropertyKnownInteger, $localAspectKnownInteger, $vocabularyIRI);
        $gotCorrectInteger = ($propertyValueInteger->getInteger() == $localKnownIntegerValue);
        my $propertyValueBoolean = $s->getPropertyValue($e, $localPropertyKnownBoolean, $localAspectKnownBoolean, $vocabularyIRI);
        $gotCorrectBoolean = ($propertyValueBoolean->getBoolean() == $localKnownBooleanValue);
        my $propertyValueEnumeration = $s->getPropertyValue($e, $localPropertyKnownEnumeration, $localAspectKnownEnumeration, $vocabularyIRI);
        my @enumeratedValue = $propertyValueEnumeration->getEnumeration();
        $gotCorrectEnumeration = (scalar(@enumeratedValue) == scalar(@localKnownEnumerationValue));
        if ($gotCorrectEnumeration) {
          for (my $i = 0; $i < scalar(@enumeratedValue); $i++) {
            # Warning: the order of values in the enumeration is prescribed for this test,
            # although nothing has been said regarding the significance of any such ordering.
            $gotCorrectEnumeration = $gotCorrectEnumeration && $localKnownEnumerationValue[$i] eq $enumeratedValue[$i];
          }
        }

        # not tested: #sec-PropertyValue-getXXX Double
        # not tested: #sec-PropertyValue-getXXX Long
        # not tested: #sec-PropertyValue-getXXX Float
        setReport($obtainedExistingValue && $gotCorrectString && $gotSomeStringRepresentation, '#sec-PropertyValue-getXXX String');
        setReport($gotCorrectInteger, '#sec-PropertyValue-getXXX Integer');
        setReport($gotCorrectBoolean, '#sec-PropertyValue-getXXX Boolean');
        setReport($gotCorrectEnumeration, '#sec-PropertyValue-getXXX Enumeration');
        setReport($obtainedExistingValue && detectedUnknownValue,'#sec-PropertyValue-exists');
        setReport($gotPropertyRef,'#sec-PropertyValue-getPropertyRef');
        setReport($gotCorrectInteger && $gotCorrectBoolean && $gotCorrectEnumeration && $gotPropertyRef, '#sec-PropertyValue');
        setReport($obtainedPropertyValueInstance, '#sec-Service-getPropertyValue-4');
      }
      
      # PropertyValues
      {
        my $gotCorrectArray = 0; #false
        my $gotCorrectValue = 0; #false

        my @propertyRefs = [
          $s->newPropertyRef($s->newPropertyName($localPropertyKnownString, $vocabularyIRI), $localAspectKnownString),
          $s->newPropertyRef($s->newPropertyName($localPropertyKnownInteger, $vocabularyIRI), $localAspectKnownInteger),
          $s->newPropertyRef($s->newPropertyName($localPropertyKnownBoolean, $vocabularyIRI), $localAspectKnownBoolean)
        ];
        my $propertyValues = $s->getPropertyValues($e, @propertyRefs);
        $obtainedPropertyValuesInstance = (defined($propertyValues) && $propertyValues->isa(PropertyValues));
        my @propertyValueArray = $propertyValues->getAll();
        my $retrievedString = undef;
        my $retrievedInteger = undef;
        my $retrievedBoolean = undef;
        for (my $i = 0; $i < 3; $i++) {
          my $lpn = $propertyValueArray[$i]->getPropertyRef()->getLocalPropertyName();
          if    ($lpn eq 'vendor')        { $retrievedString  = $propertyValueArray[$i]->getString();  }
          elsif ($lpn eq 'displayWidth')  { $retrievedInteger = $propertyValueArray[$i]->getInteger(); }
          elsif ($lpn eq 'cookieSupport') { $retrievedBoolean = $propertyValueArray[$i]->getBoolean(); }
        }
        $gotCorrectArray = (
            defined(@propertyValueArray) && scalar(@propertyValueArray) == 3 &&
            $localKnownStringValue eq $retrievedString &&
            $localKnownIntegerValue == $retrievedInteger &&
            $localKnownBooleanValue == $retrievedBoolean
            );
        my $innerPropertyRef = $s->newPropertyRef(
              $s->newPropertyName($localPropertyKnownInteger, $vocabularyIRI), $localAspectKnownInteger
            );
        my $innerPropertyValue = $propertyValues->getValue($innerPropertyRef);
        $gotCorrectValue = ($innerPropertyValue->getInteger() == $localKnownIntegerValue);

        setReport($gotCorrectArray, '#sec-PropertyValues-getAll');
        setReport($gotCorrectValue, '#sec-PropertyValues-getValue');
        setReport($gotCorrectArray && $gotCorrectValue, '#sec-PropertyValues');
        setReport($obtainedPropertyValuesInstance, '#sec-Service-getPropertyValues-4');
      }

      # Service
      # Tests cover features not already covered by previous tests
      {
        my $gotListOfProperties = 0; #false
        my $evidenceViaMapOK = 0; #false
        my $propNameDefaultIRIOK = 0; #false
        my $propRefStringOK = 0; #false
        my $propRefPropNameOK = 0; #false
        my $propValuesEvidenceOK = 0; #false
        my $propValuesEvidenceAspectOK = 0; #false
        my $propValuesEvidenceAspectVocabOK = 0; #false
        my $propValueEvidencePropRefOK = 0; #false
        my $propValueEvidencePropNameOK = 0; #false
        my $propValueEvidenceNameOK = 0; #false

        my @propertyRefArray = @{$s->listPropertyRefs()};
        if (defined(@propertyRefArray) && scalar(@propertyRefArray) == $totalPropertRefsInService) {
          $gotListOfProperties = 1; #true
        }

        # #sec-Service-newHTTPEvidence-2
        my %hmap = ();
        $hmap{'X-Header1'} = 'HeaderValue1';
        $hmap{'X-Header2'} = 'HeaderValue2';
        $hmap{'X-Header1'} = 'HeaderValue3';
        my $e2 = $s->newHTTPEvidence(\%hmap);
        if ('HeaderValue3' eq $e2->get('X-Header1') && 'HeaderValue2' eq $e2->get('X-Header2')) {
          $evidenceViaMapOK = $e2->exists('X-Header1') && $e2->exists('X-Header2') && !$e2->exists('X-Header3');
        }

        my $pn = $s->newPropertyName($localPropertyKnownString, $vocabularyIRI);
        my $pr = $s->newPropertyRef($pn, $localAspectKnownString);

        # #sec-Service-newPropertyName-1
        # Test assumes that default vocabulary was used in the class constructor.
        my $pn1 = $s->newPropertyName($localPropertyKnownString);
        $propNameDefaultIRIOK = $pn1->getLocalPropertyName() eq $localPropertyKnownString && $pn1->getNamespace() eq $vocabularyIRI;

        # #sec-Service-newPropertyRef-1
        # Test assumes that default vocabulary was used in the class constructor.
        my $pr1 = $s->newPropertyRef($localPropertyKnownString);
        $propRefStringOK = $pr1->getLocalPropertyName() eq $localPropertyKnownString &&
          $pr1->getNamespace() eq $vocabularyIRI && $pr1->getAspectName() eq $PropertyRef::NULL_ASPECT;

        # #sec-Service-newPropertyRef-2
        my $pr2 = $s->newPropertyRef($pn1);
        $propRefPropNameOK = $pr2->getLocalPropertyName() eq $localPropertyKnownString &&
          $pr2->getNamespace() eq $vocabularyIRI && $pr2->getAspectName() eq $PropertyRef::NULL_ASPECT;
          
        # #sec-Service-getPropertyValues-1
        my $pvs1 = $s->getPropertyValues($e);
        $propValuesEvidenceOK = $pvs1->getValue($pr)->getString() eq $localKnownStringValue;
        
        # #sec-Service-getPropertyValues-2
        my $pvs2 = $s->getPropertyValues($e, $localAspectKnownString);
        $propValuesEvidenceAspectOK = $pvs2->getValue($pr)->getString() eq $localKnownStringValue;
        
        # #sec-Service-getPropertyValues-3
        my $pvs3 = $s->getPropertyValues($e, $localAspectKnownString, $vocabularyIRI);
        $propValuesEvidenceAspectVocabOK = $pvs3->getValue($pr)->getString() eq $localKnownStringValue;

        # #sec-Service-getPropertyValue-1
        my $pv1 = $s->getPropertyValue($e, $pr);
        $propValueEvidencePropRefOK = $pv1->getString() eq $localKnownStringValue;

        # #sec-Service-getPropertyValue-2
        my $pv2 = $s->getPropertyValue($e, $pn);
        $propValueEvidencePropNameOK = $pv2->getString() eq $localKnownStringValue;

        # #sec-Service-getPropertyValue-3
        my $pv3 = $s->getPropertyValue($e, $localPropertyKnownString);
        $propValueEvidenceNameOK = $pv3->getString() eq $localKnownStringValue;

        setReport($evidenceViaMapOK,'#sec-Service-newHTTPEvidence-2');
        setReport($propNameDefaultIRIOK,'#sec-Service-newPropertyName-1');
        setReport($propRefStringOK,'#sec-Service-newPropertyRef-1');
        setReport($propRefPropNameOK,'#sec-Service-newPropertyRef-2');
        setReport($propValuesEvidenceOK,'#sec-Service-getPropertyValues-1');
        setReport($propValuesEvidenceAspectOK,'#sec-Service-getPropertyValues-2');
        setReport($propValuesEvidenceAspectVocabOK,'#sec-Service-getPropertyValues-3');
        setReport($propValueEvidencePropRefOK,'#sec-Service-getPropertyValue-1');
        setReport($propValueEvidencePropNameOK,'#sec-Service-getPropertyValue-2');
        setReport($propValueEvidenceNameOK,'#sec-Service-getPropertyValue-3');
        setReport(defined($s->getImplementationVersion()),'#sec-Service-getImplementationVersion'); # Just has to work without causing an exception
        setReport(defined($s->getDataVersion()),'#sec-Service-getDataVersion'); # Just has to work without causing an exception
        setReport($gotListOfProperties,'#sec-Service-listPropertyRefs');
        setReport(1,'#sec-Service-initialize'); # 1=true  Just has to work without causing an exception
        setReport(
          $factoryCreatedEvidence && $factoryCreatedPropertyName && $factoryCreatedPropertyRef &&
          $obtainedPropertyValueInstance && $obtainedPropertyValuesInstance &&
          $evidenceViaMapOK && $propNameDefaultIRIOK && $propRefStringOK && $propRefPropNameOK &&
          $propValuesEvidenceOK && $propValuesEvidenceAspectOK && $propValuesEvidenceAspectVocabOK &&
          $propValueEvidencePropRefOK && $propValueEvidencePropNameOK &&
          $propValueEvidenceNameOK && $gotListOfProperties &&
          defined($s->getImplementationVersion()) && defined($s->getDataVersion())
          ,'#sec-Service');
      }
    
    };
    if ($@) { # exception trap
      if (!($@->isa('BaseException'))) {
        print "Unknown exception: $@\n";
      }
      die $@;
    }
    return %report;
}

__END__;

#####################################################################################################
## Output                                                                                           #
## When executed, the program generates the following output (except for the 0x... memory ref):     #
##                                                                                                  #
## Using API (1.1.0 http://www.w3.org/TR/2008/WD-DDR-Simple-API-20080404/) with Repository (080715) #
## Evidence from the delivery context:                                                              #
##   User-Agent: Mozthing1.2e (X11; en-US; v12)                                                     #
##   Accept:text/html, image/png, image/jpeg, image/gif, image/x-xbitmap, */*                       #
## 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                                                                  #
## Getting all values for this context:                                                             #
##   displayHeight is 800                                                                           #
##   imageFormatSupport is ARRAY(0x1ca8a0c)                                                         #
## Getting image format support for this context:                                                   #
## Getting information via Simple API methods only:                                                 #
##   Device Height = 800                                                                            #
## Getting information via implementation specific constructor:                                     #
##   Device Height = 800                                                                            #
## Getting information via PropertyRef:                                                             #
##   Browser height = 788                                                                           #
## Getting information via custom convenience methods:                                              #
##   Device Height = 800                                                                            #
##   Device Width  = 000000                                                                         #
##   Image formats = gif89a,jpeg,png                                                                #
## BEGIN Standard API tests ------------------------------------------                              #
##   #sec-Evidence = Pass                                                                           #
##   #sec-Evidence-exists = Pass                                                                    #
##   #sec-Evidence-get = Pass                                                                       #
##   #sec-Evidence-put = Pass                                                                       #
##   #sec-PropertyName = Pass                                                                       #
##   #sec-PropertyName-getLocalPropertyName = Pass                                                  #
##   #sec-PropertyName-getNamespace = Pass                                                          #
##   #sec-PropertyRef = Pass                                                                        #
##   #sec-PropertyRef-getAspectName = Pass                                                          #
##   #sec-PropertyRef-getLocalPropertyName = Pass                                                   #
##   #sec-PropertyRef-getNamespace = Pass                                                           #
##   #sec-PropertyValue = Pass                                                                      #
##   #sec-PropertyValue-exists = Pass                                                               #
##   #sec-PropertyValue-getPropertyRef = Pass                                                       #
##   #sec-PropertyValue-getXXX Boolean = Pass                                                       #
##   #sec-PropertyValue-getXXX Double = ????                                                        #
##   #sec-PropertyValue-getXXX Enumeration = Pass                                                   #
##   #sec-PropertyValue-getXXX Float = ????                                                         #
##   #sec-PropertyValue-getXXX Integer = Pass                                                       #
##   #sec-PropertyValue-getXXX Long = ????                                                          #
##   #sec-PropertyValue-getXXX String = Pass                                                        #
##   #sec-PropertyValues = Pass                                                                     #
##   #sec-PropertyValues-getAll = Pass                                                              #
##   #sec-PropertyValues-getValue = Pass                                                            #
##   #sec-Service = Pass                                                                            #
##   #sec-Service-getDataVersion = Pass                                                             #
##   #sec-Service-getImplementationVersion = Pass                                                   #
##   #sec-Service-getPropertyValue-1 = Pass                                                         #
##   #sec-Service-getPropertyValue-2 = Pass                                                         #
##   #sec-Service-getPropertyValue-3 = Pass                                                         #
##   #sec-Service-getPropertyValue-4 = Pass                                                         #
##   #sec-Service-getPropertyValues-1 = Pass                                                        #
##   #sec-Service-getPropertyValues-2 = Pass                                                        #
##   #sec-Service-getPropertyValues-3 = Pass                                                        #
##   #sec-Service-getPropertyValues-4 = Pass                                                        #
##   #sec-Service-initialize = Pass                                                                 #
##   #sec-Service-listPropertyRefs = Pass                                                           #
##   #sec-Service-newHTTPEvidence-1 = Pass                                                          #
##   #sec-Service-newHTTPEvidence-2 = Pass                                                          #
##   #sec-Service-newPropertyName-1 = Pass                                                          #
##   #sec-Service-newPropertyName-2 = Pass                                                          #
##   #sec-Service-newPropertyRef-1 = Pass                                                           #
##   #sec-Service-newPropertyRef-2 = Pass                                                           #
##   #sec-Service-newPropertyRef-3 = Pass                                                           #
## END   Standard API tests ------------------------------------------                              #
##                                                                                                  #
#####################################################################################################