The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#-*-Perl-*-

# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.t'

use strict;
use ExtUtils::MakeMaker;
use File::Temp qw(tempfile);
use FindBin '$Bin';
use constant TEST_COUNT => 33;

use lib "$Bin/lib","$Bin/../lib","$Bin/../blib/lib","$Bin/../blib/arch";

use Test::More tests => TEST_COUNT;
use EC2TestSupport;

# this script tests all the describe() functions and associated features such as tags.
require_ok('VM::EC2');
reset_declined();

SKIP: {
skip "account information unavailable",TEST_COUNT-1 unless setup_environment();

my $ec2 = VM::EC2->new(-print_error=>1,-region=>'us-east-1') or BAIL_OUT("Can't load VM::EC2 module");
ok($ec2,'VM::EC2->new');

my $natty = $ec2->describe_images(TEST_IMAGE);  # defined in t/EC2TestSupport

if ($ec2->error_str =~ /SignatureDoesNotMatch/) {
    BAIL_OUT($ec2->error_str);
}

ok($natty,'describe image by id');

is($natty->imageLocation,'755060610258/ebs/ubuntu-images/ubuntu-natty-11.04-i386-server-20110426-nano','$image->imageLocation');
like($natty->description,'/http:\/\/nolar\.info\/nano-ami/','$image->description');
is($natty->architecture,'i386','$image->architecture');
is(($natty->blockDeviceMapping)[0],'/dev/sda1=snap-90ed13fe:1:true:standard','$image->blockDeviceMapping');
is($natty->imageState,'available','$image->imageState');

my $owner = $natty->imageOwnerId();
my @i = $ec2->describe_images(-ownerId=>$natty->imageOwnerId,
			      -filter=>{description=>$natty->description,
					'manifest-location'=>$natty->imageLocation});
ok (@i == 1,'describe_images() with multiple filters');
is ($i[0],$natty,'describe_images() with multiple filters returns expected image');

# test tagging
ok($natty->add_tags(Name=>'MyFavoriteImage',Description=>'Test tag added by VM::EC2'),'tag addition');
$natty->refresh;
my $tags = $natty->tags;
is($tags->{Name},'MyFavoriteImage','tag retrieval');

@i = $ec2->describe_images(-filter=>{'tag:Name'        => 'MyFavoriteImage',
				     'tag:Description' => '*VM::EC2'});
is ($i[0],$natty,'retrieve by tags');

ok($natty->add_tags(Name=>'MyLeastFavoriteImage'),'tag replacement');
sleep 1; # takes a while to register
$natty->refresh;
is($natty->tags->{Name},'MyLeastFavoriteImage','tag replacement');

ok($natty->delete_tags(['Name','Description']),'tag deletion');
sleep 1; # takes a short while to register
$natty->refresh;
$tags = $natty->tags;  # should be no tags now
is(scalar keys %$tags,0,'tag deletion');

# exercise availability regions and keys
my @regions = $ec2->describe_regions;
ok(scalar @regions,'describe regions');

my $r       = $ec2->describe_regions($regions[0]);
is ($r,$regions[0],'describe regions by name');

my @zones = $ec2->describe_availability_zones();
ok(scalar @zones,'describe zones');

my $z = $ec2->describe_availability_zones($zones[0]);
is ($z,$zones[0],'describe zones by name');

# make sure that we can get zones from each region
my $cnt;
foreach (@regions) {
    @zones = $_->zones;
    $cnt++ if @zones;
}
is ($cnt,scalar @regions,'each region has availability zones');

my @keys    = $ec2->describe_key_pairs;
ok(scalar @keys,'describe keys');

# security groups
my @sg = $ec2->describe_security_groups();
ok(@sg>0,'describe_security_groups');
ok(scalar(grep {$_->name =~ /default/} @sg),'default security group present');

# error handling
$ec2->print_error(0);
is($ec2->call('IncorrectAction'),undef,'errors return undef');
my $error = $ec2->error;
is($error->code,'InvalidAction','error code on invalid action');

is($ec2->call('RunInstances',(Foo=>'bar')),undef,'errors return undef');
is($ec2->error->code,'UnknownParameter','error code on invalid parameter');
my $msg = $ec2->error->message;
like($ec2->error_str,qr/UnknownParameter/,'error code interpolation');
like($ec2->error_str,qr/$msg/,'error message interpolation');
my $e = $ec2->error;
is($ec2->error_str,"$e",'error object interpolation');

$ec2->raise_error(1);
eval {
    $ec2->call('RunInstances',(Foo=>'bar'));
};
like($@,qr/UnknownParameter/,'raise error mode');
$ec2->raise_error(0);
}

exit 0;