File Coverage

blib/lib/Mojo/Redfish/Client.pm

Criterion	Covered	Total	%
statement	29	30	96.6
branch	2	4	50.0
condition	2	6	33.3
subroutine	9	9	100.0
pod	2	2	100.0
total	44	51	86.2

package Mojo::Redfish::Client;

use Mojo::Base -base;

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

our $VERSION = '0.02';
$VERSION = eval $VERSION;

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 root {
  my $self = shift;
  return $self->{root} ||= $self->get('/redfish/v1');
}

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 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 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');

=head1 FUTURE WORK

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

=over

=item *

Non-blocking (promise-based) api

=item *

Session management

=item *

Even more testing

=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.