package Ekahau::Response; use Ekahau::Base; our $VERSION=Ekahau::Base::VERSION; # Written by Scott Gifford # Copyright (C) 2004 The Regents of the University of Michigan. # See the file LICENSE included with the distribution for license # information. use strict; use warnings; use bytes; =head1 NAME Ekahau::Response - Response from an Ekahau server =head1 SYNOPSIS Provides a straightforward encapsulation of the response objects returned by the Ekahau Positioning Engine. This is the base class for the specific responses; in general you will want to use one of them. =head1 DESCRIPTION This class takes care of parsing responses from the Ekahau server into their individual components. The responses returned by Ekahau are a sort of half-assed XML. They look superficially like XML, but not enough that they can be parsed by an XML parser. Instead, this module takes a simplistic approach to parsing them. The exact rules for parsing aren't clear from the documentation, so this parsing may not be correct in all circumstances, but we have not observed any misparsing with the current code. The response is parsed into the hash reference that comprises this object. It's parsed like this: <#tag cmd args[0] args[1] ... params{key1}=value1 params{key2}=value2 SEPARATOR1 params{SEPERATOR1}[0]{key3}=value3 params{SEPERATOR1}[0]{key4}=value4 SEPARATOR1 params{SEPERATOR1}[1]{key3}=value3 params{SEPERATOR1}[1]{key4}=value4 > Here are some examples. First, <#LOC LOCATION_ESTIMATE 4 accurateX=1427.09 accurateY=2141.73 accurateTime=1117138297067 accurateContextId=22940 latestX=1429.14 latestY=2140.60 latestTime=1117138301067 latestContextId=22940 speed=0.09101 heading=5.78188 > parses to: { 'tag' => 'LOC', 'cmd' => 'LOCATION_ESTIMATE', 'args' => [ '4' ], 'params' => { 'latestX' => '1429.14', 'accurateY' => '2141.73', 'heading' => '5.78188', 'accurateTime' => '1117138297067', 'latestY' => '2140.60', 'accurateContextId' => '22940', 'speed' => '0.09101', 'accurateX' => '1427.09', 'latestTime' => '1117138301067', 'latestContextId' => '22940' }, } Second, <#AREA AREA_ESTIMATE 4 AREA name=2425 probability=1.000 contextId=22940 polygon=1396;1396;1554;1554;1394;1396&1964;2200;2200;1964;1964;1964; AREA name=2431 probability=0.000 contextId=22940 polygon=1560;1559;1682;1680;1804;1804;1559;1560&1968;2197;2196;2153;2154;1966;1966;1968; > parses to: { 'tag' => 'AREA', 'cmd' => 'AREA_ESTIMATE', 'args' => [ '4' ], 'params' => { 'AREA' => [ { 'contextId' => '22940', 'probability' => '1.000', 'name' => '2425', 'polygon' => '1396;1396;1554;1554;1394;1396&1964;2200;2200;1964;1964;1964;' }, { 'contextId' => '22940', 'probability' => '0.000', 'name' => '2431', 'polygon' => '1560;1559;1682;1680;1804;1804;1559;1560&1968;2197;2196;2153;2154;1966;1966;1968;' } ] } } Finally, this response: <#2376 DEVICE_LIST 1 2 3 > parses to this: { 'tag' => '2376', 'cmd' => 'DEVICE_LIST', 'args' => [], 'params' => { '3' => [ {} ], '2' => [ {} ], '1' => [ {} ], } } =cut use Ekahau::Response::DeviceList; use Ekahau::Response::DeviceProperties; use Ekahau::Response::Error; use Ekahau::Response::LocationEstimate; use Ekahau::Response::LocationContext; use Ekahau::Response::AreaEstimate; use Ekahau::Response::AreaList; use Ekahau::Response::StopLocationTrackOK; use Ekahau::Response::StopAreaTrackOK; use Ekahau::Response::MapImage; use constant RESPONSEBASE => 'Ekahau::Response::'; our %CMDCLASS = ( DEVICE_LIST => RESPONSEBASE.'DeviceList', DEVICE_PROPERTIES => RESPONSEBASE.'DeviceProperties', LOCATION_ESTIMATE => RESPONSEBASE.'LocationEstimate', CONTEXT => RESPONSEBASE.'LocationContext', AREA_ESTIMATE => RESPONSEBASE.'AreaEstimate', STOP_LOCATION_TRACK_OK => RESPONSEBASE.'StopLocationTrackOK', STOP_AREA_TRACK_OK => RESPONSEBASE.'StopAreaTrackOK', AREALIST => RESPONSEBASE.'AreaList', MAP => RESPONSEBASE.'MapImage', ); use constant ERROR_CLASS => 'Ekahau::Response::Error'; =head2 Constructors =head3 new ( %params ) Creates a new empty object. The only parameter recognized is C, which sets the tag property for the response. =cut sub new { my $class = shift; my(%p) = @_; my $self = {}; if ($p{tag}) { $self->{tag} = $p{tag}; } bless $self, $class; } # Internal method sub init { # Do nothing } =head3 parsenew ( $response_str ) Parse a response string into an object. The results are undefined if C<$response_str> is not a valid Ekahau response. =cut sub parsenew { my $class = shift; my $self = $class->new(); $self->parse(@_); warn "parsenew: cmd is '$self->{cmd}'\n" if ($ENV{VERBOSE}); if (my $newclass = $CMDCLASS{$self->{cmd}}) { bless $self,$newclass; $self->init; } elsif ($self->{cmd} =~ /^(?:MALFORMED_REQUEST|.*_NOT_FOUND|FAILURE|.*_FAILED|.*_PROBLEM)/) { bless $self,ERROR_CLASS; $self->init; } $self; } =head2 Methods =head3 parse ( $response_str ) Populate the fields of an object with the ones in C<$response_str>, overwriting any existing values. The results are undefined if C<$response_str> is not a valid Ekahau response. =cut sub parse { my $self = shift; my($r) = @_; my $data; $r =~ s/^\s+//; $r =~ s/\s+$//; $self->{string} = $r; # Look for a tag if ($r =~ s/^\s*<(\#\w*?\s)?\s*// and $1) { # Preserve taintedness with substr(X,0,0) chop($self->{tag} = substr($1,1).substr($self->{string},0,0)) } # Does this contain sized data? if ($r =~ /\x0asize=(\d+).*?\x0adata=/sg) { my $data_len = $1; my $data_pos = pos($r); $data = substr($r,$data_pos,$data_len,''); # Remove the "data=" substr($r,-5,5,''); } # Remove trailing angle bracket and whitespace $r =~ s/\s*>\s*$//; # Split the response into lines my @lines = split(/(?{cmd} = shift @firstline; $self->{args} = [map { s/^\"//; s/\"$//; $_ } @firstline]; $self->{params}={}; # Are there any arguments that are really parameters? foreach my $i (0..$#{$self->{args}}) { if ($self->{args}[$i] =~ /^(\w+)=(.*)$/) { # Use substr to keep taintedness $self->{params}{$1}=$2.substr($self->{args}[$i],0,0); # Remove argument splice(@{$self->{args}},$i,1,()); } } # Parameters on other lines my $datahash = $self->{params}; foreach my $l (@lines) { my $keep_taintedness = substr($l,0,0); $l =~ s/\\(<|>|\x0d\x0a)/$1/g; if ($l =~ /^([\w.\-]+?)=(.*)$/) { # Using this as a hash key will implictly untaint it, # so require that values be "word characters". my $val = $2.$keep_taintedness; $datahash->{$1}=$val; } else { $datahash = {}; push(@{$self->{params}{$l}},$datahash); } } if (defined($data)) { $self->{params}{data}=$data; } # Special case: copy area up to main parameters, for backwards # compatibility. if ($self->{params}{AREA} and $self->{params}{AREA}[0]) { while(my($k,$v)=each(%{$self->{params}{AREA}[0]})) { $self->{params}{$k} = $v; } } $self; } =head3 get_props ( @prop_names ) Returns a hash containing the values for the list of properties in C<@prop_names>. If C<@prop_names> is empty, all properties will be returned. =cut sub get_props { my $self = shift; if (!@_) { @_ = keys %{$self->{params}} }; return map { $_ => $self->{params}{$_} } @_; } =head3 get_prop ( $prop_name ) Returns the value for one of this object's properties, specified by C<$prop_name>. If no property named C<$prop_name> exists, C is returned. =cut sub get_prop { my $self = shift; my $prop = $_[0]; return $self->{params}{($prop)}; } =head3 error ( ) Returns true if this response is an L object, else returns false. =cut sub error { 0; } =head3 eventname ( ) Returns the name of this event in the same format used by L. =cut sub eventname { my $self = shift; $self->error ? 'ERROR' : uc $self->{cmd}; } =head3 type ( ) Returns the string I, to identify the type of this object, and that no more specific information is available. =cut sub type { 'Response'; } =head3 tostring ( ) Return a string representation of the object. This is reconstructed from the object's properties, and so may not be identical to the string which was parsed to create it. =cut sub tostring { my $self = shift; my $str = "<"; if (defined($self->{tag})) { $str .= "#$self->{tag} " }; $str .= $self->{cmd}; if (@{$self->{args}}) { $str .= " ".join(" ",@{$self->{args}}); } if ($self->{params}) { $str .= "\x0d\x0a"; foreach my $var (keys %{$self->{params}}) { my $val = $self->{params}{$var}; if (defined($val)) { $val =~ s/(<|>|\x0d\x0a)/\\$1/g; $str .= "$var=$val\x0d\x0a"; } else { $str .= "$var\x0d\x0a"; } } } $str .= ">\x0d\x0a"; return $str; } 1; =head1 AUTHOR Scott Gifford Egifford@umich.eduE, Esgifford@suspectclass.comE Copyright (C) 2005 The Regents of the University of Michigan. See the file LICENSE included with the distribution for license information. =head1 SEE ALSO L, L, L, L, L, L, L, L, L, L, L. =cut 1;