File Coverage

blib/lib/WebService/GoogleAPI/Client/Discovery.pm

Criterion	Covered	Total	%
statement	172	192	89.5
branch	58	80	72.5
condition	14	20	70.0
subroutine	25	30	83.3
pod	12	17	70.5
total	281	339	82.8

use strictures;

package WebService::GoogleAPI::Client::Discovery;

our $VERSION = '0.27';    # VERSION

# ABSTRACT: Google API discovery service


use Moo;
use Carp;
use WebService::GoogleAPI::Client::UserAgent;
use List::Util      qw/uniq reduce/;
use List::SomeUtils qw/pairwise/;
use Data::Dump      qw/pp/;
use CHI;

has ua => (
  is      => 'rw',
  default => sub { WebService::GoogleAPI::Client::UserAgent->new }
);
has debug => (is => 'rw', default => 0);
has 'chi' => (
  is      => 'rw',
  default => sub { CHI->new(driver => 'File', namespace => __PACKAGE__) },
  lazy    => 1
);    ## i believe that this gives priority to param if provided ?
has 'stats' => is => 'rw',
    default => sub { { network => { get => 0 }, cache => { get => 0 } } };


sub get_with_cache {
  my ($self, $key, $force, $authorized) = @_;

  my $expiration = $self->chi->get_expires_at($key) // 0;

  my $will_expire = $expiration - time();
  if ($will_expire > 0 && not $force) {
    carp "discovery_data cached data expires in $will_expire seconds"
        if $self->debug > 2;
    my $ret = $self->chi->get($key);
    croak 'was expecting a HASHREF!' unless ref $ret eq 'HASH';
    $self->stats->{cache}{get}++;
    return $ret;
  } else {
    my $ret;
    if ($authorized) {
      $ret = $self->ua->validated_api_query($key);
      $self->stats->{network}{authorized}++;
    } else {
      $ret = $self->ua->get($key)->res;
    }
    if ($ret->is_success) {
      my $all = $ret->json;
      $self->stats->{network}{get}++;
      $self->chi->set($key, $all, '30d');
      return $all;
    } else {
      if ($ret->code == 403 && !$authorized) {
        return $self->get_with_cache($key, $force, 1);
      }
      croak $ret->message;
    }
  }
  return {};
}


sub discover_key {'https://www.googleapis.com/discovery/v1/apis'}

sub discover_all {
  my $self = shift;
  $self->get_with_cache($self->discover_key, @_);
}

#TODO- double triple check that we didn't break anything with the
#hashref change


#TODO- maybe cache this on disk too?
my $available;

sub _invalidate_available {
  $available = undef;
}

sub available_APIs {

  #cache this crunch
  return $available if $available;

  my ($self) = @_;
  my $d_all = $self->discover_all;
  croak 'no items in discovery data' unless defined $d_all->{items};

  #grab only entries with the four keys we want
  #and strip other keys
  my @keys = qw/name version documentationLink discoveryRestUrl/;
  my @relevant;
  for my $i (@{ $d_all->{items} }) {
    next unless @keys == grep { exists $i->{$_} } @keys;
    push @relevant, { %{$i}{@keys} };
  }

  my $reduced = reduce {
    for my $key (qw/version documentationLink discoveryRestUrl/) {
      $a->{ $b->{name} }->{$key} //= [];
      push @{ $a->{ $b->{name} }->{$key} }, $b->{$key};
    }
    $a;
  } {}, @relevant;

  #store it away globally
  $available = $reduced;
}


sub augment_discover_all_with_unlisted_experimental_api {
  my ($self, $api_spec) = @_;
  carp <
This lengthy function name (augment_discover_all_with_unlisted_experimental_api)
will be removed soon.  Please use 'augment_with' instead.
DEPRECATION
  $self->augment_with($api_spec);
}

sub augment_with {
  my ($self, $api_spec) = @_;

  my $all = $self->discover_all();

  ## fail if any of the expected fields are not provided
  for my $field (
    qw/version title description id kind documentationLink
    discoveryRestUrl name/
  ) {
    if (not defined $api_spec->{$field}) {
      carp("required $field in provided api spec missing");
    }
  }

  push @{ $all->{items} }, $api_spec;
  $self->chi->set($self->discover_key, $all, '30d');
  $self->_invalidate_available;
  return $all;
}



sub service_exists {
  my ($self, $api) = @_;
  return unless $api;
  return $self->available_APIs->{$api};
}


sub available_versions {
  my ($self, $api) = @_;
  return [] unless $api;
  return $self->available_APIs->{$api}->{version} // [];
}


sub latest_stable_version {
  my ($self, $api) = @_;
  return '' unless $api;
  my $versions = $self->available_versions($api);
  return '' unless $versions;
  return '' unless @{$versions} > 0;

  #remove alpha or beta versions
  my @stable = grep { !/beta|alpha/ } @$versions;
  return $stable[-1] || '';
}


sub process_api_version {
  my ($self, $params) = @_;

  # scalar parameter not hashref - so assume is intended to be $params->{api}
  $params = { api => $params } if ref $params eq '';

  croak "'api' must be defined" unless $params->{api};

  ## trim any resource, method or version details in api id
  if ($params->{api} =~ /([^:]+):(v[^\.]+)/ixsm) {
    $params->{api}     = $1;
    $params->{version} = $2;
  }
  if ($params->{api} =~ /^(.*?)\./xsm) {
    $params->{api} = $1;
  }

  unless ($self->service_exists($params->{api})) {
    croak "$params->{api} does not seem to be a valid Google API";
  }

  $params->{version} //= $self->latest_stable_version($params->{api});
  return $params;
}



sub get_api_discovery_for_api_id {
  carp <
This long method name (get_api_discovery_for_api_id) is being deprecated
in favor of get_api_document. Please switch your code soon
DEPRECATION
  shift->get_api_document(@_);
}

sub get_api_document {
  my ($self, $arg) = @_;

  my $params = $self->process_api_version($arg);
  my $apis   = $self->available_APIs();

  my $api = $apis->{ $params->{api} };
  croak "No versions found for $params->{api}" unless $api->{version};

  my @versions = @{ $api->{version} };
  my @urls     = @{ $api->{discoveryRestUrl} };
  my ($url)    = pairwise { $a eq $params->{version} ? $b : () } @versions, @urls;

  croak "Couldn't find correct url for $params->{api} $params->{version}"
      unless $url;

  $self->get_with_cache($url);
}

#TODO- HERE - we are here in refactoring
sub _extract_resource_methods_from_api_spec {
  my ($self, $tree, $api_spec, $ret) = @_;
  $ret = {} unless defined $ret;
  croak("ret not a hash - $tree, $api_spec, $ret") unless ref($ret) eq 'HASH';

  if (defined $api_spec->{methods} && ref($api_spec->{methods}) eq 'HASH') {
    foreach my $method (keys %{ $api_spec->{methods} }) {
      $ret->{"$tree.$method"} = $api_spec->{methods}{$method}
          if ref($api_spec->{methods}{$method}) eq 'HASH';
    }
  }
  if (defined $api_spec->{resources}) {
    foreach my $resource (keys %{ $api_spec->{resources} }) {
      ## NB - recursive traversal down tree of api_spec resources
      $self->_extract_resource_methods_from_api_spec("$tree.$resource", $api_spec->{resources}{$resource}, $ret);
    }
  }
  return $ret;
}



sub extract_method_discovery_detail_from_api_spec {
  carp <
This rather long method name (extract_method_discovery_detail_from_api_spec)
is being deprecated in favor of get_method_details. Please switch soon
DEPRECATION
  shift->get_method_details(@_);
}

sub get_method_details {
  my ($self, $tree, $api_version) = @_;
  ## where tree is the method in format from _extract_resource_methods_from_api_spec() like projects.models.versions.get
  ##   the root is the api id - further '.' sep levels represent resources until the tailing label that represents the method
  croak 'You must ask for a method!' unless defined $tree;

  my @nodes = split /\./smx, $tree;
  croak(
    "tree structure '$tree' must contain at least 2 nodes including api id, [list of hierarchical resources ] and method - not "
        . scalar(@nodes))
      unless @nodes > 1;

  my $api_id = shift(@nodes);    ## api was head
  my $method = pop(@nodes);      ## method was tail

  ## split out version if is defined as part of $tree
  ## trim any resource, method or version details in api id
  ## we have already isolated head from api tree children
  if ($api_id =~ /([^:]+):([^\.]+)$/ixsm) {
    $api_id      = $1;
    $api_version = $2;
  }

  ## handle incorrect api_id
  if (!$self->service_exists($api_id)) {
    croak("unable to confirm that '$api_id' is a valid Google API service id");
  }

  $api_version = $self->latest_stable_version($api_id) unless $api_version;


  ## TODO: confirm that spec available for api version
  my $api_spec = $self->get_api_document({ api => $api_id, version => $api_version });


  ## we use the schemas to substitute into '$ref' keyed placeholders
  my $schemas = {};
  foreach my $schema_key (sort keys %{ $api_spec->{schemas} }) {
    $schemas->{$schema_key} = $api_spec->{'schemas'}{$schema_key};
  }

  ## recursive walk through the structure in _fix_ref
  ##  substitute the schema keys into the total spec to include
  ##  '$ref' values within the schema structures themselves
  ##  including within the schema spec structures (NB assumes no cyclic structures )
  ##   otherwise would could recursive chaos
  my $api_spec_fix
      = $self->_fix_ref($api_spec, $schemas);    ## first level ( '$ref' in the method params and return values etc )
  $api_spec = $self->_fix_ref($api_spec_fix, $schemas)
      ;                                          ## second level ( '$ref' in the interpolated schemas from first level )

  ## now extract all the methods (recursive )
  my $all_api_methods = $self->_extract_resource_methods_from_api_spec("$api_id:$api_version", $api_spec);

  unless (defined $all_api_methods->{$tree}) {
    $all_api_methods = $self->_extract_resource_methods_from_api_spec($api_id, $api_spec);
  }
  if ($all_api_methods->{$tree}) {

    #add in the global parameters to the endpoint,
    #stored in the top level of the api_spec
    # TODO - why are we mutating the main hash?
    $all_api_methods->{$tree}{parameters}
        = { %{ $all_api_methods->{$tree}{parameters} }, %{ $api_spec->{parameters} } };
    return $all_api_methods->{$tree};
  }

  croak("Unable to find method detail for '$tree' within Google Discovery Spec for $api_id version $api_version");
}
########################################################

########################################################
########################################################

#=head2 C
#
#This sub walks through the structure and replaces any hashes keyed with '$ref' with
#the value defined in $schemas->{  }
#
#eg
# ->{'response'}{'$ref'}{'Buckets'}
# is replaced with
# ->{response}{ $schemas->{Buckets} }
#
# It assumes that the schemas have been extracted from the original discover for the API
# and is typically applied to the method ( api endpoint ) to provide a fully descriptive
# structure without external references.
#
#=cut

########################################################
sub _fix_ref {
  my ($self, $node, $schemas) = @_;
  my $ret = undef;
  my $r   = ref($node);


  if ($r eq 'ARRAY') {
    $ret = [];
    foreach my $el (@$node) {
      push @$ret, $self->_fix_ref($el, $schemas);
    }
  } elsif ($r eq 'HASH') {
    $ret = {};
    foreach my $key (keys %$node) {
      if ($key eq '$ref') {

        #say $node->{'$ref'};
        $ret = $schemas->{ $node->{'$ref'} };
      } else {
        $ret->{$key} = $self->_fix_ref($node->{$key}, $schemas);
      }
    }
  } else {
    $ret = $node;
  }

  return $ret;
}
########################################################



#TODO: consider ? refactor to allow parameters either as a single api id such as 'gmail'
#      as well as the currently accepted  hash keyed on the api and version
#
#SEE ALSO:
#  The following methods are delegated through to Client::Discovery - see perldoc WebService::Client::Discovery for detils
#
#  get_method_meta
#  discover_all
#  extract_method_discovery_detail_from_api_spec
#  get_api_discovery_for_api_id

########################################################
#TODO- give short name and deprecate
sub methods_available_for_google_api_id {
  my ($self, $api_id, $version) = @_;

  $version = $self->latest_stable_version($api_id) unless $version;
  ## TODO: confirm that spec available for api version
  my $api_spec = $self->get_api_discovery_for_api_id({ api => $api_id, version => $version });
  my $methods  = $self->_extract_resource_methods_from_api_spec($api_id, $api_spec);
  return $methods;
}
########################################################



sub list_of_available_google_api_ids {
  carp <
This rather long function name (list_of_available_google_api_ids)
is being deprecated in favor of the shorter list_api_ids. Please
update your code accordingly.
DEPRECATION
  shift->list_api_ids;
}
## returns a list of all available API Services
sub list_api_ids {
  my ($self) = @_;
  my @api_list = keys %{ $self->available_APIs };
  return wantarray ? @api_list : join(',', @api_list);
}


1;

__END__