#!/usr/bin/env perl
use strict;
use warnings;
use v5.10;
use App::Rad qw(MoreHelp);
use JSON qw(from_json to_json);
use LWP;
use Net::OpenStack::Compute;

sub setup {
    my $c = shift;

    $c->register_commands({
        server => 'perform server actions',
        image  => 'perform image actions',
        flavor => 'perform flavor actions',
    });
    $c->register(s => \&server, 'alias for server');
    $c->register(i => \&image, 'alias for image');
    $c->register(f => \&flavor, 'alias for flavor');
    $c->more_help(<<EOD);
    
Server commands:

    server [list]
    server show [<id>]
    server create <name> <flavor> <image>
    server delete <id>

Image commands:

    image [list]
    image show [<id>]
    image create <name> <server-id>
    image delete <id>

Flavor commands:

    flavor [list]
    flavor show [<id>]
EOD

    my $msg = "%s env var is missing. Did you forget to source novarc?\n";
    die sprintf($msg, 'NOVA_URL') unless $ENV{NOVA_URL};
    die sprintf($msg, 'NOVA_USERNAME') unless $ENV{NOVA_USERNAME};
    die sprintf($msg, 'NOVA_PASSWORD or NOVA_API_KEY')
        unless $ENV{NOVA_PASSWORD} || $ENV{NOVA_API_KEY};

    $c->stash->{compute} = Net::OpenStack::Compute->new(
        auth_url   => $ENV{NOVA_URL},
        user       => $ENV{NOVA_USERNAME},
        password   => $ENV{NOVA_PASSWORD} || $ENV{NOVA_API_KEY},
        project_id => $ENV{NOVA_PROJECT_ID},
        region     => $ENV{NOVA_REGION_NAME},
    );
    $c->getopt('verbose|v');
}

App::Rad->run();

sub server {
    my $c = shift;
    my $compute = $c->stash->{compute};
    my @args = @{$c->argv};
    my $sub_cmd = shift @args;
    given ($sub_cmd) {
        when (undef) {
            return _get_servers($c);
        }
        when ('list') {
            return _get_servers($c);
        }
        when ('show') {
            die "Usage: $0 server show <id>\n" unless @args == 1;
            my $s = $compute->get_server($args[0]);
            return _to_json($s) if $c->options->{verbose};
            return $s ? _format_servers($s) : 'No such server';
        }
        when ('create') {
            die "Usage: $0 server create <name> <flavor> <image>\n"
                unless @args == 3;
            my ($name, $flavor, $image) = @args;
            my $s = $compute->create_server(
                name => $name, flavor => $flavor, image => $image);
            return _to_json($s) if $c->options->{verbose};
            return "Creating server $s->{id} with password $s->{adminPass}";
        }
        when ('delete') {
            die "Usage: $0 server delete <id>\n" unless @args == 1;
            my ($id) = @args;
            $compute->delete_server($id);
            return "Server $id has been marked for deletion";
        }
        default {
            die "Supported server commands are list, show, create and delete."
                . "\n";
        }
    }
}

sub image {
    my $c = shift;
    my $compute = $c->stash->{compute};
    my @args = @{$c->argv};
    my $sub_cmd = shift @args;
    given ($sub_cmd) {
        when (undef) {
            return _get_images($c);
        }
        when ('list') {
            return _get_images($c);
        }
        when ('show') {
            die "Usage: $0 image show <id>\n" unless @args == 1;
            my $img = $compute->get_image($args[0]);
            return _to_json($img) if $c->options->{verbose};
            return 'No such image' unless $img;
            return _format_images($img);
        }
        when ('create') {
            die "Usage: $0 image create <name> <server-id>\n" unless @args == 2;
            my ($name, $server) = @args;
            return $compute->create_image(name => $name, server => $server);
        }
        when ('delete') {
            die "Usage: $0 image delete <id>\n" unless @args == 1;
            my ($id) = @args;
            $compute->delete_image($id);
            return "Image $id has been marked for deletion";
        }
        default {
            die "Supported image commands are list, show, create and delete.\n";
        }
    }
}

sub flavor {
    my $c = shift;
    my $compute = $c->stash->{compute};
    my @args = @{$c->argv};
    my $sub_cmd = shift @args;
    given ($sub_cmd) {
        when (undef) {
            return _get_flavors($c);
        }
        when ('list') {
            return _get_flavors($c);
        }
        when ('show') {
            die "Usage: $0 flavor show <id>\n" unless @args == 1;
            my $flavor = $compute->get_flavor($args[0]);
            return _to_json($flavor) if $c->options->{verbose};
            return 'No such flavor' unless $flavor;
            return _format_flavors($flavor);
        }
        default {
            die "Supported flavor commands are list, show, create and delete."
                . "\n";
        }
    }
}

sub _get_servers {
    my $c = shift;
    my $compute = $c->stash->{compute};
    my $servers = $compute->get_servers(detail => 1);
    return _to_json($servers) if $c->options->{verbose};
    return _format_servers(@$servers);
}

sub _get_images {
    my $c = shift;
    my $compute = $c->stash->{compute};
    my $images = $compute->get_images(detail => 1);
    return _to_json($images) if $c->options->{verbose};
    return _format_images(@$images);
}

sub _get_flavors {
    my $c = shift;
    my $compute = $c->stash->{compute};
    my $flavors = $compute->get_flavors(detail => 1);
    return _to_json($flavors) if $c->options->{verbose};
    return _format_flavors(@$flavors);
}

sub _format_servers {
    my @servers = @_;
    join "\n", map { join "\t", @$_{qw(id name status)}, _get_ip($_) } @servers;
}

sub _format_images {
    my @images = @_;
    join "\n", map { join "\t", @$_{qw(id name status)} } @images;
}

sub _format_flavors {
    my @flavors = @_;
    join "\n", map { join "\t", @$_{qw(id name ram)} } @flavors;
}

sub _get_ip {
    my $server = shift;
    for my $addr (map @{$server->{addresses}{$_} || []}, qw(public private)) {
        return $addr->{addr} if $addr->{version} == 4;
    }
    return 'IP-MISSING';
}

# Warning, recursive magic ahead.
sub _to_json {
    ref $_[0] ? to_json($_[0], {pretty => 1}) : _to_json(from_json($_[0]))
}

# PODNAME: oscompute


__END__
=pod

=head1 NAME

oscompute

=head1 VERSION

version 1.0301

=head1 SYNOPSIS

    Usage: oscompute command [arguments]

    Available Commands:
        flavor      flavor [--verbose|-v] [show [<id>]]
        help        show syntax and available commands
        image       image [--verbose|-v] [show [<id>]] [create <name> <server-id>] [delete <id>]
        server      server [--verbose|-v] [show [<id>]] [create <name> <flavor> <image>] [delete <id>]

    Examples:

    # List all servers.
    oscompute server

    # Same thing.
    oscompute server show

    # Show all details.
    oscompute server -v show

    # Show info for a particular server.
    oscompute server show ec05b52e-f575-469c-a91e-7f0ddd4fab95

    # Create a new server.
    # Order of arguments are server create `name` `flavor` `image`
    oscompute server create bob 1 11b2a5bf-590c-4dd4-931f-a65751a4db0e

    # Delete a server.
    oscompute server delete ec05b52e-f575-469c-a91e-7f0ddd4fab95

    # List all available images.
    oscompute image

    # Create a snapshot image of a given server.
    oscompute image create myimg ec05b52e-f575-469c-a91e-7f0ddd4fab95

=head1 DESCRIPTION

This is a command line tool for interacting with the OpenStack Compute API.

=head1 AUTHOR

Naveed Massjouni <naveedm9@gmail.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by Naveed Massjouni.

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

=cut

