# Common client routines. =head1 COPYRIGHT This file is part of RemoteBOINC. Copyright (C) 2010 Toni Giorgino, Universitat Pompeu Fabra RemoteBOINC is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. RemoteBOINC is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with BOINC. If not, see . =cut # $Id$ use XML::Simple; use LWP::UserAgent; use vars qw($verbose); use strict; # Request the remote DAV address. Dies on failure. sub getDavUrl { my $cgi_url=shift; my $ua = new LWP::UserAgent; my $response = $ua->post( $cgi_url, { action => 'get_dav_url' }); if($response->is_success) { my $content = $response->content; logInfo("Response received for DAV:\n$content\n",1); my $ch=XMLin($content); my $du=$ch->{DavUrl}; if(!$du) { die "Error getting DAV address"; } return $du; } else { my $reason=$response->status_line; die "Error in getting DAV address from remote: $reason. Server may be down.\n"; } } # Request the wu template for a specific app (used to extract cli # arguments). Dies on failure. sub getWuTemplate { my $cgi_url=shift; my $app=shift; my $ua = new LWP::UserAgent; my $response = $ua->post( $cgi_url, { action => 'get_wu_template', application => $app }); if($response->is_success) { my $content = $response->content; logInfo("Response received for template:\n$content\n",1); # fixup the template, which lacks the root element my $ch=XMLin($content, ForceArray => ["file_info"] ); if($ch->{Failure}) { my $reason=$ch->{Failure}->{Reason}; die "Error in getting WU template remote: $reason.\n". "You may have selected a non-configured application"; } return $ch; } else { my $reason=$response->status_line; die "Error in getting template from remote: $reason. Server may be down.\n"; } } # Extract parameter list from the template (in no particular order) sub parseWuTemplate { my $t=shift; my $p={}; if(!($t->{WuTemplate}->{rboinc}->{application})) { die "Not a remote-enabled application."; } # reference to array of file_info. Each element is a hash of number and rboinc my @fi=@{$t->{WuTemplate}->{workunit}->{file_ref}}; foreach my $fn (@fi) { my $pname=$fn->{rboinc}->{parameter_name}; my $pdesc=$fn->{rboinc}->{parameter_description} || "(undocumented)"; my $poptional=$fn->{rboinc}->{optional}; if($pname) { $p->{$pname}={ description=>$pdesc, optional=>$poptional } } } return $p; } # Parse result name and split into components sub parseResultName { my $n=shift; my ($name,$user,$group,$step,$maxsteps,$rnd,$ext) = ($n=~/^(.+)-(.+)_(.+)-(.+)-(.+)-(.+)_(.+)$/); my $r={ name => $name, user => $user, group => $group, step => $step, maxsteps => $maxsteps, rnd => $rnd, ext => $ext }; return $r; } # Check if the given files (as list) are all readable. sub checkReadableFiles { my $l=shift; foreach my $f (@$l) { if(! -r $f) { print STDERR "File $f is not readable. Exiting.\n"; return 0; } } return 1; } # Unused sub waitKey { my $tmp=<>; } # Print on STDOUT if the $verbose global variable is defined. # 1st arg: message; 2nd arg: whether to print separator lines. sub logInfo { my $msg=shift; my $lines=shift; my $in=""; my $out=""; if(defined $lines) { $in="vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv\n"; $out="^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^"; } if($verbose) { print "$in$msg$out\n"; } } # http://www.devdaily.com/perl/edu/articles/pl010005/pl010005.shtml #----------------------------( promptUser )-----------------------------# # # # FUNCTION: promptUser # # # # PURPOSE: Prompt the user for some type of input, and return the # # input back to the calling program. # # # # ARGS: $promptString - what you want to prompt the user with # # $defaultValue - (optional) a default value for the prompt # # # #-------------------------------------------------------------------------# sub promptUser { #-------------------------------------------------------------------# # two possible input arguments - $promptString, and $defaultValue # # make the input arguments local variables. # #-------------------------------------------------------------------# my ($promptString,$defaultValue) = @_; #-------------------------------------------------------------------# # if there is a default value, use the first print statement; if # # no default is provided, print the second string. # #-------------------------------------------------------------------# if ($defaultValue) { print $promptString, "[", $defaultValue, "]: "; } else { print $promptString, ": "; } $| = 1; # force a flush after our print $_ = ; # get the input from STDIN (presumably the keyboard) #------------------------------------------------------------------# # remove the newline character from the end of the input the user # # gave us. # #------------------------------------------------------------------# chomp; #-----------------------------------------------------------------# # if we had a $default value, and the user gave us input, then # # return the input; if we had a default, and they gave us no # # no input, return the $defaultValue. # # # # if we did not have a default value, then just return whatever # # the user gave us. if they just hit the key, # # the calling routine will have to deal with that. # #-----------------------------------------------------------------# if ("$defaultValue") { return $_ ? $_ : $defaultValue; # return $_ if it has a value } else { return $_; } } 1;