From 55a90a3f1eedba0e3fd04cb667b02abd097a28d7 Mon Sep 17 00:00:00 2001 From: Pavel Kolesnikov Date: Tue, 15 Jan 2013 17:18:35 -0800 Subject: [PATCH 1/3] Mandatory user filters support + utility functions Usage: $gdc->login($login, $passwd) or die "Unable to authenticate\n"; my $resp = $gdc->assign_user_filter ( $project, $username, $label, @values); --- lib/WWW/GoodData.pm | 164 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 164 insertions(+) diff --git a/lib/WWW/GoodData.pm b/lib/WWW/GoodData.pm index b78bbeb..c64dc62 100644 --- a/lib/WWW/GoodData.pm +++ b/lib/WWW/GoodData.pm @@ -27,6 +27,7 @@ use warnings; use WWW::GoodData::Agent; use JSON; use URI; +use URI::Escape; our $root = new URI ('https://secure.gooddata.com/gdc'); @@ -843,6 +844,169 @@ sub create_report_definition )->{uri}; } +=itemB PROJECT_URI TITLE ATTRIBUTE_URI VALUE_URIS + +Create an user filter object representing the idea of +the attribute being equal to one of given values + +=cut + +sub create_user_filter_object +{ + my $self = shift; + my $project = shift; + my $title = shift; + my $attr_uri = shift; + my @value_uris = @_; + + my $in_expr = join(', ', map { "[$_]" } @value_uris); + my $uri = $self->get_uri (new URI ($project), + { category => 'self', type => 'project' }, # Validate it's a project + qw/metadata/, { category => 'obj'}); + return $self->{agent}->post ($uri, { + userFilter => { + content => { + expression => "[$attr_uri] IN ($in_expr)" + }, + meta => { + category => "userFilter", + title => "$title" + } + } + }); +} + +=itemB PROJECT_URI LOGIN LABEL VALUES + +Create an "attribute IN (values)" filtering expression and +associate it with a project member specified by login name. + +The attribute is specified by the label identifier and the +values by uploaded values of the selected label (a.k.a the +attributeDisplayForm). + +=cut + +sub assign_user_filter +{ + my $self = shift; + my $project = shift; + my $login = shift; + my $label_idtf = shift; + my @values = @_; + + my $user_uri = $self->find_member_by_login ($project, $login); + my $label = $self->{agent}->get ($self->identifier_to_uri ($project, $label_idtf)); + my $attr_uri = $label->{attributeDisplayForm}->{content}->{formOf}; + my @value_uris = map { $self->value_to_uri ($project, $label, $_) } @values; + my $filter_title = "$label_idtf IN (" . join(', ', map { "'$_'" } @values); + my $filter_resp = $self->create_user_filter_object ($project, $filter_title, $attr_uri, @value_uris); + return $self->assign_user_filter_objects ($project, $user_uri, $filter_resp->{uri}); +} + +=itemB PROJECT_URI USER_URI FILTER_URI + +Associate the given filter object with a project member + +=cut + +sub assign_user_filter_objects +{ + my $self = shift; + my $project = shift; + my $user_uri = shift; + my $filter_uri = shift; + + my $uri = $self->get_uri (new URI ($project), + { category => 'self', type => 'project' }, # Validate it's a project + qw/metadata/, { category => 'userfilters'}); + return $self->{agent}->post ($uri, { + userFilters => { + items => [ + { + user => $user_uri, + userFilters => [ $filter_uri ] + } + ] + } + }); +} + +=itemB PROJECT_URI LOGIN + +Find a project member by a login name. + +Returns the profile URI. + +=cut + +sub find_member_by_login +{ + my $self = shift; + my $project = shift; + my $login = shift; + + my $users_uri = $self->get_uri (new URI ($project), { category => 'users' }); + my @users = $self->{agent}->get ($users_uri)->{users}; + foreach my $u (@{$users[0]}) { + return $u->{user}->{links}->{self} if $u->{user}->{content}->{login} eq $login; + } + die "User $login is not a member of project $project"; +} + +=itemB PROJECT_URI IDENTIFIER + +Converts a project-wide unique object identifier into an object URI + +=cut + +sub identifier_to_uri +{ + my $self = shift; + my $project = shift; + my $identifier = shift; + + my $uri = $self->get_uri (new URI ($project), + { category => 'self', type => 'project' }, # Validate it's a project + qw/metadata/, { category => 'instance-identifiers'}); + my $resp = $self->{agent}->post ($uri, { 'identifierToUri' => [ $identifier ] }); + return undef unless $resp->{identifiers}; + return $resp->{identifiers}[0]->{uri}; +} + +=item B LABEL PROJECT_URI VALUE + +Converts the value of a label (passed as an object or specified by +an identifier) into GoodData's internal attribute element URI. + +=cut + +sub value_to_uri +{ + my $self = shift; + my $project = shift; + my $label = shift; + my $value = shift; + + unless (ref $label) { + my $label_uri = $self->identifier_to_uri ($project, $label) + or die "No object with identifier '$label' found"; + $label = $self->{agent}->get ($label_uri); + } + my $idtf = $label->{attributeDisplayForm}->{meta}->{identifier}; + my $value_uri = $label->{attributeDisplayForm}->{links}->{elements} . '?filter=' . uri_escape($value); + my $resp = $self->{agent}->get ($value_uri); + my $elements = $resp->{attributeElements}->{elements}; + + if ($elements) { + foreach my $e (@$elements) { + return $e->{uri} if $e->{title} eq $value; + } + } + die "Value '$value' not found for label '$idtf'"; +} + + =item B Log out the session with B unless not logged in. From eb27af97d2e0b06c5fef07466d96c5868cce870b Mon Sep 17 00:00:00 2001 From: Pavel Kolesnikov Date: Wed, 16 Jan 2013 13:56:46 -0800 Subject: [PATCH 2/3] Example for the mandatory user filter support --- lib/WWW/GoodData.pm | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/lib/WWW/GoodData.pm b/lib/WWW/GoodData.pm index c64dc62..d6da6d4 100644 --- a/lib/WWW/GoodData.pm +++ b/lib/WWW/GoodData.pm @@ -885,6 +885,17 @@ The attribute is specified by the label identifier and the values by uploaded values of the selected label (a.k.a the attributeDisplayForm). +Example: + +$gdc->login($login, $passwd) or die "Unable to authenticate\n"; + +my @values = ( 'CA', 'CO' ); +my $resp = $gdc->assign_user_filter ( + "/gdc/projects/abcdabcdabcd0aabcbab", + "joe@example.org", + "label.region.code", + @values); + =cut sub assign_user_filter From 3552db34cb464de8f2bc3663f2a9fd5ce1b7ee7a Mon Sep 17 00:00:00 2001 From: Lubomir Rintel Date: Thu, 11 Oct 2012 15:27:09 +0200 Subject: [PATCH 3/3] Properly handle 204 responses --- lib/WWW/GoodData/Agent.pm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/lib/WWW/GoodData/Agent.pm b/lib/WWW/GoodData/Agent.pm index 139aa48..815fb2f 100644 --- a/lib/WWW/GoodData/Agent.pm +++ b/lib/WWW/GoodData/Agent.pm @@ -147,6 +147,9 @@ sub request # Pass processed response from subrequest (redirect) return $response if ref $response eq 'HASH'; + # Do not bother checking content and type if there's none + return undef if $response->code == 204; + # Decode my $decoded = eval { decode_json ($response->content) } if $response->header ('Content-Type') =~ /^application\/json(;.*)?/;