Perl x Open Food Facts Hackathon: Paris, France - May 24-25 Learn more

#!/usr/bin/perl -w
# Lists the available images (distros)
use strict;
# Global options
our $opt_version;
our $opt_help;
our $opt_man;
our $opt_server = 'http://localhost:8081/';
# 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) {
print '$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) {
print 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,
=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