—#!/usr/bin/perl -w
# Lists the available images (distros)
use
Pod::Usage;
use
Getopt::Long;
use
SOAP::Lite;
use
strict;
# Global options
our
$opt_version
;
our
$opt_help
;
our
$opt_man
;
# Handle commandline options
Getopt::Long::Configure (
'bundling'
,
'no_ignore_case'
);
GetOptions(
'version|V'
=> \
$opt_version
,
'help|h'
=> \
$opt_help
,
'man'
=> \
$opt_man
,
'server|s=s'
=> \
$opt_server
,
'resource|r=s'
=> \
$opt_resource
,
);
# Handle -V or --version
if
(
$opt_version
) {
'$0: $Revision: 1.9 $'
,
"\n"
;
exit
0;
}
# Usage
pod2usage(
-verbose
=> 2,
-exitstatus
=> 0)
if
(
$opt_man
);
pod2usage(
-verbose
=> 1,
-exitstatus
=> 0)
if
(
$opt_help
);
exit
main();
sub
main {
# Connect to the server
my
$soap
= create_soap_instance(
$opt_resource
,
$opt_server
);
# Create the test service object
my
$response
=
$soap
->call(
new
=> 1);
soap_assert(
$response
);
my
$testsys
=
$response
->result;
# Retrieve the images
$response
=
$soap
->get_images(
$testsys
);
soap_assert(
$response
);
if
(!
$response
->result) {
warn
"No results returned\n"
;
return
-1;
}
# Print the header
my
$format
=
"%-5s %-25s %-20s\n"
;
printf
(
$format
,
"ID"
,
"Name"
,
"Status"
);
# Print each record
foreach
my
$row
(@{
$response
->result}) {
printf
(
$format
,
$row
->{id},
$row
->{descriptor},
$row
->{status}
);
}
return
0;
}
# Convenience function to create the soap instance
sub
create_soap_instance {
my
$resource
=
shift
||
return
undef
;
my
$server
=
shift
||
return
undef
;
my
$soap
= SOAP::Lite
-> uri(
$resource
)
-> proxy(
$server
,
options
=> {
compress_threshold
=> 10000});
return
$soap
;
};
# Convenience function to print out any errors encountered in a soap call
# and exit.
sub
soap_assert {
my
$response
=
shift
;
if
(
$response
->fault) {
join
', '
,
$response
->faultcode,
$response
->faultstring;
return
undef
;
}
return
1;
}
__END__
=head1 NAME
stp-lsimage - lists available images
=head1 SYNOPSIS
stp-lsimage [options]
=head1 DESCRIPTION
This tool allows listing of images available to be run from the test
system. It makes calls to the server at 'server_url' providing the
'resource_uri' using SOAP::Lite.
=head1 OPTIONS
=over 8
=item B<-V>, B<--version>
Displays the version number of the script and exits.
=item B<-h>, B<--help>
Displays a brief usage message
=item B<--man>
Displays the man page
=item B<-s> I<server_url>, B<--server>=I<server_url>
The URL of the WebService::TestSystem server to connect to. By default,
it uses 'http://localhost:8081'.
=item B<-r> I<resource_uri>, B<--resource>=I<resource_uri>
The URI of the service provided by the server. By default, it uses
'http://www.osdl.org/WebService/TestSystem'. Users should not typically
need to alter this setting.
=back
=head1 PREREQUISITES
B<SOAP::Lite>,
B<Pod::Usage>,
B<Getopt::Long>
=head1 AUTHOR
Bryce Harrington E<lt>bryce@osdl.orgE<gt>
=head1 COPYRIGHT
Copyright (C) 2004 Open Source Development Labs
All Rights Reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 REVISION
Revision: $Revision: 1.9 $
=cut