#!/usr/bin/perl
# Copyright (C) 2007 Eric L. Wilhelm
use warnings;
use strict;
=head1 NAME
anno_client - talk directly to the server
=cut
package bin::anno_client;
use Getopt::Helpful;
use YAML::Syck ();
my $get_cred = sub {die "no credentials"};
sub main {
my (@args) = @_;
my $user;
my $rev;
my $hopt = Getopt::Helpful->new(
usage => 'CALLER get|post|put|delete <id> [opts]',
['u|user=s', \$user, '<name=pass>',
'username and/or password'],
['r|revision=i', \$rev, '<revnum>', 'existing revision'],
'+help',
);
$hopt->Get_from(\@args);
my ($action, $id) = @args;
$action = uc($action);
my $anno;
if($action =~ m/POST|PUT/) {
(-t STDIN) and warn "type your yaml now\n";
my $str = do {local $/; <STDIN>};
$anno = YAML::Syck::Load($str);
}
unless(defined($id)) {
# it better be on stdin
($action =~ m/POST|PUT/) or
$hopt->usage("must have id to GET|DELETE");
if($action eq 'PUT') {
defined($id = $anno->{id}) or die "no id in $anno";
}
}
my $pass;
if($user) {
($user, $pass) = split(/=/, $user);
}
my $server = 'localhost:8085';
# read config and such
if((not ($user and $pass)) and (-e 'server_details.yml')) {
my $conf = YAML::Syck::LoadFile('server_details.yml');
$conf = $conf->{anno_servers}{$server} or
die "no config for '$server'";
unless($user) {
$user = $conf->{'*default'};
}
unless($pass) {
$pass = $conf->{$user};
}
}
$get_cred = sub {return($user, $pass)};
my $uri = 'http://' . $server . '/';
$uri .= 'annotation/' unless(($id || '') eq 'manifest');
$uri .= $id . '.yml' if($id);
$uri .= '?rev=' . $rev if(defined($rev));
my @and;
if($action =~ m/POST|PUT/) {
@and = ([content_type => 'text/x-yaml'], YAML::Syck::Dump($anno));
}
my $ua = MyUA->new();
warn "$action $uri @and";
my $ans = $ua->req($action, $uri, @and);
print $ans->content;
}
BEGIN {
package MyUA;
use base 'LWP::UserAgent';
sub get_basic_credentials {$get_cred->()};
sub req {
my $self = shift;
my $ans = $self->request(HTTP::Request->new(@_));
my %want = (
POST => 201,
DELETE => 200,
PUT => 200,
GET => 200,
);
($ans->code == $want{$_[0]}) or
die "bad answer ", $ans->code, " ", $ans->content;
return($ans);
}
} # end MyUA
package main;
if($0 eq __FILE__) {
bin::anno_client::main(@ARGV);
}
# vi:ts=2:sw=2:et:sta
my $package = 'bin::anno_client';