package Net::PMP::CLI;
use Moose;
with 'MooseX::SimpleConfig';
with 'MooseX::Getopt';

use Net::PMP::Client;
use JSON;
use Data::Dump qw( dump );

our $VERSION = '0.005';

has '+configfile' =>
    ( default => $ENV{PMP_CLIENT_CONFIG} || ( $ENV{HOME} . '/.pmp.yaml' ) );

# keep attributes sorted as usage prints in this order
has 'child'   => ( is => 'rw', isa => 'Str', );
has 'debug'   => ( is => 'rw', isa => 'Bool', );
has 'expires' => ( is => 'rw', isa => 'Str' );
has 'file'    => ( is => 'rw', isa => 'Str' );
has 'guid'    => ( is => 'rw', isa => 'Str', );
has 'host' =>
    ( is => 'rw', isa => 'Str', default => 'https://api-sandbox.pmp.io', );
has 'id' => ( is => 'rw', isa => 'Str', required => 1, );
has 'label'   => ( is => 'rw', isa => 'Str' );
has 'limit'   => ( is => 'rw', isa => 'Int' );
has 'parent'  => ( is => 'rw', isa => 'Str', );
has 'pass'    => ( is => 'rw', isa => 'Str' );
has 'path'    => ( is => 'rw', isa => 'Str', );
has 'profile' => ( is => 'rw', isa => 'Str' );
has 'query'   => ( is => 'rw', isa => 'HashRef', );
has 'scope'   => ( is => 'rw', isa => 'Str' );
has 'secret'  => ( is => 'rw', isa => 'Str', required => 1, );
has 'tag'     => ( is => 'rw', isa => 'Str', );
has 'tags'    => ( is => 'rw', isa => 'ArrayRef', );
has 'title'   => ( is => 'rw', isa => 'Str', );
has 'user'    => ( is => 'rw', isa => 'Str' );

=head1 NAME

Net::PMP::CLI - command line application for Net::PMP::Client

=head1 SYNOPSIS

 use Net::PMP::CLI;
 my $app = Net::PMP::CLI->new_with_options();
 $app->run();

=head1 DESCRIPTION

This class is used by the C<pmpc> command-line tool.
It uses L<MooseX::SimpleConfig> and L<MooseX::Getopt> to allow
for simple configuration file and option parsing.

=head1 METHODS

With the exceptions of B<run> and B<init_client> all method
names are commands.

=head2 run

Main method. Calls commands passed via @ARGV.

=cut

sub _getopt_full_usage {
    my ( $self, $usage ) = @_;
    $usage->die( { post_text => $self->commands } );
}

sub _usage_format {
    return "usage: %c command %o";
}

sub run {
    my $self = shift;

    $self->debug and dump $self;

    my @cmds = @{ $self->extra_argv };

    if ( !@cmds or $self->help_flag ) {
        $self->usage->die( { post_text => $self->commands } );
    }

    for my $cmd (@cmds) {
        if ( !$self->can($cmd) ) {
            warn "No such command $cmd\n";
            $self->usage->die();
        }
        $self->$cmd();
    }

}

=head2 commands

Returns usage text for available commands.

=cut

sub commands {
    my $self = shift;
    my $txt  = <<EOF;
commands:
    search  --query tag=foo --query text=bar --query limit=100
    delete_by_search --query tag=foo --query text=bar --query limit=100
    add     --parent <guid> --child <guid>
    create  --profile <profile> --title <title> --tags foo --tags bar
    delete  --guid <guid>
    delete_by_tag --tag foo
    get     --path /path/to/resource
    groups
    put     --file /path/to/resource.json
    users
EOF
    return $txt;
}

sub _list_items {
    my ( $self, $label, $urn ) = @_;
    my $client = $self->init_client();
    my $root   = $client->get_doc();
    my $q      = $root->query($urn);
    my $uri    = $q->as_uri( { limit => 200 } );     # TODO random big number
    my $res    = $client->get_doc($uri) or return;
    my $items  = $res->get_items();
    while ( my $item = $items->next ) {
        my $profile = $item->get_profile;
        $profile =~ s,^.+/,,;
        printf(
            "%s [%s]: %s [%s]\n",
            $label, $profile, ( $item->get_title || '[missing title]' ),
            $item->get_uri,
        );
        if ( $item->has_items ) {
            my $iitems = $item->get_items;
            while ( my $iitem = $iitems->next ) {
                my $iprofile = $iitem->get_profile;
                $iprofile =~ s,^.+/,,;
                printf( " contains: %s [%s] [%s]\n",
                    $iitem->get_title, $iitem->get_uri, $iprofile );
            }
        }
    }
}

=head2 search( I<query> )

Executes search for I<query> and prints results to stdout.

=cut

sub search {
    my $self   = shift;
    my $query  = $self->query or die "--query required for search\n";
    my $client = $self->init_client();
    my $res    = $client->search($query) or return;
    my $items  = $res->get_items();
    while ( my $item = $items->next ) {
        my $profile = $item->get_profile || 'root';
        $profile =~ s,^.+/,,;
        printf( "%s: %s [%s]\n",
            $profile, $item->get_title, $item->get_uri, );
    }
}

=head2 delete_by_search( I<query> )

Execute search for I<query> and deletes the results.

=cut

sub delete_by_search {
    my $self   = shift;
    my $query  = $self->query or die "--query required for search\n";
    my $client = $self->init_client();
    my $res    = $client->search($query) or return;
    my $items  = $res->get_items();
    while ( my $item = $items->next ) {
        if ( $client->delete($item) ) {
            printf( "Deleted %s\n", $item->get_uri );
        }
    }
}

=head2 create

Create or update a resource via Net::PMP::Client.
Requires the C<--profile> and C<--title> options.

=cut

sub create {
    my $self    = shift;
    my $profile = $self->profile or die "--profile required for create\n";
    my $title   = $self->title or die "--title required for create\n";
    my $tags    = $self->tags || [];
    my $client  = $self->init_client;

    # verify profile first
    my $prof_doc = $self->get( '/profiles/' . $profile );
    if ( !$prof_doc ) {
        die "invalid profile: $profile\n";
    }
    my $doc = Net::PMP::CollectionDoc->new(
        version    => $client->get_doc->version,
        attributes => { title => $title, tags => $tags, },
        links      => {
            profile => [ { href => $client->host . '/profiles/' . $profile } ]
        },
    );
    $client->save($doc);
    printf( "%s saved as '%s' at %s\n",
        $profile, $doc->get_title, $doc->get_uri );
}

=head2 create_credentials

Create a credential set. Requires --user and --pass options,
and optionally --scope --expires --label.

=cut

sub create_credentials {
    my $self    = shift;
    my $user    = $self->user or die "--user required";
    my $pass    = $self->pass or die "--pass required";
    my $scope   = $self->scope;
    my $expires = $self->expires;
    my $label   = $self->label;
    my $client  = $self->init_client;
    my $creds   = $client->create_credentials(
        username => $user,
        password => $pass,
        scope    => $scope,
        expires  => $expires,
        label    => $label,
    );

    if ($creds) {
        printf( "Credentials created: %s\n", dump($creds) );
    }
    else {
        printf("Failed to create credentials\n");
    }
}

=head2 delete

Deletes a resource. Requires the C<--guid> option.

=cut

sub delete {
    my $self   = shift;
    my $guid   = $self->guid or die "--guid required for delete\n";
    my $client = $self->init_client;
    my $doc    = $client->get_doc_by_guid($guid);
    if ( !$doc ) {
        die "Cannot delete non-existent doc $guid\n";
    }
    if ( $client->delete($doc) ) {
        printf( "Deleted %s\n", $guid );
    }
    else {
        printf( "Failed to delete %s\n", $guid );    # never get here, croaks
    }
}

=head2 delete_by_tag([I<tag>])

Deletes all resources that match a search for tag.

=cut

sub delete_by_tag {
    my $self = shift;
    my $tag = shift || $self->tag;
    defined $tag or die "--tag required for delete_by_tag\n";

    # optional profile if defined
    my $profile = $self->profile;
    my $limit = $self->limit || 100;

    my %args = ( tag => $tag, limit => $limit );
    if ($profile) {
        $args{profile} = $profile;
    }
    my $client = $self->init_client;

    my $matches = $client->search( \%args );
    if ($matches) {
        my $res = $matches->get_items();
        while ( my $item = $res->next ) {
            if ( $client->delete($item) ) {
                printf( "Deleted %s\n", $item->get_uri );
            }
        }
    }
}

=head2 users

List all users.

=cut

sub users {
    my $self = shift;
    my $urn  = "urn:collectiondoc:query:users";
    $self->_list_items( 'User', $urn );
}

=head2 groups

List all groups.

=cut

sub groups {
    my $self = shift;
    my $urn  = "urn:collectiondoc:query:groups";
    $self->_list_items( 'Group', $urn );
}

=head2 get([I<path>])

Issues a get_doc() for the URI represented by I<path>. If I<path>
is not explicitly passed, looks at the C<--path> option.

Dumps the resource for I<path> to stdout.

=cut

sub get {
    my $self = shift;
    my $path = shift || $self->path;
    if ( !$path ) {
        die "--path required for get\n";
    }
    my $client = $self->init_client;
    my $uri    = $client->host . $path;
    my $doc    = $client->get_doc($uri);
    if ( $doc eq '0' ) {
        printf( "No such path: %s [%s]\n",
            $self->path, $client->last_response->status_line );
    }
    else {
        #dump $doc;
        print $doc->as_json;
    }
}

=head2 put([I<filename>])

Reads I<filename> and PUTs it to the server. If missing, the file()
attribute will be checked instead.

I<filename> should represent a ready-to-save CollectionDoc in JSON format.
A simple string substitution will be performed, replacing C<${HOSTNAME}> with
the base PMP host for the configured environment.

=cut

sub put {
    my $self = shift;
    my $filename = shift || $self->file();
    if ( !$filename ) {
        die "--file required for put\n";
    }
    my $client   = $self->init_client;
    my $hostname = $client->host;

    # slurp file
    my $fh = IO::File->new("< $filename")
        or die "Can't read file $filename: $!";
    local $/;
    my $buf = <$fh>;

    # string sub
    $buf =~ s/\$\{HOSTNAME\}/$hostname/g;

    # decode as hashref
    my $json = decode_json($buf);

    # write it
    my $doc = Net::PMP::CollectionDoc->new($json);
    $client->save($doc);
    printf( "%s saved as %s\n", $filename, $doc->get_uri() );
}

=head2 add( I<parent_doc>, I<child_doc> )

Save I<child_doc> as child of I<parent_doc>.

=cut

sub add {
    my $self = shift;
    my $parent = shift || $self->parent;
    if ( !$parent ) {
        die "--parent required for add_item\n";
    }
    my $child = shift || $self->child;
    if ( !$child ) {
        die "--child required for add_item\n";
    }
    my $client     = $self->init_client;
    my $parent_doc = $client->get_doc_by_guid($parent);
    my $child_doc  = $client->get_doc_by_guid($child);
    if ( !$parent_doc ) {
        die "could not find parent $parent\n";
    }
    if ( !$child_doc ) {
        die "could not find child $child\n";
    }
    $parent_doc->add_item($child_doc);
    $client->save($parent_doc);
    printf( "child %s saved to parent %s\n", $child, $parent );
}

=head2 init_client

Instantiates and caches a Net::PMP::Client instance.

=cut

sub init_client {
    my $self = shift;
    return $self->{_client} if $self->{_client};
    my $client = Net::PMP::Client->new(
        id     => $self->id,
        secret => $self->secret,
        host   => $self->host,
        debug  => $self->debug,
    );
    $self->{_client} = $client;
    return $client;
}

1;

__END__

=head1 AUTHOR

Peter Karman, C<< <karman at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-net-pmp at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-PMP>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.


=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Net::PMP::Client


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-PMP>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Net-PMP>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Net-PMP>

=item * Search CPAN

L<http://search.cpan.org/dist/Net-PMP/>

=back


=head1 ACKNOWLEDGEMENTS

American Public Media and the Public Media Platform sponsored the development of this module.

=head1 LICENSE AND COPYRIGHT

Copyright 2013 American Public Media Group

See the LICENSE file that accompanies this module.

=cut
