| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package WQS::SPARQL::Result; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 4 |  |  | 4 |  | 325004 | use strict; | 
|  | 4 |  |  |  |  | 38 |  | 
|  | 4 |  |  |  |  | 110 |  | 
| 4 | 4 |  |  | 4 |  | 22 | use warnings; | 
|  | 4 |  |  |  |  | 7 |  | 
|  | 4 |  |  |  |  | 107 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 | 4 |  |  | 4 |  | 1470 | use Class::Utils qw(set_params); | 
|  | 4 |  |  |  |  | 38806 |  | 
|  | 4 |  |  |  |  | 112 |  | 
| 7 | 4 |  |  | 4 |  | 200 | use Error::Pure qw(err); | 
|  | 4 |  |  |  |  | 8 |  | 
|  | 4 |  |  |  |  | 143 |  | 
| 8 | 4 |  |  | 4 |  | 2778 | use URI; | 
|  | 4 |  |  |  |  | 25256 |  | 
|  | 4 |  |  |  |  | 1198 |  | 
| 9 |  |  |  |  |  |  |  | 
| 10 |  |  |  |  |  |  | our $VERSION = 0.02; | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | sub new { | 
| 13 | 3 |  |  | 3 | 1 | 1421 | my ($class, @params) = @_; | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | # Create object. | 
| 16 | 3 |  |  |  |  | 10 | my $self = bless {}, $class; | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  | # Verbose mode. | 
| 19 | 3 |  |  |  |  | 15 | $self->{'verbose'} = 0; | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | # Process parameters. | 
| 22 | 3 |  |  |  |  | 16 | set_params($self, @params); | 
| 23 |  |  |  |  |  |  |  | 
| 24 | 3 |  |  |  |  | 31 | return $self; | 
| 25 |  |  |  |  |  |  | } | 
| 26 |  |  |  |  |  |  |  | 
| 27 |  |  |  |  |  |  | sub result { | 
| 28 | 2 |  |  | 2 | 1 | 505 | my ($self, $result_hr, $vars_ar) = @_; | 
| 29 |  |  |  |  |  |  |  | 
| 30 | 2 | 50 |  |  |  | 6 | if (! defined $vars_ar) { | 
| 31 | 2 |  |  |  |  | 7 | $vars_ar = $result_hr->{'head'}->{'vars'}; | 
| 32 |  |  |  |  |  |  | } | 
| 33 |  |  |  |  |  |  |  | 
| 34 | 2 | 50 |  |  |  | 8 | if ($self->{'verbose'}) { | 
| 35 | 0 |  |  |  |  | 0 | require Data::Printer; | 
| 36 | 0 |  |  |  |  | 0 | Data::Printer::p($result_hr); | 
| 37 |  |  |  |  |  |  | } | 
| 38 |  |  |  |  |  |  |  | 
| 39 | 2 |  |  |  |  | 3 | my @res; | 
| 40 | 2 | 50 |  |  |  | 7 | if (exists $result_hr->{'results'}->{'bindings'}) { | 
| 41 | 2 |  |  |  |  | 3 | my @items = @{$result_hr->{'results'}->{'bindings'}}; | 
|  | 2 |  |  |  |  | 8 |  | 
| 42 | 2 |  |  |  |  | 5 | foreach my $item_hr (@items) { | 
| 43 | 2 |  |  |  |  | 3 | my $result_hr; | 
| 44 | 2 |  |  |  |  | 3 | foreach my $var (@{$vars_ar}) { | 
|  | 2 |  |  |  |  | 4 |  | 
| 45 | 2 | 50 |  |  |  | 6 | if (! exists $item_hr->{$var}) { | 
| 46 | 0 |  |  |  |  | 0 | next; | 
| 47 |  |  |  |  |  |  | } | 
| 48 |  |  |  |  |  |  |  | 
| 49 |  |  |  |  |  |  | # TODO Implement other values | 
| 50 |  |  |  |  |  |  |  | 
| 51 |  |  |  |  |  |  | # QID. | 
| 52 |  |  |  |  |  |  | # TODO Check real QID, could be another uri. | 
| 53 | 2 | 50 |  |  |  | 6 | if ($item_hr->{$var}->{'type'} eq 'uri') { | 
| 54 | 2 |  |  |  |  | 10 | my $qid_uri = URI->new($item_hr->{$var}->{'value'}); | 
| 55 | 2 |  |  |  |  | 8515 | my @segs = $qid_uri->path_segments; | 
| 56 | 2 |  |  |  |  | 160 | $result_hr->{$var} = $segs[-1]; | 
| 57 |  |  |  |  |  |  | } | 
| 58 |  |  |  |  |  |  | } | 
| 59 | 2 |  |  |  |  | 6 | push @res, $result_hr; | 
| 60 |  |  |  |  |  |  | } | 
| 61 |  |  |  |  |  |  | } | 
| 62 |  |  |  |  |  |  |  | 
| 63 | 2 |  |  |  |  | 14 | return @res; | 
| 64 |  |  |  |  |  |  | } | 
| 65 |  |  |  |  |  |  |  | 
| 66 |  |  |  |  |  |  | 1; | 
| 67 |  |  |  |  |  |  |  | 
| 68 |  |  |  |  |  |  | __END__ |