view release on metacpan or  search on metacpan

sbin/vsoapc  view on Meta::CPAN

print "Keyword: $keyword Action: $action\n" if $DEBUG >= 1;

# Actions cannot start with -
if (defined $action
    and $action =~ /^-/) {
    unshift @ARGV, $action;
    $action = '';
}

$action = '' unless defined $action;

# Ok. Now it's time to do the action.
our $uri = strip_ws($cfg{$c_sec}{'uri'}) || 'urn:/VUser';
our $proxy = strip_ws($cfg{$c_sec}{'proxy'});
our $service = strip_ws($cfg{$c_sec}{'service'});

my $soap;
if ($service) {
    $log->log (LOG_INFO, "Attempting to connect to $service");
    $soap = SOAP::Lite->service($service);
} else {
    $log->log (LOG_INFO, "Attempting to connect to $proxy for $uri");
    $soap = SOAP::Lite
    -> uri ($uri)
    -> proxy ($proxy);
}

$log->log (LOG_DEBUG, "Credentials: %s, %s", $username, defined $password? $password : 'undef');

# Log sends back info in the SOAP headers including a ticket that
# is sent back through the headers for the other task functions
if ($debug) {
    use Data::Dumper; print Dumper $soap;
}
my $authinfo = $soap
    #SOAP::Lite->service($service)
    -> login ($username, $password)
    ;# -> result;
    
if ($debug) {
    use Data::Dumper; print Dumper $authinfo;
    $log->log (LOG_DEBUG, "Login: $authinfo");
}

if (not $authinfo) {
    die "Invalid login\n";
}

if ($keyword eq 'help') {
    show_help($action);
} else {
    my %opts = create_opts($keyword, $action);
    ## Now translate the options into SOAP::Data objects in a magical way
    my @params = hash2soap(%opts);
    if ($debug) {
        print "SOAP params: ";
        use Data::Dumper; print Dumper \@params;
    }
    # Do action
    my $soap_auth = SOAP::Header->name("authinfo", $authinfo);
    #my $soap_auth = SOAP::Data->name("authinfo", $authinfo);
    
    my $call = #$soap
        SOAP::Lite->uri($uri)->proxy($proxy)
	   -> call("$keyword\_$action", $soap_auth, @params);
	if ($debug) {
	    print "\$call: "; use Data::Dumper; print Dumper $call;
	}
	
	my @results = $call->valueof("//results");
	#my @results = $call->paramsout();
	if ($debug > 1) {
	    print "RS: "; use Data::Dumper; print Dumper \@results;
	}
	
	display_resultSet(@results);
}

sub display_resultSet {
    my @results = @_;
    $log->log(LOG_DEBUG, "Displaying ResultSet");
    foreach my $result (@results) {
        if ($debug > 2) {
            print '$result: ';
            use Data::Dumper; print Dumper $result;
        }
        # Psuedo-hashes here ---v
        # {'ResultSet'} is a []
        my $result_sets = $result->{'results'}{'ResultSet'};
        my $sets;
        if (ref $result_sets eq 'ARRAY') {
            $sets = $result_sets;
        } else {
            $sets = [$result_sets];
        }
        foreach my $rs (@$sets) { 
            my $cols = $rs->{'columns'}{'item'};
            my $values = $rs->{'values'}{'item'};
            my @rows = ();
            if ($debug > 2) {
                print '$values: ';
                use Data::Dumper; print Dumper $values;
            }
            if (ref $values eq 'HASH') {
                push @rows, $values;
            } elsif (ref $values eq 'ARRAY') {
                @rows = @{ $values };
            }
            if ($debug > 2) {
                print '$rows: ';
                use Data::Dumper; print Dumper \@rows;
            }
            for (my $i = 0; $i < @rows; $i++) {
                print "\n" if ($i > 0);
                for (my $j = 0; $j < @$cols; $j++) {
                    #use Data::Dumper; print Dumper $rows[$i];
                    printf("%s: %s\n", $cols->[$j], $rows[$i]{'item'}[$j]);
                }
            }
        }
    }
}

sub hash2soap {
    my %opts = @_;
    
    my @params = ();
    
    foreach my $key (keys %opts) {
        my $data = SOAP::Data->name($key => $opts{$key});
        push @params, $data;
    }
    
    return @params;
}

sub show_help
{
    my $keyword = shift;

    if (not $keyword) {
	   my @keywords = #$soap
	       SOAP::Lite->uri($uri)->proxy($proxy)
	       -> call ('get_keywords', SOAP::Header->new(authinfo => $authinfo))
	       -> valueof('//keywords');
	   
	   if ($debug) {
	       print "Keywords: ";
	       use Data::Dumper; print Dumper \@keywords;
	   }
	   
	   foreach my $key (@keywords) {
	       #if ($debug) { print "Key: "; use Data::Dumper; print Dumper $key; }
	       my $descr = $key->{description} || 'No description';
	       printf ("%8s - %s\n", $key->{keyword}, $descr);
	   }
    } else {
	    print "Options marked with '*' are required.\n";

        if ($debug) {
            use Data::Dumper; print Dumper $soap;
            $log->log(LOG_DEBUG, "Service: %s / %s", $service, $soap->service);
        }

	   my @actions = #$soap
	       #SOAP::Lite->service($service)
	       SOAP::Lite->uri($uri)->proxy($proxy)
           -> call ('get_actions', SOAP::Header->name(authinfo => $authinfo),
	                      SOAP::Data->name('keyword' => $keyword))
	       -> valueof('//actions');
	   if ($debug) {
	       print '@actions: ';
	       use Data::Dumper; print Dumper \@actions;
	   }
	   foreach my $action (@actions) {
	       my $descr = $action->{description} || 'No description';
	       printf ("%8s - %s\n", $action->{action}, $descr);
	       my @options = #$soap
	           SOAP::Lite->uri($uri)->proxy($proxy)
		       -> call ('get_options', SOAP::Header->new(authinfo => $authinfo),
		                      SOAP::Data->name('keyword' => $keyword),
		                      SOAP::Data->name('action' => $action->{action}))
		       -> valueof('//options');
	       foreach my $option (@options) {
	           next if $option eq '';
		       my $descr = $option->{description} || 'No description';
		       printf("\t%-16s %s - %s\n",
		              "--".$option->{option},
		              ($option->{required}? '*': ' '),
		              $descr);
	       }
	   }
    }
}

# Create options from meta data and options list.
sub create_opts
{
    my $keyword = shift;
    my $action = shift;

    $log->log(LOG_DEBUG, "Creating options for $keyword | $action");

    my @options = #$soap
        SOAP::Lite->uri($uri)->proxy($proxy)
        -> get_options (SOAP::Header->name('authinfo' => $authinfo),
	                    SOAP::Data->name('keyword' => $keyword),
	                    SOAP::Data->name('action' => $action)
	                    )
        -> valueof('//options');

    if ($debug) {
        print "Raw options: ";
        use Data::Dumper; print Dumper \@options;
    }

    # This should be the same (or very similar to) what's done in
    # VUser::ExtHandler
    my %opts = ();
    my @opt_defs = ();

    foreach my $opt (@options) {
        next if $opt eq '';
	   my $gopt_type = '';

	   my $type = $opt->{type};
	   if ($type eq 'string') {
	       $gopt_type = '=s';
	   } elsif ($type eq 'integer') {
	       $gopt_type = '=i';
	   } elsif ($type eq 'counter') {
	       $gopt_type = '+';
	   } elsif ($type eq 'boolean') {
	       $gopt_type = '!';
	   } elsif ($type eq 'float') {
	       $gopt_type = '=f';
	   }

	   my $def = $opt->{option}.$gopt_type;
	   push @opt_defs , $def;
    }

    if (@opt_defs) {
	   GetOptions(\%opts, @opt_defs);
    }
    return %opts;
}
    
__END__

=head1 NAME

vsoapd - vuser SOAP daemon.

=head1 SYNOPSIS

=head1 OPTIONS

=head1 DESCRIPTION

=head1 CONFIGURATION

 [vsoapc] 
 # Server to connect to. The protocol must match the transport
 # used by the vsoapd server. (vsoapd defaults to HTTP.)
 proxy = http://localhost:8000/