File Coverage

blib/lib/Mojo/Redfish/Client.pm

Criterion	Covered	Total	%
statement	42	44	95.4
branch	4	8	50.0
condition	2	6	33.3
subroutine	14	14	100.0
pod	4	4	100.0
total	66	76	86.8

package Mojo::Redfish::Client;

use Mojo::Base -base;

use Carp ();
use Mojo::Collection;
use Mojo::Promise;
use Mojo::Redfish::Client::Result;
use Scalar::Util ();

our $VERSION = '0.03';
$VERSION = eval $VERSION;

has concurrency => 5;
has ssl => 1;
has [qw/host password token username/];

has ua => sub {
  my $self = shift;
  my $ua = Mojo::UserAgent->new(insecure => 1);

  Scalar::Util::weaken $self;
  $ua->on(prepare => sub {
    my ($ua, $tx) = @_;
    my $url = $tx->req->url;

    if (defined(my $host = $self->host)) {
      $url->host($host);
    }

    if (defined(my $ssl = $self->ssl)) {
      $url->scheme($ssl ? 'https' : 'http');
    }

    if (my $token = $self->token) {
      $tx->req->headers->header('X-Auth-Token', $token);
    } elsif (my $userinfo = $self->_userinfo) {
      $url->userinfo($userinfo);
    }
  });

  return $ua;
};

sub get {
  my ($self, $url) = @_;
  my $tx = $self->ua->get($url);
  if (my $err = $tx->error) { Carp::croak $err->{message} }
  my $data = $tx->res->json;
  return $self->_result($tx->res->json);
}

sub get_p {
  my ($self, $url) = @_;
  $self->ua->get_p($url)->then(sub{
    my $tx = shift;
    if (my $err = $tx->error) { Carp::croak $err->{message} }
    my $data = $tx->res->json;
    return $self->_result($tx->res->json);
  });
}

sub root {
  my $self = shift;
  return $self->{root} ||= $self->get('/redfish/v1');
}

sub root_p {
  my $self = shift;
  return Mojo::Promise->resolve($self->{root})
    if $self->{root};
  return $self->get_p('/redfish/v1')->then(sub{
    return $self->{root} = shift;
  });
}

sub _result {
  my ($self, $data) = @_;
  return Mojo::Redfish::Client::Result->new(
    data   => $data,
    client => $self,
  );
};

sub _userinfo {
  my $self = shift;
  my ($user, $pass) = @{$self}{qw/username password/};
  return undef unless $user || $pass;
  return "$user:$pass";
};

1;

=head1 NAME

Mojo::Redfish::Client - A Redfish client with a Mojo flair

=head1 SYNOPSIS

  my $client = Mojo::Redfish::Client->new(host => '192.168.0.1');
  my $system = $client->root->get('/Systems')->get('/Members')->first;
  my $name   = $system->value('/Name');
  say "Name: $name";

=head1 DESCRIPTION

L is a modern standards-based system for querying computer systems for information.
It replaces the existing IPMI "standard", such as it was, both in standardization and in using JSON over HTTP rather than binary protocols.

L is, as the name suggests, a client for Redfish.
It works to smooth out some of the common pain points of working with Redfish, especially the task of walking the data structure to find relevant information.

This is still a work-in-progress, however the author uses it in work application so every effort will be made to keep the api reasonably stable while improving where possible.

=head1 ATTRIBUTES

L inherits all attributes from L and implements the following new ones.

=head2 concurrency

The B concurrency limit.
This is not a global concurrency, it only limits concurrency when a single operation would make several concurrent requests within it.
For example (and the only current case), L on an array.
If zero (or otherwise falsey), no concurrency limit will be applied.
Default is C<5>.

=head2 host

The Redfish host.

=head2 password

Password used for authentication by the default L (with L).

=head2 ssl

If true, the default L will establish the connection using SSL/TLS by setting the request scheme to C.
If false, the request scheme will be C.
If not defined, the url scheme will not be set.
Default is true.

=head2 token

Session token to be used by the default L, overrides L and L.

=head2 ua

The instance of L used to make requests.
The default is an instance which subscribes to L to set authentication and ssl.

=head2 username

Username used for authentication by the default L (with L).

=head1 METHODS

L inherits all methods from L and implements the following new ones.

=head2 get

  my $result = $client->get('/redfish/v1/Systems');

Requests the requested url via the L.
Returns an instance of L.
Dies on errors (the exact exception and behavior is subject to change).

=head2 get_p

Same as L but returns a L that resolves to the result.

=head2 root

  my $result = $client->root;

Requests the Redfish root url (C) from the L via L or fetches a cached copy.
Caches and returns the result.

  # same as (except for the caching)
  my $result = $client->get('/redfish/v1');

=head2 root_p

Same as L but returns a L that resolves to the (possibly cached) root result.

=head1 FUTURE WORK

This module is still in early development.
Future work will include

=over

=item *

Session management

=back


=head1 SEE ALSO

=over

=item L.

=back

=head1 THANKS

This module's development was sponsored by L.

=head1 SOURCE REPOSITORY

L

=head1 AUTHOR

Joel Berger, [e-mail]

=head1 CONTRIBUTORS

None yet.

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2019 by L and L

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.