Open MPI logo

MTT Devel Mailing List Archives

  |   Home   |   Support   |   FAQ   |   all MTT Devel mailing list

Subject: Re: [MTT devel] [MTT svn] svn:mtt-svn r1481 - in trunk: client lib/MTT/Reporter
From: Jeff Squyres (jsquyres_at_[hidden])
Date: 2012-08-06 07:25:45


Sweet.

On Aug 6, 2012, at 2:42 AM, Mike Dubman wrote:

> sure, it is already in the trunk - we are polishing the whole use-case and once working fine - will add some docs.
>
> On Sat, Aug 4, 2012 at 7:40 PM, Jeff Squyres (jsquyres) <jsquyres_at_[hidden]> wrote:
> Sounds sweet!
>
> Will you guys be contributing This stuff, perchance?
>
> Sent from my phone. No type good.
>
> On Aug 4, 2012, at 11:56 AM, "Mike Dubman" <mike.ompi_at_[hidden]> wrote:
>
>> Hi,
>>
>> We are switching from datastore (feature we added a couple of years ago) to MongoDB NoSQL DB to keep mtt results.
>>
>> We are adding some "regression" capability based on MTT and MongoDB reporter:
>>
>> - run mtt
>> - when mtt finishes, extract results for previous runs of the same test with same parameters
>> - compare performance metrics and generate regression report (excel)
>> - attach regression report to the mtt email report
>>
>> So, we are adding all lego-like utils to support this:
>>
>> - save results to OO storage (for comfort using from Perl)
>> - create Analyzers for various well-known tests
>> - query results, group them and generate regression statistics, place report into excel (mongo-query.pl)
>> - Generate report which can be attached to mtt report (breport.pl)
>>
>>
>> So, we have reporter and query tool for Mongo, which is simple and customizable.
>>
>> regards
>> M
>>
>>
>> On Wed, Aug 1, 2012 at 2:00 PM, Jeff Squyres <jsquyres_at_[hidden]> wrote:
>> Mike --
>>
>> MongoDB is a NoSQL thingy, right?
>>
>> Can you describe this plugin a bit? Do you guys have some kind of reporter for MongoDB?
>>
>>
>> On Aug 1, 2012, at 5:46 AM, <svn-commit-mailer_at_[hidden]> wrote:
>>
>> > Author: miked (Mike Dubman)
>> > Date: 2012-08-01 05:46:03 EDT (Wed, 01 Aug 2012)
>> > New Revision: 1481
>> > URL: https://svn.open-mpi.org/trac/mtt/changeset/1481
>> >
>> > Log:
>> > add modified version mongobquery and MTTMongodb
>> >
>> > Added:
>> > trunk/client/mongobquery.pl (contents, props changed)
>> > trunk/lib/MTT/Reporter/MTTMongodb.pm
>> >
>> > Added: trunk/client/mongobquery.pl
>> > ==============================================================================
>> > --- /dev/null 00:00:00 1970 (empty, because file is newly added)
>> > +++ trunk/client/mongobquery.pl 2012-08-01 05:46:03 EDT (Wed, 01 Aug 2012) (r1481)
>> > @@ -0,0 +1,1018 @@
>> > +#!/usr/bin/perl
>> > +#
>> > +# Copyright (c) 2009
>> > +# $COPYRIGHT$
>> > +#
>> > +# Additional copyrights may follow
>> > +#
>> > +# $HEADER$
>> > +#
>> > +# Now that @INC is setup, bring in the modules
>> > +
>> > +#use strict;
>> > +#use warnings;
>> > +use LWP::UserAgent;
>> > +use HTTP::Request::Common;
>> > +use Data::Dumper;
>> > +use File::Basename;
>> > +use File::Temp;
>> > +use Config::IniFiles;
>> > +use YAML::XS;
>> > +use MongoDB;
>> > +use MongoDB::OID;
>> > +use YAML;
>> > +use YAML::Syck;
>> > +use DateTime;
>> > +
>> > +###########################################################
>> > +# Set variables
>> > +###########################################################
>> > +my $module_name=$0;
>> > +my $module_path=$0;
>> > +
>> > +$module_name=~s/([^\/\\]+)$//;
>> > +$module_name=$1;
>> > +
>> > +$module_path=~s/([^\/\\]+)$//;
>> > +
>> > +
>> > +###########################################################
>> > +# Main block
>> > +###########################################################
>> > +use Getopt::Long qw(:config no_ignore_case);
>> > +
>> > +my $opt_help;
>> > +my $opt_server;
>> > +my $opt_username;
>> > +my $opt_password;
>> > +
>> > +my $opt_ping;
>> > +my $opt_upload;
>> > +my $opt_query;
>> > +my $opt_view;
>> > +my $opt_admin;
>> > +
>> > +my @opt_data;
>> > +my @opt_raw;
>> > +
>> > +my $opt_gqls;
>> > +my @opt_gqlf;
>> > +my @opt_section;
>> > +my $opt_dir;
>> > +my $opt_no_raw;
>> > +
>> > +my $opt_dstore;
>> > +my $opt_info;
>> > +my $opt_format;
>> > +my $opt_mailto;
>> > +my $opt_regression_from;
>> > +my $opt_regression_to;
>> > +my $opt_regression_step;
>> > +
>> > +my @opt_newuser;
>> > +
>> > +GetOptions ("help|h" => \$opt_help,
>> > + "server|a=s" => \$opt_server,
>> > + "username|u=s" => \$opt_username,
>> > + "password|p=s" => \$opt_password,
>> > + "ping" => \$opt_ping,
>> > + "upload" => \$opt_upload,
>> > + "query" => \$opt_query,
>> > + "view" => \$opt_view,
>> > + "admin" => \$opt_admin,
>> > +
>> > + "data|S=s" => \@opt_data,
>> > + "raw|R=s" => \@opt_raw,
>> > +
>> > + "gqls|L=s" => \$opt_gqls,
>> > + "gqlf|F=s" => \@opt_gqlf,
>> > + "section|T=s" => \@opt_section,
>> > + "dir|O=s" => \$opt_dir,
>> > + "no-raw" => \$opt_no_raw,
>> > +
>> > + "dstore|D" => \$opt_dstore,
>> > + "info|I=s" => \$opt_info,
>> > + "format|V=s" => \$opt_format,
>> > + "email|e=s" => \$opt_mailto,
>> > +
>> > + "newuser=s{3,5}" => \@opt_newuser,
>> > +
>> > + "regression-from=s" => \$opt_regression_from,
>> > + "regression-to=s" => \$opt_regression_to,
>> > + "regression-step=s" => \$opt_regression_step
>> > + );
>> > +
>> > +
>> > +my $url = ();
>> > +my $username = ();
>> > +my $password = ();
>> > +
>> > +$url = $opt_server ? $opt_server : "http://bgate.mellanox.com:27017";
>> > +$url =~ s/http:\/\///;
>> > +$username = $opt_username ? $opt_username : "admin";
>> > +$password = $opt_password ? $opt_password : "";
>> > +
>> > +my %conf = ('url' => "$url\/client",
>> > + 'username' => $username,
>> > + 'password' => $password
>> > + );
>> > +
>> > +if ($opt_help)
>> > +{
>> > + my $action = '';
>> > +
>> > + $action = 'ping' if ($opt_ping);
>> > + $action = 'upload' if ($opt_upload);
>> > + $action = 'query' if ($opt_query);
>> > + $action = 'view' if ($opt_view);
>> > + $action = 'admin' if ($opt_admin);
>> > +
>> > + help($action);
>> > +
>> > + exit;
>> > +}
>> > +elsif ($opt_ping)
>> > +{
>> > + #ping( \%conf );
>> > + #print $url," url\n";
>> > + my $conn = MongoDB::Connection->new(host => $url );
>> > + if($conn != 0)
>> > + {
>> > + print"\n\nping: success\n\n";
>> > + }
>> > +}
>> > +elsif ($opt_upload)
>> > +{
>> > + if ($#opt_data < 0)
>> > + {
>> > + help('upload');
>> > + }
>> > + my @data = split(/,/,join(',',@opt_data)) if (@opt_data);
>> > + my @raw = split(/,/,join(',',@opt_raw)) if (@opt_raw);
>> > +
>> > + # Check if files existed
>> > + verify_opt_file( @data );
>> > + verify_opt_file( @raw );
>> > +
>> > + $conf{data} = \@data;
>> > + $conf{raw} = \@raw;
>> > +
>> > + upload( \%conf );
>> > +}
>> > +elsif ($opt_query)
>> > +{
>> > + my $gql = ();
>> > + if ($opt_gqls)
>> > + {
>> > + $gql = $opt_gqls;
>> > + }
>> > + else
>> > + {
>> > + help('query');
>> > + }
>> > + #print $gql, " before\n";
>> > + $gql =~ s/\s+/ /g;
>> > + $gql =~ s/ /#/g;
>> > + $gql =~ s/And/AND/g;
>> > + $gql =~ s/and/AND/g;
>> > + $gql =~ s/Or/OR/g;
>> > + $gql =~ s/or/OR/g;
>> > + $gql =~ s/#In#/IN/g;
>> > + $gql =~ s/#in#/IN/g;
>> > + $gql =~ s/Not/NOT/g;
>> > + $gql =~ s/not/NOT/g;
>> > + $gql =~ s/#AND#/ AND /g;
>> > + $gql =~ s/#OR#/ \| /g;
>> > + #$gql =~ s/#IN#/IN/g;
>> > + $gql =~ s/#NOT/NOT/g;
>> > + $gql =~ s/#=#/=/g;
>> > + $gql =~ s/#>#/>/g;
>> > + $gql =~ s/#>=#/>=/g;
>> > + $gql =~ s/#<#/</g;
>> > + $gql =~ s/#<=#/<=/g;
>> > + #print $gql," after\n";
>> > + #exit;
>> > +
>> > + my @date_array;
>> > + if($gql =~ m/=>|=</)
>> > + {
>> > + print "\nError:\nInvalid format: \"=>\" or \"=<\"\nUse \">=\" or \"<=\" instead\n";
>> > + exit;
>> > + }
>> > +
>> > + if($opt_regression_step)
>> > + {
>> > + if($opt_regression_step =~ m/^\d{4}-\d{2}-\d{2}$/)
>> > + {
>> > + #print "ok $opt_regression_step \n";
>> > + }else
>> > + {
>> > + die "\nparametr \"regression-step\" has invalid format. YYYY-MM-DD\nexample --regression-step=\'0000-01-03\'";
>> > + }
>> > +
>> > + if($gql =~ m/TestRunPhase\.start_time/)
>> > + {
>> > + $str_start_time = $';
>> > + if($str_start_time =~ m/\d{4}-\d{2}-\d{2}#\d{2}:\d{2}:\d{2}/)
>> > + {
>> > + $str_start_time = $&;
>> > + }else
>> > + {
>> > + die "synrax error";
>> > + }
>> > + }else
>> > + {
>> > + die "syntax error";
>> > + }
>> > +
>> > + if($gql =~ m/TestRunPhase\.end_time/)
>> > + {
>> > + $str_end_time = $';
>> > + if($str_end_time =~ m/\d{4}-\d{2}-\d{2}#\d{2}:\d{2}:\d{2}/)
>> > + {
>> > + $str_end_time = $&;
>> > + }else
>> > + {
>> > + die "syntax error";
>> > + }
>> > + }else
>> > + {
>> > + die "syntax error";
>> > + }
>> > +
>> > + #print "start_time $str_start_time end_time $str_end_time \n";
>> > +
>> > + my $timezone = DateTime->now;
>> > +
>> > + @numbers = split(/:|-|#/,$str_start_time);
>> > + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
>> > + my %hash_start_time = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> $timezone->time_zone());
>> > + my $DateTime_start_time = DateTime->new(%hash_start_time);
>> > +
>> > + @numbers = split(/:|-|#/,$str_end_time);
>> > + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
>> > + my %hash_end_time = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> $timezone->time_zone());
>> > + my $DateTime_end_time = DateTime->new(%hash_end_time);
>> > +
>> > +
>> > + print "\n\nacceptable dates:\n";
>> > + my $count = 1;
>> > + my @arg_to_subtract = split(/-/,$opt_regression_step);
>> > + #print "\n\n_at_arg_to_subtract\n\n";
>> > + while(DateTime->compare( $DateTime_start_time, $DateTime_end_time )!=1)
>> > + {
>> > +
>> > + $DateTime_end_time->subtract(years=> @arg_to_subtract[0],months=>@arg_to_subtract[1],days =>@arg_to_subtract[2]);
>> > + my $month = $DateTime_end_time->month();
>> > + my $day = $DateTime_end_time->day();
>> > + if(!($day =~ m/\d{2}/))
>> > + {
>> > + $day = "0".$day;
>> > + }
>> > + if(!($month =~ m/\d{2}/))
>> > + {
>> > + $month = "0".$month;
>> > + }
>> > + $str = $DateTime_end_time->year() . "-" . $month . "-" . $day;
>> > + push(@date_array,$str);
>> > + print "$str ";
>> > + if($count % 7 == 0)
>> > + {
>> > + print"\n";
>> > + }
>> > + $count++;
>> > +
>> > + }
>> > + #print"\n\n @date_array\n\n";
>> > + }
>> > + #print "hash start_time ", $DateTime_start_time, " hash end_time ", $DateTime_end_time, "\n";
>> > + #print "time zone ",$timezone,"\n";
>> > +
>> > + my $query_to_mongo = string2query($gql);
>> > + $query_to_mongo .= ";";
>> > + print "\n\n**********************************************************************query to mongo*************************************************************************";
>> > + print "\n",$query_to_mongo,"\n";
>> > + print "*************************************************************************************************************************************************************\n";
>> > + ######################################################################
>> > + #mongo
>> > + #######################################################################
>> > + my $conn = MongoDB::Connection->new(host => $url);
>> > + my $db = $conn->mtt;
>> > + my $mtt_result = $db->TestRunPhase;
>> > + my $all_result = $mtt_result->find(eval $query_to_mongo);
>> > + my $i = 0;
>> > + if($opt_regression_step)
>> > + {
>> > + while (my $doc = $all_result->next)
>> > + {
>> > + if($doc->{"modules"}->{"TestRunPhase"}->{"start_time"} =~ m/\d{4}-\d{2}-\d{2}/)
>> > + {
>> > + if ($& ~~ @date_array)
>> > + {
>> > + open F, '>', "$i.yaml";
>> > + print F YAML::Syck::Dump( $doc );
>> > + close F;
>> > + $i++;
>> > + }
>> > + }
>> > + else
>> > + {
>> > + die "something strange happened";
>> > + }
>> > +
>> > + }
>> > + }else
>> > + {
>> > + while (my $doc = $all_result->next)
>> > + {
>> > +
>> > + open F, '>', "$i.yaml";
>> > + print F YAML::Syck::Dump( $doc );
>> > + close F;
>> > + $i++;
>> > + }
>> > +
>> > + }
>> > + print "found $i documents\n";
>> > + ######################################################################
>> > + #mongo
>> > + ######################################################################
>> > +
>> > +}
>> > +elsif ($opt_view)
>> > +{
>> > + if ($opt_gqls)
>> > + {
>> > + # $conf{gql} = $opt_gqls;
>> > + }
>> > + elsif (@opt_gqlf && @opt_section && (@opt_gqlf == @opt_section))
>> > + {
>> > + # my $gql = ();
>> > + # my @a_select;
>> > + # my $v_from;
>> > + # my @a_where;
>> > + # my @a_order;
>> > + # my $v_limit;
>> > + # my $v_offset;
>> > + # my $i = 0;
>> > + #
>> > + # my @files=split(/,/,join(',',@opt_gqlf)) if (@opt_gqlf);
>> > + # my @sections=split(/,/,join(',',@opt_section)) if (@opt_section);
>> > + #
>> > + # # Check if files existed
>> > + # verify_opt_file( @files );
>> > + #
>> > + # for($i=0; $i < @files; $i++)
>> > + # {
>> > + # # Use ini-file in case it is set in command line
>> > + # my $cfg = new Config::IniFiles( -file => "$files[$i]", -nocase => 1 );
>> > + # if (not defined $cfg or $@)
>> > + # {
>> > + # die "$!";
>> > + # }
>> > + # $opt_format = $cfg->val("$sections[$i]", 'format') if ($cfg->val("$sections[$i]", 'format'));
>> > + #
>> > + # my @a_temp_select = $cfg->val("$sections[$i]", 'select') if ($cfg->val("$sections[$i]", 'select'));
>> > + # my $v_temp_from = $cfg->val("$sections[$i]", 'from') if ($cfg->val("$sections[$i]", 'from'));
>> > + # my @a_temp_where = $cfg->val("$sections[$i]", 'where') if ($cfg->val("$sections[$i]", 'where'));
>> > + # my @a_temp_order = $cfg->val("$sections[$i]", 'order') if ($cfg->val("$sections[$i]", 'order'));
>> > + # my $v_temp_limit = $cfg->val("$sections[$i]", 'limit') if ($cfg->val("$sections[$i]", 'limit'));
>> > + # my $v_temp_offset = $cfg->val("$sections[$i]", 'offset') if ($cfg->val("$sections[$i]", 'offset'));
>> > +
>> > + # @a_select = @a_temp_select if ($#a_temp_select != (-1));
>> > + # $v_from = $v_temp_from if ($v_temp_from);
>> > + # my $j = 0;
>> > + # my $k = 0;
>> > + # for ($j = 0; $j < scalar(@a_where); $j++)
>> > + # {
>> > + # for ($k = 0; $k < scalar(@a_temp_where); $k++)
>> > + # {
>> > + # if ($a_temp_where[$k])
>> > + # {
>> > + # $a_temp_where[$k] =~ m/^\s*(\w+)/i;
>> > + # if (grep /^\s*$1/, $a_where[$j])
>> > + # {
>> > + # $a_where[$j] = $a_temp_where[$k];
>> > + # delete($a_temp_where[$k]);
>> > + # next;
>> > + # }
>> > + # }
>> > + # }
>> > + # }
>> > + # foreach (@a_temp_where)
>> > + # {
>> > + # push(@a_where, $_) if ($_);
>> > + # }
>> > + #
>> > + # @a_order = @a_temp_order if ($#a_temp_order != (-1));
>> > + # $v_limit = $v_temp_limit if ($v_temp_limit);
>> > + # $v_offset = $v_temp_offset if ($v_temp_offset);
>> > + # }
>> > + #
>> > + # $gql = '';
>> > + # $gql .= ' select ' . join(',',@a_select) if (@a_select);
>> > + # $gql .= ' from ' . $v_from if ($v_from);
>> > + # $gql .= ' where ' . join(' and ',@a_where) if (@a_where);
>> > + # $gql .= ' order by ' . join(',',@a_order) if (@a_order);
>> > + # $gql .= ' limit ' . $v_limit if ($v_limit);
>> > + # $gql .= ' offset ' . $v_offset if ($v_offset);
>> > + #
>> > + # $conf{gql} = $gql;
>> > + #
>> > +
>> > + print "this feature temporarily unavailable\n";
>> > + exit;
>> > + }
>> > + elsif ($opt_dstore)
>> > + {
>> > + $conf{kind} = 'all';
>> > + }
>> > + elsif ($opt_info)
>> > + {
>> > + $conf{kind} = $opt_info;
>> > + }
>> > + else
>> > + {
>> > + help('view');
>> > + }
>> > +
>> > + if ($opt_format)
>> > + {
>> > + foreach my $format qw(raw txt html yaml)
>> > + {
>> > + $conf{format} = $format if ($opt_format eq $format) ;
>> > + }
>> > + }
>> > + $conf{format} = 'raw' if (!exists($conf{format})) ;
>> > +
>> > + view( \%conf );
>> > +}
>> > +elsif ($opt_admin)
>> > +{
>> > +
>> > + print "this feature temporarily unavailable\n";
>> > + exit;
>> > + #if ($#opt_newuser > 0)
>> > + #{
>> > + # $conf{newuser} = \@opt_newuser;
>> > + #}
>> > + #admin( \%conf );
>> > +}
>> > +else
>> > +{
>> > + help();
>> > + exit;
>> > +}
>> > +
>> > +
>> > +# Send notification by e-mail
>> > +if ( $opt_mailto ) {
>> > +# send_results_by_mail($opt_mailto, @files);
>> > +}
>> > +
>> > +
>> > +###############################################################################
>> > +# Define functions
>> > +###############################################################################
>> > +
>> > +###############################################################################
>> > +#
>> > +#convert string to query
>> > +#
>> > +###############################################################################
>> > +
>> > +sub string2query
>> > +{
>> > + my $gql = $_[0];
>> > + my $before;
>> > + my $after;
>> > + my $match_case;
>> > + while($gql =~ m/\([^\(\)]+(=|>=|<=|<|>|IN\([^\(\)]+\))+[^\(\)]+\)/)
>> > + {
>> > + $before = $`;
>> > + $after = $';
>> > + $match_case = $&;
>> > + chop($match_case);
>> > + $match_case = reverse($match_case);
>> > + chop($match_case);
>> > + $match_case = reverse($match_case);
>> > + #print "() before: ",$before," after: ",$after," match case: ",$match_case,"\n";
>> > + #<STDIN>;
>> > + $gql = $before . string2query($match_case) . $after;
>> > + #print "gql after: ",$gql,"\n";
>> > + }
>> > + if($gql =~ m/\|/ && $gql =~ m/AND/)
>> > + {
>> > +
>> > + while($gql =~ m/[^\|]+(AND)+[^\|]+/)
>> > + {
>> > + $before = $`;
>> > + $after = $';
>> > + $match_case = $&;
>> > + #chop($match_case);
>> > + #$match_case = reverse($match_case);
>> > + #chop($match_case);
>> > + #$match_case = reverse($match_case);
>> > +
>> > + #print "AND OR before: ",$before," after: ",$after," match case: ",$match_case,"\n";
>> > + #<STDIN>;
>> > + $gql = $before . string2query($match_case) . $after;
>> > + #print "gql after: ",$gql,"\n";
>> > + }
>> > + }
>> > +
>> > + #print "lowest level: ",$gql,"\n";
>> > + #<STDIN>;
>> > + $gql = string2query_lowest($gql);
>> > + #print "gql after: ",$gql,"\n";
>> > +
>> > + return $gql;
>> > +}
>> > +
>> > +###############################################################################
>> > +#
>> > +#convert string to query (lowest level)
>> > +#
>> > +###############################################################################
>> > +sub string2query_lowest
>> > +{
>> > + my $input_string = $_[0];
>> > + my @subs = split(/\s/,$input_string);
>> > + my $arg;
>> > + my $query_to_mongo = " {";
>> > + my $before;
>> > + my $after;
>> > + my $match_case;
>> > + #my $prefix = "modules.TestRunPhase.";
>> > + my $prefix = "modules.";
>> > + if($input_string =~ m/AND/ && $input_string =~ m/\|/)
>> > + {
>> > + print "error: bquery lowest level\n";
>> > + print "input string: ",$input_string,"\n";
>> > + die;
>> > + }elsif($input_string =~ m/\|/)
>> > + {
>> > + $query_to_mongo .= "\'\$or\'=>[";
>> > + }else
>> > + {
>> > + $query_to_mongo .= "\'\$and\'=>[";
>> > + }
>> > + foreach $arg(@subs)
>> > + {
>> > + #print $arg," subs\n";
>> > + }
>> > + foreach $arg(@subs)
>> > + {
>> > + $arg =~ s/#/ /g;
>> > +
>> > + if($arg =~m/>=|<=|NOTIN/)
>> > + {
>> > + #print "before match: ", $before,", after match: ",$after," match case: ",$match_case,"\n";
>> > + $before ="{\'$prefix" . $` . "\'=>";
>> > + $after = $';
>> > + $match_case = $&;
>> > + if($match_case eq ">=")
>> > + {
>> > + #print "bolshe ili ravno\n";
>> > + $query_to_mongo .= $before . "{\'\$gte\'=>" . $after . "}},";
>> > +
>> > + }elsif($match_case eq "<=")
>> > + {
>> > + #print "menshe ili ravno\n";
>> > + $query_to_mongo .= $before . "{\'\$lte\'=>" . $after . "}},";
>> > +
>> > + }else
>> > + {
>> > + #print "NIN\n";
>> > + $after =~ s/\(/\[/g;
>> > + $after =~ s/\)/\]/g;
>> > + $query_to_mongo .= $before . "{\'\$nin\'=>" . $after . "}},";
>> > + }
>> > + }
>> > + elsif($arg =~ m/{.+=>.+}/)
>> > + {
>> > + $query_to_mongo .= $arg . ",";
>> > + }
>> > + elsif($arg =~ m/>|=|<|IN/)
>> > + {
>> > + #print "before match1: ", $before," after match: ",$after," match case: ",$match_case,"\n";
>> > +
>> > + $before ="{\'$prefix" . $` . "\'=>";
>> > + $after = $';
>> > + $match_case = $&;
>> > +
>> > + if($match_case eq ">")
>> > + {
>> > + #print "bolshe\n";
>> > + $query_to_mongo .= $before . "{\'\$gt\'=>" . $after . "}},";
>> > +
>> > + }elsif($match_case eq "=")
>> > + {
>> > + #print "ravno\n";
>> > + $query_to_mongo .= $before . $after ."},";
>> > + }elsif($match_case eq "<")
>> > + {
>> > + #print "menshe\n";
>> > + $query_to_mongo .= $before . "{\'\$lt\'=>" . $after . "}},";
>> > + }
>> > + else
>> > + {
>> > + #print "IN\n";
>> > + $after =~ s/\(/\[/g;
>> > + $after =~ s/\)/\]/g;
>> > + $query_to_mongo .= $before . "{\'\$in\'=>" . $after . "}},";
>> > + }
>> > + }
>> > + }
>> > + chop($query_to_mongo);
>> > + $query_to_mongo .= "]} ";
>> > + return $query_to_mongo;
>> > +}
>> > +
>> > +###############################################################################
>> > +#
>> > +# Show help to tool
>> > +#
>> > +###############################################################################
>> > +sub help
>> > +{
>> > + my ($action)=@_;
>> > +
>> > + print ("Usage: $module_name [options...] <action> [arguments...]\n");
>> > + print ("\'$module_name\' communicate with datastore .\n\n");
>> > +
>> > + print ("\nOptions:\n");
>> > + printf (" %-5s %-10s\t%-s\n", '-h,', '--help', "Show the help message and exit.");
>> > + printf (" %-5s %-10s\t%-s\n", '-a,', '--server', "The server to connect to.");
>> > + printf (" %-5s %-10s\t%-s\n", '-u,', '--username', "User name.");
>> > + printf (" %-5s %-10s\t%-s\n", '-p,', '--password', "Password.");
>> > +
>> > + print ("\nActions:\n");
>> > +
>> > + if (!defined($action) || $action eq '' || $action eq 'ping')
>> > + {
>> > + print (" --ping\t The 'ping' command check connection with datastore.\n");
>> > + }
>> > + if (!defined($action) || $action eq '' || $action eq 'upload')
>> > + {
>> > + print (" --upload\t The 'upload' command translates input data into datastore entities and uploads them into your application's datastore.\n");
>> > + }
>> > + if (!defined($action) || $action eq '' || $action eq 'query')
>> > + {
>> > + print (" --query\t The 'query' command translates input string in special request to datastore and download data form query set.\n");
>> > + }
>> > + if (!defined($action) || $action eq '' || $action eq 'view')
>> > + {
>> > + print (" --view\t The 'view' command requests information from datastore.\n");
>> > + }
>> > + if (!defined($action) || $action eq '' || $action eq 'admin')
>> > + {
>> > + print (" --admin\t The 'admin' admin of datastore operations.\n");
>> > + }
>> > +
>> > + print ("\nArguments:\n");
>> > +
>> > + if (!defined($action) || $action eq '' || $action eq 'upload')
>> > + {
>> > + printf (" %-5s %-10s\t%-s\n", '-S,', '--data', "The name of the file containing the data to upload.");
>> > + printf (" %-5s %-10s\t%-s\n", '-R,', '--raw', "Raw file associated with data.");
>> > + }
>> > + if (!defined($action) || $action eq '' || $action eq 'query')
>> > + {
>> > + printf (" %-5s %-10s\t%-s\n", '-L,', '--gqls', "String with GQL query.");
>> > + printf (" %-5s %-10s\t%-s\n", '-F,', '--gqlf', "The path to file inclusive query.");
>> > + printf (" %-5s %-10s\t%-s\n", '-T,', '--section', "Section of configuration file with query.");
>> > + printf (" %-5s %-10s\t%-s\n", '-O,', '--dir', "The path to the directory that will store retrieved data.");
>> > + printf (" %-5s %-10s\t%-s\n", '', '--no-raw', "Don't download Raw file associated with data.");
>> > + }
>> > + if (!defined($action) || $action eq '' || $action eq 'view')
>> > + {
>> > + printf (" %-5s %-10s\t%-s\n", '-D,', '--dstore', "Retrieve Google Data store detailed organization with names of models and properties.");
>> > + printf (" %-5s %-10s\t%-s\n", '-I,', '--info', "Show information about clusters, compilers, bench applications and mpi. One of following as 'suite','mpi','compiler','cluster'");
>> > + printf (" %-5s %-10s\t%-s\n", '-L,', '--gqls', "String with GQL query.");
>> > + printf (" %-5s %-10s\t%-s\n", '-F,', '--gqlf', "The path to file inclusive query.");
>> > + printf (" %-5s %-10s\t%-s\n", '-T,', '--section', "Section of configuration file with query.");
>> > + printf (" %-5s %-10s\t%-s\n", '-V,', '--format', "Output format. One of following as 'txt','html','yaml','raw'. Default is 'raw'");
>> > + }
>> > + if (!defined($action) || $action eq '' || $action eq 'admin')
>> > + {
>> > + printf (" %-5s %-10s\t%-s\n", '', '--newuser', "User information as username, password, email (mandatory) and first_name, last_name (optinal). Keep order");
>> > + }
>> > + printf (" %-5s %-10s\t%-s\n", '-e,', '--email', "e-mail address");
>> > +
>> > + exit;
>> > +}
>> > +
>> > +
>> > +###############################################################################
>> > +#
>> > +# Check if files directed in command line exists
>> > +#
>> > +###############################################################################
>> > +sub verify_opt_file
>> > +{
>> > + my (@files)=@_;
>> > + foreach my $file (@files)
>> > + {
>> > + if( ! -e $file)
>> > + {
>> > + die "$file doesn't exist!";
>> > + }
>> > + }
>> > +}
>> > +
>> > +
>> > +###############################################################################
>> > +#
>> > +# Ping procedure
>> > +#
>> > +###############################################################################
>> > +sub ping
>> > +{
>> > + my ($conf_ref)=@_;
>> > +
>> > + my $ua = LWP::UserAgent->new();
>> > + $ua->agent("mtt-submit");
>> > + $ua->proxy('http', $ENV{'http_proxy'});
>> > +
>> > + my $request = POST(
>> > + $conf_ref->{url},
>> > + Content_Type => 'form-data',
>> > + Content => [
>> > + PING => 1,
>> > + description => 'bquery ping'
>> > + ]);
>> > +
>> > + $request->authorization_basic($conf_ref->{username}, $conf_ref->{password});
>> > +
>> > + my $response = $ua->request($request);
>> > +
>> > + print "Error at $conf_ref->{url}\n ", $response->status_line, "\n"
>> > + unless $response->is_success;
>> > + print "content type at $conf_ref->{url} -- ", $response->content_type, "\n"
>> > + unless $response->content_type eq 'text/html';
>> > +
>> > + print $response->content;
>> > +}
>> > +
>> > +
>> > +###############################################################################
>> > +#
>> > +# Upload procedure
>> > +#
>> > +###############################################################################
>> > +sub upload
>> > +{
>> > + my ($conf_ref)=@_;
>> > + my $i = 0;
>> > + use MongoDB;
>> > + use MongoDB::OID;
>> > + use YAML;
>> > + use Data::Dumper;
>> > + use YAML::XS;
>> > + my $conn = MongoDB::Connection->new(host => 'bgate.mellanox.com:27017');
>> > + my $db = $conn->mtt;
>> > + my $TestRunPhase = $db->TestRunPhase;
>> > + for ($i=0; $i<@{$conf_ref->{data}}; $i++)
>> > + {
>> > + my $ua = LWP::UserAgent->new();
>> > + $ua->agent("mtt-submit");
>> > + $ua->proxy('http', $ENV{'http_proxy'});
>> > +
>> > + my $request;
>> > + my $data_file = "$conf_ref->{data}->[$i]" if defined($conf_ref->{data}->[$i]);
>> > + my $raw_file = "$conf_ref->{raw}->[$i]" if defined($conf_ref->{raw}->[$i]);
>> > + if ($raw_file)
>> > + {
>> > + #$request = POST(
>> > + # $conf_ref->{url},
>> > + # Content_Type => 'form-data',
>> > + # Content => [
>> > + # SUBMIT => 1,
>> > + # data => [$data_file],
>> > + # raw => [$raw_file],
>> > + # description => 'MTT Results Submission'
>> > + # ]);
>> > + }
>> > + else
>> > + {
>> > + print "load $data_file\n";
>> > + open my $fh, '<', "$data_file"
>> > + or die "can't open config file: $!";
>> > + my $f_hash = LoadFile($fh);
>> > + #print Dumper($f_hash), "\n";
>> > + my $inserted_id = $TestRunPhase->insert($f_hash);
>> > + print "inserted id $inserted_id \n";
>> > + #$request = POST(
>> > + # $conf_ref->{url},
>> > + # Content_Type => 'form-data',
>> > + # Content => [
>> > + # SUBMIT => 1,
>> > + # data => [$data_file],
>> > + # description => 'bquery submit'
>> > + # ]);
>> > + }
>> > +
>> > + #$request->authorization_basic($conf_ref->{username}, $conf_ref->{password});
>> > +
>> > + #my $response = $ua->request($request);
>> > +
>> > + #print "Error at $conf_ref->{url}\n ", $response->status_line, "\n"
>> > + # unless $response->is_success;
>> > + #print "content type at $conf_ref->{url} -- ", $response->content_type, "\n"
>> > + # unless $response->content_type eq 'text/html';
>> > +
>> > + #print $response->content;
>> > + }
>> > +}
>> > +
>> > +
>> > +###############################################################################
>> > +#
>> > +# Query procedure
>> > +#
>> > +###############################################################################
>> > +sub query
>> > +{
>> > + my ($conf_ref)=@_;
>> > +
>> > + my $ua = LWP::UserAgent->new();
>> > + $ua->agent("mtt-submit");
>> > + $ua->proxy('http', $ENV{'http_proxy'});
>> > +
>> > + my $request = POST(
>> > + $conf_ref->{url},
>> > + Content_Type => 'form-data',
>> > + Content => [
>> > + QUERY => 1,
>> > + gql => $conf_ref->{gql},
>> > + raw => $conf_ref->{raw},
>> > + description => 'bquery view'
>> > + ]);
>> > +
>> > + $request->authorization_basic($conf_ref->{username}, $conf_ref->{password});
>> > +
>> > + my $response = $ua->request($request);
>> > +
>> > + die "Error at $conf_ref->{url}\n ", $response->status_line, "\n"
>> > + unless $response->is_success;
>> > + die "content type at $conf_ref->{url} -- ", $response->content_type, "\n"
>> > + unless $response->content_type eq 'text/yaml';
>> > +
>> > + # Load respond into YAML hash
>> > + use YAML::Syck ();
>> > + $YAML::Syck::ImplicitTyping = 1;
>> > + my $temp_str = $response->content;
>> > + my $data = eval {YAML::Syck::Load($temp_str)};
>> > +# use YAML::XS ();
>> > +# my $temp_str = $response->content;
>> > +# my $data = eval {YAML::XS::Load($temp_str)};
>> > + if (not defined $data or $@)
>> > + {
>> > + die "$!";
>> > + }
>> > +
>> > + MTT::Files::mkdir($conf_ref->{dir}) || die "cannot mkdir $conf_ref->{dir}: $!";
>> > +
>> > + my $default_form = {
>> > + product => 'mtt-gds',
>> > + version => "0.1",
>> > + app_id => 'query'
>> > + };
>> > +
>> > + foreach my $respond_form (@{$data->{data}})
>> > + {
>> > + my $filename = "$conf_ref->{dir}\/$respond_form->{key}";
>> > + my $raw_filename = $filename.'.zip';
>> > + $filename = $filename.'.yaml';
>> > +
>> > + my %form = (%$respond_form, %$default_form);
>> > +
>> > + if (int($conf_ref->{raw}) == 1 && exists($form{raw}))
>> > + {
>> > + open(fh_temp, ">$raw_filename") || die "cannot create $raw_filename: $!";
>> > + binmode fh_temp;
>> > + print fh_temp $form{raw};
>> > + close fh_temp;
>> > +
>> > + delete $form{raw};
>> > + }
>> > +
>> > + delete $form{key};
>> > +
>> > + # Generate YAML file contents
>> > + YAML::XS::DumpFile($filename, \%form);
>> > + }
>> > +}
>> > +
>> > +
>> > +###############################################################################
>> > +#
>> > +# View procedure
>> > +#
>> > +###############################################################################
>> > +sub view
>> > +{
>> > + my ($conf_ref)=@_;
>> > +
>> > + my $ua = LWP::UserAgent->new();
>> > + $ua->agent("mtt-submit");
>> > + $ua->proxy('http', $ENV{'http_proxy'});
>> > +
>> > + my $request;
>> > + if (exists($conf_ref->{kind}))
>> > + {
>> > + $request = POST(
>> > + $conf_ref->{url},
>> > + Content_Type => 'form-data',
>> > + Content => [
>> > + VIEW => 1,
>> > + kind => $conf_ref->{kind},
>> > + format => $conf_ref->{format},
>> > + description => 'bquery view'
>> > + ]);
>> > + }
>> > + elsif (exists($conf_ref->{gql}))
>> > + {
>> > + $request = POST(
>> > + $conf_ref->{url},
>> > + Content_Type => 'form-data',
>> > + Content => [
>> > + VIEW => 1,
>> > + gql => $conf_ref->{gql},
>> > + format => $conf_ref->{format},
>> > + description => 'bquery view'
>> > + ]);
>> > + }
>> > +
>> > + $request->authorization_basic($conf_ref->{username}, $conf_ref->{password});
>> > +
>> > + my $response = $ua->request($request);
>> > +
>> > + print "Error at $conf_ref->{url}\n ", $response->status_line, "\n"
>> > + unless $response->is_success;
>> > + print "content type at $conf_ref->{url} -- ", $response->content_type, "\n"
>> > + unless $response->content_type eq 'text/html';
>> > +
>> > + print $response->content;
>> > +}
>> > +
>> > +
>> > +###############################################################################
>> > +#
>> > +# Admin procedure
>> > +#
>> > +###############################################################################
>> > +sub admin
>> > +{
>> > + my ($conf_ref)=@_;
>> > +
>> > + my $ua = LWP::UserAgent->new();
>> > + $ua->agent("mtt-submit");
>> > + $ua->proxy('http', $ENV{'http_proxy'});
>> > +
>> > + my $request;
>> > + if (exists($conf_ref->{newuser}) && $#{$conf_ref->{newuser}} >=2)
>> > + {
>> > + $request = POST(
>> > + $conf_ref->{url},
>> > + Content_Type => 'form-data',
>> > + Content => [
>> > + ADMIN => 1,
>> > + _NEWUSER_ => 1,
>> > + username => $conf_ref->{newuser}->[0],
>> > + password => $conf_ref->{newuser}->[1],
>> > + email => $conf_ref->{newuser}->[2],
>> > + first_name => ($#{$conf_ref->{newuser}} >=3 ? $conf_ref->{newuser}->[3] : ''),
>> > + last_name => ($#{$conf_ref->{newuser}} >=4 ? $conf_ref->{newuser}->[4] : ''),
>> > + description => 'bquery admin'
>> > + ]);
>> > + }
>> > +
>> > + $request->authorization_basic($conf_ref->{username}, $conf_ref->{password});
>> > +
>> > + my $response = $ua->request($request);
>> > +
>> > + print "Error at $conf_ref->{url}\n ", $response->status_line, "\n"
>> > + unless $response->is_success;
>> > + print "content type at $conf_ref->{url} -- ", $response->content_type, "\n"
>> > + unless $response->content_type eq 'text/html';
>> > +
>> > + print $response->content;
>> > +}
>> > +
>> > +
>> > +###############################################################################
>> > +#
>> > +# Send files by e-mail
>> > +#
>> > +###############################################################################
>> > +sub send_results_by_mail
>> > +{
>> > + my ($mail_to, @files) = @_;
>> > +
>> > + foreach my $mail_file (@files)
>> > + {
>> > + system("echo report is attached | /usr/bin/mutt -s 'breport' -a $mail_file $mail_to");
>> > + }
>> > +}
>> >
>> > Added: trunk/lib/MTT/Reporter/MTTMongodb.pm
>> > ==============================================================================
>> > --- /dev/null 00:00:00 1970 (empty, because file is newly added)
>> > +++ trunk/lib/MTT/Reporter/MTTMongodb.pm 2012-08-01 05:46:03 EDT (Wed, 01 Aug 2012) (r1481)
>> > @@ -0,0 +1,1195 @@
>> > +#!/usr/bin/env perl
>> > +#
>> > +# Copyright (c) 2009 Voltaire
>> > +# Copyright (c) 2010 Cisco Systems, Inc. All rights reserved.
>> > +# $COPYRIGHT$
>> > +#
>> > +# Additional copyrights may follow
>> > +#
>> > +# $HEADER$
>> > +#
>> > +
>> > +package MTT::Reporter::MTTMongodb;
>> > +
>> > +use strict;
>> > +use MTT::Messages;
>> > +use MTT::Values;
>> > +use MTT::Values::Functions;
>> > +use MTT::Version;
>> > +use MTT::Globals;
>> > +use MTT::DoCommand;
>> > +use LWP::UserAgent;
>> > +use HTTP::Request::Common qw(POST);
>> > +use Data::Dumper;
>> > +use File::Basename;
>> > +use File::Temp qw(tempfile tempdir);
>> > +use YAML::XS;
>> > +
>> > +use POSIX qw(strftime);
>> > +use File::stat;
>> > +
>> > +# http credentials
>> > +my $username;
>> > +my $password;
>> > +my $realm;
>> > +my $url;
>> > +my $port;
>> > +
>> > +# platform common name
>> > +my $platform;
>> > +
>> > +# LWP user agents (one per proxy)
>> > +my @lwps;
>> > +
>> > +# Hostname string to report
>> > +my $hostname;
>> > +
>> > +# User ID (can be overridden in the INI)
>> > +my $local_username;
>> > +
>> > +# directory and file to write to
>> > +my $dirname;
>> > +
>> > +my $testrun_files_count = 0;
>> > +my $testbuild_files_count = 0;
>> > +my $mpiinstall_files_count = 0;
>> > +
>> > +our $clusterInfo = undef;
>> > +
>> > +#--------------------------------------------------------------------------
>> > +
>> > +sub Init {
>> > + my ($ini, $section) = @_;
>> > +
>> > + Debug("[MTTGDS reporter] Init\n");
>> > +
>> > + # Have we been initialized already? If so, error -- per #261,
>> > + # this module can currently only handle submitting to one database
>> > + # in a given run.
>> > +
>> > + if (defined($username)) {
>> > + Error("The MTTGDS plugin can only be used once in an INI file.\n");
>> > + }
>> > +
>> > + # Extract data from the ini fields
>> > +
>> > + $username = Value($ini, $section, "mttdatabase_username");
>> > + $password = Value($ini, $section, "mttdatabase_password");
>> > + $url = Value($ini, $section, "mttdatabase_url");
>> > + #$url = Value($ini, $section, "mttdatabase_url").'client';
>> > + $realm = Value($ini, $section, "mttdatabase_realm");
>> > + $hostname = Value($ini, $section, "mttdatabase_hostname");
>> > + $local_username = Value($ini, "mtt", "local_username");
>> > +
>> > + if (!$url) {
>> > + Warning("Need URL in MTTGDS Reporter section [$section]\n");
>> > + return undef;
>> > + }
>> > + my $count = 0;
>> > + ++$count if ($username);
>> > + ++$count if ($password);
>> > + ++$count if ($realm);
>> > + if ($count > 0 && $count != 3) {
>> > + Warning("MTTGDS Reporter section [$section]: if password, username, or realm is specified, they all must be specified.\n");
>> > + return undef;
>> > + }
>> > + $platform = Value($ini, $section, "mttdatabase_platform");
>> > +
>> > + # Extract the host and port from the URL. Needed for the
>> > + # credentials section.
>> > +
>> > + my $dir;
>> > + my $host = $url;
>> > + if ($host =~ /(http:\/\/[-a-zA-Z0-9.]+):(\d+)\/?(.*)?$/) {
>> > + $host = $1;
>> > + $port = $2;
>> > + $dir = $3;
>> > + } elsif ($host =~ /(http:\/\/[-a-zA-Z0-9.]+)\/?(.*)?$/) {
>> > + $host = $1;
>> > + $dir = $2;
>> > + $port = 80;
>> > + } elsif ($host =~ /(https:\/\/[-a-zA-Z0-9.]+)\/?(.*)?$/) {
>> > + $host = $1;
>> > + $dir = $2;
>> > + $port = 443;
>> > + } elsif ($host =~ /(https:\/\/[-a-zA-Z0-9.]+):(\d+)\/?(.*)?$/) {
>> > + $host = $1;
>> > + $port = $2;
>> > + $dir = $3;
>> > + } else {
>> > + Warning("MTTGDS Reporter did not get a valid url: $url .\n");
>> > + return undef;
>> > + }
>> > + $url = "$host:$port";
>> > + # Setup proxies
>> > + my $scheme = (80 == $port) ? "http" : "https";
>> > +
>> > + # Create the Perl LWP stuff to setup for HTTP requests later.
>> > + # Make one for each proxy (we'll always have at least one proxy
>> > + # entry, even if it's empty).
>> > + my $proxies = \@{$MTT::Globals::Values->{proxies}->{$scheme}};
>> > + foreach my $p (@{$proxies}) {
>> > + my %params = { env_proxy => 0 };
>> > + my $ua = LWP::UserAgent->new(%params);
>> > +
>> > + # @#$@!$# LWP proxying for https *does not work*. So
>> > + # don't set $ua->proxy() for it. Instead, we'll set
>> > + # $ENV{https_proxy} whenever we process requests that
>> > + # require SSL proxying, because that is obeyed deep down
>> > + # in the innards underneath LWP.
>> > + $ua->proxy([$scheme], $p->{proxy})
>> > + if ($p->{proxy} ne "" && $scheme ne "https");
>> > + $ua->agent("MPI Test MTTGDS Reporter");
>> > + push(@lwps, {
>> > + scheme => $scheme,
>> > + agent => $ua,
>> > + proxy => $p->{proxy},
>> > + source => $p->{source},
>> > + });
>> > + }
>> > + if ($realm && $username && $password) {
>> > + Verbose(" Set HTTP credentials for realm \"$realm\"\n");
>> > + }
>> > +
>> > + # Do a test ping to ensure that we can reach this URL.
>> > +
>> > + Debug("MTTGDS client pinging a server...\n");
>> > + my $form = {
>> > + PING => 1,
>> > + Description => 'Pinging a server'
>> > + };
>> > + #DINARDINARDINARDINAR
>> > + #my $req = POST ($url, $form);
>> > + #$req->authorization_basic($username, $password);
>> > + #my $response = _do_request($req);
>> > + #if (! $response->is_success()) {
>> > + # Warning(">> Failed test ping to MTTGDS URL: $url\n");
>> > + # Warning(">> Error was: " . $response->status_line . "\n" .
>> > + # $response->content);
>> > + # Error(">> Do not want to continue with possible bad submission URL -- aborting\n");
>> > + #}
>> > + #DINARDINARDINARDINAR
>> > + #Debug("MTTGDS reporter initialized ($realm, $username, XXXXXX, $url, $platform)\n");
>> > + #Debug("MTTGDS reporter respond content ($response->content)\n");
>> > +
>> > + # Extract data from the ini fields
>> > +
>> > + $dirname = MTT::DoCommand::cwd();
>> > +
>> > + Debug("Collect cluster information...\n");
>> > + my $clusterinfo_module = MTT::Values::Value($ini, "vbench", "clusterinfo_module");
>> > + $clusterinfo_module = "UnknownCluster" if (!defined($clusterinfo_module) || $clusterinfo_module eq "");
>> > + Debug("Use $clusterinfo_module module to collect information.\n");
>> > +
>> > + $clusterInfo = MTT::Module::Run("MTT::Reporter::Utils::$clusterinfo_module", "get_cluster_info", MTT::Values::Functions::env_hosts(2));
>> > + if (!defined($clusterInfo)) {
>> > + Error("Fatal: Can't collect cluster information\n");
>> > + }
>> > + Debug("Collect cluster information Finished\n");
>> > +
>> > + Debug("File reporter initialized ($dirname)\n");
>> > +
>> > + return 1;
>> > +}
>> > +
>> > +#--------------------------------------------------------------------------
>> > +
>> > +my $entries;
>> > +
>> > +sub Submit {
>> > +
>> > +
>> > + my ( $info, $newentries ) = @_;
>> > +
>> > + Debug("[MTTGDS reporter] Submit\n");
>> > +
>> > + if (!defined($newentries)) {
>> > + Warning("[MTTGDS reporter]: Submit parameter is undef. Skip.\n");
>> > + return;
>> > + }
>> > +
>> > + if ( !defined($entries) ) {
>> > + %$entries = ();
>> > + }
>> > +
>> > + foreach my $phase (keys(%$newentries))
>> > + {
>> > + my $phase_obj = $newentries ->{$phase};
>> > +
>> > + foreach my $section ( keys(%$phase_obj) )
>> > + {
>> > + Debug("Phase: $phase Section: $section\n");
>> > +
>> > + my $new_section_obj = $phase_obj->{$section};
>> > +
>> > + my $section_obj = $entries->{$phase}->{$section};
>> > +
>> > + foreach my $report (@$new_section_obj)
>> > + {
>> > + Debug(" add report\n");
>> > + push(@$section_obj, $report);
>> > + }
>> > +
>> > + $entries->{$phase}->{$section} = $section_obj;
>> > +
>> > + }
>> > + }
>> > +
>> > + Verbose(">> Reporter MTTGDS: cached for later submit\n");
>> > + Debug("[MTTGDS reporter] Exit from Submit\n");
>> > +}
>> > +
>> > +sub Finalize {
>> > + Debug("[MTTGDS reporter] Finalize\n");
>> > +
>> > + _do_submit();
>> > + undef $entries;
>> > +
>> > + undef $username;
>> > + undef $password;
>> > + undef $realm;
>> > + undef $url;
>> > + undef $platform;
>> > + undef @lwps;
>> > +}
>> > +
>> > +#--------------------------------------------------------------------------
>> > +
>> > +sub _do_submit {
>> > + #DinarDinarDinarDinar
>> > + use MongoDB;
>> > + use MongoDB::OID;
>> > + use YAML;
>> > + use Data::Dumper;
>> > + use YAML::XS;
>> > + $url =~ s/http:\/\///;
>> > + my $conn = MongoDB::Connection->new(host => $url);
>> > + my $db = $conn->mtt;
>> > + my $TestRunPhase = $db->TestRunPhase;
>> > + my $MPIInstallPhase = $db->MPIInstallPhase;
>> > + my $TestBuildPhase = $db->TestBuildPhase;
>> > + my $doc;
>> > + my @numbers;
>> > + my $inserted_id;
>> > + my $old_date;
>> > + my %new_date;
>> > + #DinarDinarDinarDinar
>> > +
>> > + # Make a default form that will be used to seed all the forms that
>> > + # will be sent
>> > + my $default_form = {
>> > + product => 'mtt-gds',
>> > + version => "0.1",
>> > + app_id => 'submit',
>> > + };
>> > +
>> > + my $ini = $MTT::Globals::Internals->{ini};
>> > + my $submit_failed_results = MTT::Values::Value( $ini, "VBench", 'submit_failed_results_to_gds' );
>> > +
>> > + # mtt ini flag to control what mtt results to submit to GDS
>> > + if (!defined($submit_failed_results) || $submit_failed_results eq '')
>> > + {
>> > + $submit_failed_results = 1;
>> > + }
>> > +
>> > + my $submit_results = MTT::Values::Value( $ini, "VBench", 'submit_results_to_gds' );
>> > + # mtt ini flag to control what mtt results to submit to GDS
>> > + if (!defined($submit_results) || $submit_results eq '' || $submit_results eq '1' || $submit_results eq 'True')
>> > + {
>> > + $submit_results = 1;
>> > + } else {
>> > + $submit_results = 0;
>> > + }
>> > +
>> > + #foreach my $phase (keys(%$entries)) {
>> > + foreach my $phase ( "MPI Install", "Test Build", "Test Run" )
>> > + {
>> > + my $submitted = 0;
>> > + my $phase_obj = $entries->{$phase};
>> > +
>> > + foreach my $section ( keys(%$phase_obj) )
>> > + {
>> > + my $section_obj = $phase_obj->{$section};
>> > +
>> > + foreach my $report_original (@$section_obj)
>> > + {
>> > +
>> > + # Each section of a phase gets its own report to the
>> > + # database. Make a deep copy of the default form to start
>> > + # with.
>> > + my $form;
>> > + %$form = %{$default_form};
>> > + $form->{modules} = {};
>> > +
>> > + # Ensure to do a deep copy of the report (vs. just
>> > + # copying the reference) because we want to locally
>> > + # change some values
>> > + my $report;
>> > + %$report = %{$report_original};
>> > + %$report->{files_to_copy} = {} if (!exists($report->{files_to_copy}));
>> > +
>> > + $MTT::Values::Functions::current_report = $report;
>> > +
>> > + my $attachment = {};
>> > +
>> > + if ( $phase eq "Test Run" )
>> > + {
>> > +
>> > + my $mpi_install = $entries->{"MPI Install"}->{$report->{mpi_install_section_name}};
>> > + my $mpi_report = @$mpi_install[0];
>> > +
>> > + _process_phase_mpi_install("MPI Install", $report->{mpi_install_section_name}, $mpi_report, $form->{modules});
>> > +
>> > + my $test_build = $entries->{"Test Build"}->{$report->{test_build_section_name}};
>> > + my $build_report = @$test_build[0];
>> > + _process_phase_test_build("Test Build", $report->{test_build_section_name}, $build_report, $form->{modules});
>> > +
>> > + _process_phase_test_run($phase, $section, $report, $form->{modules});
>> > + $attachment = $report->{files_to_copy};
>> > + }
>> > + elsif ( $phase eq "Test Build" )
>> > + {
>> > + my $mpi_install = $entries->{"MPI Install"}->{$report->{mpi_install_section_name}};
>> > + my $mpi_report = @$mpi_install[0];
>> > + _process_phase_mpi_install("MPI Install", $report->{mpi_install_section_name}, $mpi_report, $form->{modules});
>> > +
>> > + _process_phase_test_build($phase, $section, $report, $form->{modules});
>> > + }
>> > + elsif ( $phase eq "MPI Install" )
>> > + {
>> > + _process_phase_mpi_install($phase, $section, $report, $form->{modules});
>> > + }
>> > + else
>> > + {
>> > + Debug("Phase: $phase Section: $section SKIPPED\n");
>> > + next;
>> > + }
>> > +
>> > + $MTT::Values::Functions::current_report = undef;
>> > +
>> > + Debug("Submitting to MongoDB...\n");
>> > +
>> > + my ($req, $file) = _prepare_request($phase, $report, $form, $attachment);
>> > +
>> > + # do not submit result with non PASS status in case 'submit_failed_results_to_gds' key is set as '0'
>> > + if ( ($submit_failed_results == 0) && ($report->{test_result} != 1) )
>> > + {
>> > + Debug("MTT ini-file has key \'submit_failed_results_to_gds\'=$submit_failed_results and phase: $phase test_result: $report->{test_result}\n");
>> > + next;
>> > + }
>> > +
>> > + if ( $submit_results == 0 )
>> > + {
>> > + Debug("MTT ini-file has key \'submit_results_to_gds\'=$submit_results\n");
>> > + next;
>> > + }
>> > +
>> > + #DinarDinarDinar
>> > + if ( $phase eq "Test Run" )
>> > + {
>> > +
>> > + #$old_date = $form->{'modules'}->{'TestRunPhase'}->{'start_time'};
>> > + #@numbers = split(/:|-|\s/,$old_date);
>> > + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
>> > + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
>> > + #$form->{'TestRun_start_time'} = DateTime->new(%new_date);
>> > +
>> > +
>> > + #$old_date = $form->{'modules'}->{'TestBuildPhase'}->{'start_time'};
>> > + #@numbers = split(/:|-|\s/,$old_date);
>> > + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
>> > + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
>> > + #$form->{'TestBuild_start_time'} = DateTime->new(%new_date);
>> > +
>> > +
>> > + #$old_date = $form->{'modules'}->{'MpiInstallPhase'}->{'start_time'};
>> > + #@numbers = split(/:|-|\s/,$old_date);
>> > + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
>> > + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
>> > + #$form->{'MpiInstall_start_time'} = DateTime->new(%new_date);
>> > +
>> > +
>> > + #$old_date = $form->{'modules'}->{'TestRunPhase'}->{'end_time'};
>> > + #@numbers = split(/:|-|\s/,$old_date);
>> > + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
>> > +
>> > + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
>> > + #$form->{'TestRun_end_time'} = DateTime->new(%new_date);
>> > +
>> > +
>> > + #$old_date = $form->{'modules'}->{'TestBuildPhase'}->{'end_time'};
>> > + #@numbers = split(/:|-|\s/,$old_date);
>> > + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
>> > + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
>> > + #$form->{'TestBuild_end_time'} = DateTime->new(%new_date);
>> > +
>> > +
>> > + #$old_date = $form->{'modules'}->{'MpiInstallPhase'}->{'end_time'};
>> > + #@numbers = split(/:|-|\s/,$old_date);
>> > + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
>> > + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
>> > + #$form->{'MpiInstall_end_time'} = DateTime->new(%new_date);
>> > +
>> > +
>> > + my $inserted_id = $TestRunPhase->insert($form);
>> > +
>> > +
>> > +
>> > + #$doc = ($TestRunPhase->find({'_id'=>$inserted_id}))->next;
>> > +
>> > + #TestRun
>> > + #$old_date = $doc->{'modules'}->{'TestRunPhase'}->{'start_time'};
>> > + #@numbers = split(/:|-|\s/,$old_date);
>> > + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
>> > + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
>> > + #$TestRunPhase->update({'_id'=>$inserted_id},{'$set'=>{'modules.TestRunPhase.start_time'=>DateTime->new(%new_date)}});
>> > +
>> > + #$old_date = $doc->{'modules'}->{'TestRunPhase'}->{'end_time'};
>> > + #@numbers = split(/:|-|\s/,$old_date);
>> > + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
>> > + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
>> > + #$TestRunPhase->update({'_id'=>$inserted_id},{'$set'=>{'modules.TestRunPhase.end_time'=>DateTime->new(%new_date)}});
>> > +
>> > + #MPIInstall
>> > + #$old_date = $doc->{'modules'}->{'MpiInstallPhase'}->{'start_time'};
>> > + #@numbers = split(/:|-|\s/,$old_date);
>> > + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
>> > + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
>> > + #$TestRunPhase->update({'_id'=>$inserted_id},{'$set'=>{'modules.MpiInstallPhase.start_time'=>DateTime->new(%new_date)}});
>> > +
>> > + #$old_date = $doc->{'modules'}->{'MpiInstallPhase'}->{'end_time'};
>> > + #@numbers = split(/:|-|\s/,$old_date);
>> > + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
>> > + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
>> > + #$TestRunPhase->update({'_id'=>$inserted_id},{'$set'=>{'modules.MpiInstallPhase.end_time'=>DateTime->new(%new_date)}});
>> > +
>> > +
>> > + #TestBuild
>> > + #$old_date = $doc->{'modules'}->{'TestBuildPhase'}->{'start_time'};
>> > + #@numbers = split(/:|-|\s/,$old_date);
>> > + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
>> > + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
>> > + #$TestRunPhase->update({'_id'=>$inserted_id},{'$set'=>{'modules.TestBuildPhase.start_time'=>DateTime->new(%new_date)}});
>> > +
>> > + #$old_date = $doc->{'modules'}->{'TestBuildPhase'}->{'end_time'};
>> > + #@numbers = split(/:|-|\s/,$old_date);
>> > + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
>> > + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
>> > + #$TestRunPhase->update({'_id'=>$inserted_id},{'$set'=>{'modules.TestBuildPhase.end_time'=>DateTime->new(%new_date)}});
>> > +
>> > +
>> > +
>> > + }
>> > + if ( $phase eq "MPI Install" )
>> > + {
>> > +
>> > + #$old_date = $form->{'modules'}->{'MpiInstallPhase'}->{'start_time'};
>> > + #@numbers = split(/:|-|\s/,$old_date);
>> > + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
>> > + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
>> > + #$form->{'MpiInstall_start_time'} = DateTime->new(%new_date);
>> > +
>> > +
>> > + #$old_date = $form->{'modules'}->{'MpiInstallPhase'}->{'end_time'};
>> > + #@numbers = split(/:|-|\s/,$old_date);
>> > + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
>> > + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
>> > + #$form->{'MpiInstall_end_time'} = DateTime->new(%new_date);
>> > +
>> > + $inserted_id = $MPIInstallPhase->insert($form);
>> > +
>> > +
>> > +
>> > +
>> > + #$doc = ($MPIInstallPhase->find({'_id'=>$inserted_id}))->next;
>> > +
>> > + #MPIInstall
>> > + #$old_date = $doc->{'modules'}->{'MpiInstallPhase'}->{'start_time'};
>> > + #@numbers = split(/:|-|\s/,$old_date);
>> > + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
>> > + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
>> > + #$MPIInstallPhase->update({'_id'=>$inserted_id},{'$set'=>{'modules.MpiInstallPhase.start_time'=>DateTime->new(%new_date)}});
>> > +
>> > + #$old_date = $doc->{'modules'}->{'MpiInstallPhase'}->{'end_time'};
>> > + #@numbers = split(/:|-|\s/,$old_date);
>> > + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
>> > + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
>> > + #$MPIInstallPhase->update({'_id'=>$inserted_id},{'$set'=>{'modules.MpiInstallPhase.end_time'=>DateTime->new(%new_date)}});
>> > +
>> > + }
>> > + if ( $phase eq "Test Build")
>> > + {
>> > +
>> > +
>> > +
>> > + #$old_date = $form->{'modules'}->{'TestBuildPhase'}->{'start_time'};
>> > + #@numbers = split(/:|-|\s/,$old_date);
>> > + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
>> > + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
>> > + #$form->{'TestBuild_start_time'} = DateTime->new(%new_date);
>> > +
>> > +
>> > + #$old_date = $form->{'modules'}->{'TestBuildPhase'}->{'end_time'};
>> > + #@numbers = split(/:|-|\s/,$old_date);
>> > + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
>> > + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
>> > +
>> > + #$form->{'TestBuild_end_time'} = DateTime->new(%new_date);
>> > +
>> > + my $inserted_id = $TestBuildPhase->insert($form);
>> > +
>> > +
>> > +
>> > + #$doc = ($TestBuildPhase->find({'_id'=>$inserted_id}))->next;
>> > +
>> > + #TestBuild
>> > + #$old_date = $doc->{'modules'}->{'TestBuildPhase'}->{'start_time'};
>> > + #@numbers = split(/:|-|\s/,$old_date);
>> > + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
>> > + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
>> > + #$TestBuildPhase->update({'_id'=>$inserted_id},{'$set'=>{'modules.TestBuildPhase.start_time'=>DateTime->new(%new_date)}});
>> > +
>> > + #$old_date = $doc->{'modules'}->{'TestBuildPhase'}->{'end_time'};
>> > + #@numbers = split(/:|-|\s/,$old_date);
>> > + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
>> > + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
>> > + #$TestBuildPhase->update({'_id'=>$inserted_id},{'$set'=>{'modules.TestBuildPhase.end_time'=>DateTime->new(%new_date)}});
>> > + }
>> > + #DinarDinarDinar
>> > +
>> > + $submitted = 1;
>> > + }
>> > + }
>> > + Verbose(">> Submitted $phase to MongoDB\n")
>> > + if ($submitted);
>> > + }
>> > +}
>> > +
>> > +#--------------------------------------------------------------------------
>> > +
>> > +sub _process_phase_mpi_install {
>> > + my ( $phase, $section, $report, $form )=@_;
>> > + $form->{MpiInstallPhase} = {};
>> > + my $phase_form = $form->{MpiInstallPhase};
>> > +
>> > + _fill_submit_info( $phase, $section, $report, $form );
>> > + _fill_compiler_info( $phase, $section, $report, $form );
>> > + _fill_cluster_info( $phase, $section, $report, $form );
>> > + _fill_mpi_info( $phase, $section, $report, $form );
>> > +
>> > + $phase_form->{start_time} = strftime( "%Y-%m-%d %H:%M:%S",
>> > + localtime $report->{start_timestamp} );
>> > +
>> > + my $duration = $report->{duration};
>> > + $duration =~ m/^(\w+)\s(.+)/;
>> > + $duration = $1;
>> > + $phase_form->{duration} = $duration;
>> > +
>> > + $phase_form->{end_time} = strftime( "%Y-%m-%d %H:%M:%S",
>> > + localtime ($report->{start_timestamp} + $phase_form->{duration}) );
>> > +
>> > + $phase_form->{description} = $report->{description};
>> > + $phase_form->{stdout} = $report->{result_stdout};
>> > + $phase_form->{stderr} = $report->{result_stderr};
>> > + $phase_form->{status} = $report->{test_result};
>> > + $phase_form->{configuration} = $report->{configure_arguments};
>> > +
>> > + my $ini = $MTT::Globals::Internals->{ini};
>> > + my $mpi_section = $report->{mpi_install_section_name};
>> > +
>> > + my $mpiget_section = MTT::Values::Value( $ini, "MPI install: " . $mpi_section, "mpi_get" );
>> > +
>> > + my $mpiget_module = MTT::Values::Value( $ini, "MPI get: " . $mpiget_section, "module" );
>> > +
>> > + if ($mpiget_module eq "AlreadyInstalled") {
>> > + $phase_form->{mpi_path} = MTT::Values::Value( $ini, "MPI get: ". $mpiget_section, "alreadyinstalled_dir" );
>> > + $phase_form->{mpi_path} = EvaluateString( $phase_form->{mpi_path}, $ini, "MPI get: ". $mpiget_section );
>> > + } else {
>> > + my $mpi_install = $MTT::MPI::installs->{$mpiget_section}->{$report->{mpi_version}}->{$mpi_section};
>> > + $phase_form->{mpi_path} = $mpi_install->{installdir};
>> > + }
>> > +
>> > + return 0;
>> > +}
>> > +
>> > +#--------------------------------------------------------------------------
>> > +
>> > +sub _process_phase_test_build {
>> > + my ( $phase, $section, $report, $form )=@_;
>> > + $form->{TestBuildPhase} = {};
>> > + my $phase_form = $form->{TestBuildPhase};
>> > +
>> > + _fill_submit_info( $phase, $section, $report, $form );
>> > + _fill_compiler_info( $phase, $section, $report, $form );
>> > + _fill_cluster_info( $phase, $section, $report, $form );
>> > + _fill_mpi_info( $phase, $section, $report, $form );
>> > + _fill_suite_info( $phase, $section, $report, $form );
>> > +
>> > + $phase_form->{start_time} = strftime( "%Y-%m-%d %H:%M:%S",
>> > + localtime $report->{start_timestamp} );
>> > +
>> > + my $duration = $report->{duration};
>> > + $duration =~ m/^(\w+)\s(.+)/;
>> > + $duration = $1;
>> > + $phase_form->{duration} = $duration;
>> > +
>> > + $phase_form->{end_time} = strftime( "%Y-%m-%d %H:%M:%S",
>> > + localtime ($report->{start_timestamp} + $phase_form->{duration}) );
>> > +
>> > + $phase_form->{description} = $report->{description};
>> > + $phase_form->{stdout} = $report->{result_stdout};
>> > + $phase_form->{stderr} = $report->{result_stderr};
>> > + $phase_form->{status} = $report->{test_result};
>> > +
>> > + return 0;
>> > +}
>> > +
>> > +#--------------------------------------------------------------------------
>> > +
>> > +sub _process_phase_test_run {
>> > + my ( $phase, $section, $report, $form )=@_;
>> > + $form->{TestRunPhase} = {};
>> > +
>> > + _pre_process_phase( $phase, $section, $report, $form );
>> > +
>> > + # copy benchmark's additional data about mpi (filled in benchmark's analyzer)
>> > + %$form->{TestRunPhase} = ( %$report->{testphase} ) if (defined ($report->{testphase}));#!!!!!!!!!!!!
>> > + my $phase_form = $form->{TestRunPhase};
>> > +
>> > + _fill_submit_info( $phase, $section, $report, $form );
>> > + _fill_compiler_info( $phase, $section, $report, $form );
>> > + _fill_cluster_info( $phase, $section, $report, $form );
>> > + _fill_mpi_info( $phase, $section, $report, $form );
>> > + _fill_suite_info( $phase, $section, $report, $form );
>> > +
>> > + $phase_form->{start_time} = strftime( "%Y-%m-%d %H:%M:%S",
>> > + localtime $report->{start_timestamp} );
>> > +
>> > + my $duration = $report->{duration};
>> > + $duration =~ m/^(\w+)\s(.+)/;
>> > + $duration = $1;
>> > + $phase_form->{duration} = $duration;
>> > +
>> > + $phase_form->{end_time} = strftime( "%Y-%m-%d %H:%M:%S",
>> > + localtime ($report->{start_timestamp} + $phase_form->{duration}) );
>> > +
>> > + $phase_form->{description} = $report->{description};
>> > + $phase_form->{stdout} = $report->{result_stdout};
>> > + $phase_form->{stderr} = $report->{result_stderr};
>> > + $phase_form->{status} = $report->{test_result};
>> > + $phase_form->{cmdline} = $report->{command};
>> > + my @sections;
>> > + push( @sections, "test run: " . $section );
>> > + push( @sections, "MTT" );
>> > + push( @sections, "VBench" );
>> > +
>> > + $phase_form->{test_name} = $report->{test_name} if (!defined($phase_form->{test_name}));
>> > +
>> > + $phase_form->{mpi_nproc} = int($report->{np});
>> > + $phase_form->{mpi_hlist} = MTT::Values::Functions::env_hosts(2);
>> > +
>> > + $phase_form->{net_note} = _get_value( "vbench:net_note", @sections );
>> > +
>> > + my $ini = $MTT::Globals::Internals->{ini};
>> > + my @taglist = ();
>> > + my @tagsections = (@sections);
>> > + foreach my $tagsection (@tagsections) {
>> > + my @val = MTT::Values::Value($ini, $tagsection, "vbench:tag");
>> > + if ( $#val != (-1) ) {
>> > + @val = split(/\n/, $val[0]) if ($#val == 0);
>> > + foreach (@val)
>> > + {
>> > + my $tag = $_;
>> > + push( @taglist, $tag ) if ($tag);
>> > + }
>> > + }
>> > + }
>> > + @{$phase_form->{tag}} = @taglist;
>> > +
>> > + $phase_form->{test_case} = $report->{parameters}
>> > + if ( !defined( $phase_form->{test_case} ) );
>> > +
>> > + # JMS Why do we have an mpi_mca field? Shouldn't this kind of
>> > + # stuff be in the MPI Details parameters and network fields?
>> > + if (!defined($phase_form->{mpi_mca})) {
>> > + # JMS Should generlize this to be "extract from the current
>> > + # ::MPI::module". There are other instances of this direct
>> > + # call in MTT::Test::Analyze::Performance::*.
>> > + $phase_form->{mpi_mca} =
>> > + MTT::Values::Functions::MPI::OMPI::find_mca_params($report->{command});
>> > +
>> > + if (!defined($phase_form->{mpi_rlist})) {
>> > + my $rankfile = undef;
>> > + my $cmdline = $report->{command};
>> > + if ( $cmdline =~ m/-rf\s([\S]+)/ ) {
>> > + $rankfile = $1;
>> > + }
>> > + if ( $cmdline =~ m/--rankfile\s([\S]+)/ ) {
>> > + $rankfile = $1;
>> > + }
>> > + $phase_form->{mpi_rlist} = $rankfile;
>> > + }
>> > + } else {
>> > + if (!defined($phase_form->{mpi_rlist})) {
>> > + $phase_form->{mpi_rlist} = "";
>> > + }
>> > + }
>> > +
>> > + if ( $phase_form->{mpi_rlist} ne "") {
>> > + push(@{$report->{files_to_copy}}, $phase_form->{mpi_rlist});
>> > + }
>> > +
>> > + # fill mpi_btl string list
>> > + if ($phase_form->{mpi_mca} =~ m/-mca\sbtl\s(\S+)/) {
>> > + @{$phase_form->{mpi_btl}} = split /,/, $1;
>> > + } else {
>> > + @{$phase_form->{mpi_btl}} = ();
>> > + }
>> > +
>> > + # filling dynamic fields with prefix "data_"
>> > + $phase_form->{data_message_size} = $report->{message_size} if (exists( $report->{message_size} ));
>> > + $phase_form->{data_latency_min} = $report->{latency_min} if (exists( $report->{latency_min} ));
>> > + $phase_form->{data_latency_avg} = $report->{latency_avg} if (exists( $report->{latency_avg} ));
>> > + $phase_form->{data_latency_max} = $report->{latency_max} if (exists( $report->{latency_max} ));
>> > + $phase_form->{data_bandwidth_min} = $report->{bandwidth_min} if (exists( $report->{bandwidth_min} ));
>> > + $phase_form->{data_bandwidth_avg} = $report->{bandwidth_avg} if (exists( $report->{bandwidth_avg} ));
>> > + $phase_form->{data_bandwidth_min} = $report->{bandwidth_min} if (exists( $report->{bandwidth_min} ));
>> > +
>> > + # filling dynamic fields with prefix "custom_"
>> > +
>> > + # Special named export environment variables set in mpirun command line
>> > + # should be stored as part of data in GDS datastore
>> > + while ( $phase_form->{cmdline} =~ m/\s+-[x|e]\s+(custom_\w+)\=([^\s\"\']+)/g){
>> > + my $value = $2;
>> > + eval "\$value = \"$value\"";
>> > + $phase_form->{$1} = $value;
>> > + }
>> > + while ( $phase_form->{cmdline} =~ m/\s+-[x|e]\s+(custom_\w+)\=\"([^\"]*)\"/g ){
>> > + my $value = $2;
>> > + eval "\$value = \"$value\"";
>> > + $phase_form->{$1} = $value;
>> > + }
>> > + while ( $phase_form->{cmdline} =~ m/\s+-[x|e]\s+\"(custom_\w+)\=([^\"]*)\"/g){
>> > + my $value = $2;
>> > + eval "\$value = \"$value\"";
>> > + $phase_form->{$1} = $value;
>> > + }
>> > + while ( $phase_form->{cmdline} =~ m/\s+-[x|e]\s+(custom_\w+)\=\'([^\']*)\'/g ){
>> > + my $value = $2;
>> > + eval "\$value = \"$value\"";
>> > + $phase_form->{$1} = $value;
>> > + }
>> > + while ( $phase_form->{cmdline} =~ m/\s+-[x|e]\s+\'(custom_\w+)\=([^\']*)\'/g){
>> > + my $value = $2;
>> > + eval "\$value = \"$value\"";
>> > + $phase_form->{$1} = $value;
>> > + }
>> > +
>> > + # filling cached fields with prefix "cached_"
>> > + _fill_cached_info( $form );
>> > +
>> > + return 0;
>> > +}
>> > +
>> > +#--------------------------------------------------------------------------
>> > +
>> > +sub _get_value {
>> > + my $name = shift @_;
>> > + my @sections = @_;
>> > +
>> > + my $ini = $MTT::Globals::Internals->{ini};
>> > +
>> > + # push (@sections, "MTT");
>> > + # push (@sections, "VBench");
>> > +
>> > + my $value = MTT::Values::Value( $ini, "VBench", $name );
>> > +
>> > + # my $value = VBench::Values::getValueFromSections($ini, $name, @sections);
>> > +
>> > + return $value;
>> > +}
>> > +
>> > +#--------------------------------------------------------------------------
>> > +
>> > +sub _pre_process_phase {
>> > + my ( $phase, $section, $report, $form )=@_;
>> > +
>> > + my $ini = $MTT::Globals::Internals->{ini};
>> > + my $module = $ini->val( "Test run: " . $section, "analyze_module" );
>> > +
>> > + # If there's no analyze module, then just return
>> > + return $form
>> > + if (!$module);
>> > +
>> > + $module = "MTT::Test::Analyze::Performance::$module";
>> > + my $method = "PreReport";
>> > + my @args = ( $phase, $section, $report );
>> > +
>> > + Debug("Call PreReport on $module module.\n");
>> > +
>> > + my $str = "require $module";
>> > + my $check = eval $str;
>> > + if ($@) {
>> > + Warning("Could not load module $module: $@\n");
>> > + } else {
>> > + my $ret = undef;
>> > + $str = "\$ret = exists(\$${module}::{$method})";
>> > + eval $str;
>> > + if (1 == $ret) {
>> > + $ret = undef;
>> > + $str = "\$ret = \&${module}::$method(\@args)";
>> > + $check = eval $str;
>> > + if ($@) {
>> > + Warning("Could not run module $module:$method: $@\n");
>> > + }
>> > + }
>> > + }
>> > +
>> > + return $form;
>> > +}
>> > +
>> > +#--------------------------------------------------------------------------
>> > +
>> > +sub _fill_cached_info {
>> > + my ( $form ) = @_;
>> > + my $phase_form = $form->{TestRunPhase};
>> > + my @info_list = ( "SubmitInfo", "ClusterInfo", "MpiInfo", "CompilerInfo", "SuiteInfo" );
>> > + my @exception_list = ( "clusterinfo_net_conf", "clusterinfo_net_pci" );
>> > +
>> > + foreach my $info (@info_list) {
>> > + foreach my $key (keys(%{$form->{$info}})) {
>> > + $phase_form->{lc("cached\_$info\_$key")} = $form->{$info}->{$key};
>> > + foreach (@exception_list) {
>> > + if (lc("$_") eq lc("$info\_$key")) {
>> > + delete($phase_form->{lc("cached\_$info\_$key")});
>> > + last;
>> > + }
>> > + }
>> > + }
>> > + }
>> > +
>> > + $phase_form->{"cached_mpiinstallphase_mpi_path"} = $form->{MpiInstallPhase}->{mpi_path};
>> > +
>> > + return $phase_form;
>> > +}
>> > +
>> > +#--------------------------------------------------------------------------
>> > +
>> > +sub _fill_cluster_info {
>> > + my ( $phase, $section, $report, $form ) = @_;
>> > + $form->{ClusterInfo} = {};
>> > + my $info_form = $form->{ClusterInfo};
>> > +
>> > + if ( !defined($report) ) {
>> > + die "Runtime Error";
>> > + }
>> > + else {
>> > + my @sections;
>> > + push( @sections, "test run: " . $section );
>> > + push( @sections, "MTT");
>> > + push( @sections, "VBench");
>> > +
>> > + $info_form->{cluster_name} = $platform;
>> > +
>> > + my $node_count =
>> > + _get_value( "vbench:cluster_node_count", @sections );
>> > +
>> > + %$info_form = (%$info_form, %$clusterInfo);
>> > +
>> > + delete $info_form->{total_mhz};
>> > +
>> > + if (defined($node_count) && $node_count ne "") {
>> > + $info_form->{node_count} = $node_count;
>> > + }
>> > + }
>> > +
>> > + return $info_form;
>> > +}
>> > +
>> > +#--------------------------------------------------------------------------
>> > +
>> > +sub _fill_mpi_info {
>> > + my ( $phase, $section, $report, $form ) = @_;
>> > + $form->{MpiInfo} = {};
>> > + # copy benchmark's additional data about mpi (filled in benchmark's analyzer)
>> > + %$form->{MpiInfo} = ( %$report->{mpi} ) if (exists ($report->{mpi}));#!!!!!!!!!!!!
>> > + my $info_form = $form->{MpiInfo};
>> > +
>> > + if ( !defined($report) ) {
>> > + die "Runtime Error";
>> > + }
>> > + else {
>> > + my @sections;
>> > + push( @sections, "test run: " . $section );
>> > +
>> > + my @mpi_name_parts =
>> > + split( /:/, $report->{mpi_install_section_name}, 1 );
>> > + $info_form->{mpi_name} = @mpi_name_parts[0];
>> > +
>> > + $info_form->{mpi_version} = $report->{mpi_version};
>> > +
>> > + my $mpi_path;
>> > + my $ini = $MTT::Globals::Internals->{ini};
>> > + my $mpi_section = $report->{mpi_install_section_name};
>> > +
>> > + my $mpiget_section = MTT::Values::Value( $ini, "MPI install: " . $mpi_section, "mpi_get" );
>> > +
>> > + my $mpiget_module = MTT::Values::Value( $ini, "MPI get: " . $mpiget_section, "module" );
>> > +
>> > + if ($mpiget_module eq "AlreadyInstalled") {
>> > + $mpi_path = MTT::Values::Value( $ini, "MPI get: ". $mpiget_section, "alreadyinstalled_dir" );
>> > + $mpi_path = EvaluateString( $mpi_path, $ini, "MPI get: ". $mpiget_section );
>> > + } else {
>> > + my $mpi_install = $MTT::MPI::installs->{$mpiget_section}->{$report->{mpi_version}}->{$mpi_section};
>> > + $mpi_path = $mpi_install->{installdir};
>> > + }
>> > +
>> > + my $error = 0;
>> > + my $cmd = "LD_LIBRARY_PATH=" . $mpi_path . "/lib " . $mpi_path . "/bin/mpirun --version";
>> > + open(SHELL, "$cmd 2>&1|") || ($error = 1);
>> > + $info_form->{oma_version} = "";
>> > + if ($error == 0) {
>> > + while (<SHELL>) {
>> > + if ( $_ =~ m/OMA\s+([r\d\.-]+)\s/) {
>> > + $info_form->{oma_version} = $1;
>> > + last;
>> > + }
>> > + }
>> > + close SHELL;
>> > + } # $error = 0
>> > + else {
>> > + $error = 0;
>> > + }
>> > +
>> > + # Add host file to "copy list"
>> > + if ( MTT::Values::Functions::have_hostfile() ) {
>> > + my $hostFile = MTT::Values::Functions::hostfile();
>> > + push(@{$report->{files_to_copy}}, $hostFile);
>> > + }
>> > + }
>> > + return $info_form;
>> > +}
>> > +
>> > +#--------------------------------------------------------------------------
>> > +
>> > +sub _fill_suite_info {
>> > + my ( $phase, $section, $report, $form ) = @_;
>> > + $form->{SuiteInfo} = {};
>> > + # copy benchmark's additional data about benchmark suite (filled in benchmark's analyzer)
>> > + %$form->{SuiteInfo} = ( %$report->{suiteinfo} ) if (exists ($report->{suiteinfo}));#!!!!!!!!!!!!
>> > + my $info_form = $form->{SuiteInfo};
>> > +
>> > + if ( !defined($report) ) {
>> > + die "Runtime Error";
>> > + }
>> > + else {
>> > + my @sections;
>> > + push( @sections, "test run: " . $section );
>> > +
>> > + my $suite_name = undef;
>> > + my $suite_version = undef;
>> > +
>> > + my $test_run = $section;
>> > + if ( $test_run =~ m/^(\S+):(\S+)/ ) {
>> > + $suite_name = $1;
>> > + $suite_version = $2;
>> > + }
>> > + else {
>> > + if ( $test_run =~ m/^(\S+)\s(.+)$/ ) {
>> > + $suite_name = $1;
>> > + $suite_version = "undefined";
>> > + }
>> > + else {
>> > + $suite_name = $test_run;
>> > + $suite_version = "undefined";
>> > + }
>> > + }
>> > + $info_form->{suite_name} = $suite_name if (!defined($info_form->{suite_name}));
>> > + $info_form->{suite_version} = $suite_version if (!defined($info_form->{suite_version}));
>> > +
>> > + }
>> > + return $info_form;
>> > +}
>> > +
>> > +#--------------------------------------------------------------------------
>> > +
>> > +sub _fill_submit_info {
>> > + my ( $phase, $section, $report, $form ) = @_;
>> > + $form->{SubmitInfo} = {};
>> > + my $info_form = $form->{SubmitInfo};
>> > +
>> > + if ( !defined($report) ) {
>> > + die "Runtime Error";
>> > + }
>> > + else {
>> > + if (!$local_username) {
>> > + $local_username = getpwuid($<);
>> > + }
>> > +
>> > + if (!defined($hostname) || "" eq $hostname) {
>> > + $hostname = `hostname`;
>> > + chomp($hostname);
>> > + }
>> > +
>> > + $info_form->{hostname} = $hostname;
>> > + $info_form->{local_username} = $local_username;
>> > + $info_form->{http_username} = $username;
>> > + $info_form->{mtt_version} = $MTT::Version::Combined;
>> > + }
>> > + return $info_form;
>> > +}
>> > +
>> > +#--------------------------------------------------------------------------
>> > +
>> > +sub _fill_compiler_info {
>> > + my ( $phase, $section, $report, $form ) = @_;
>> > + $form->{CompilerInfo} = {};
>> > + my $info_form = $form->{CompilerInfo};
>> > +
>> > + if ( !defined($report) ) {
>> > + die "Runtime Error";
>> > + }
>> > + else {
>> > + $info_form->{compiler_name} = "unknown";
>> > + $info_form->{compiler_name} = $report->{compiler_name} if (defined($report->{compiler_name}));
>> > + $info_form->{compiler_version} = "unknown";
>> > + $info_form->{compiler_version} = $report->{compiler_version} if (defined($report->{compiler_version}));
>> > + }
>> > + return $info_form;
>> > +}
>> > +
>> > +#--------------------------------------------------------------------------
>> > +
>> > +sub _do_request {
>> > + my $req = shift;
>> > +
>> > + # Ensure that the environment is clean so that nothing happens
>> > + # that we're unaware of.
>> > + my %ENV_SAVE = %ENV;
>> > + delete $ENV{http_proxy};
>> > + delete $ENV{https_proxy};
>> > + delete $ENV{HTTP_PROXY};
>> > + delete $ENV{HTTPS_PROXY};
>> > +
>> > + # Go through each ua and try to get a good connection. If we get
>> > + # connection refused from any of them, try another.
>> > + my $response;
>> > + foreach my $ua (@lwps) {
>> > + Debug("MTTGDS client trying proxy: $ua->{proxy} / $ua->{source}\n");
>> > + $ENV{https_proxy} = $ua->{proxy}
>> > + if ("https" eq $ua->{scheme});
>> > +
>> > + # Do the HTTP request
>> > + $response = $ua->{agent}->request($req);
>> > +
>> > + # If it succeeded, or if it failed with something other than
>> > + # code 500, return (code 500 = can't connect)
>> > + if ($response->is_success() ||
>> > + $response->code() != 500) {
>> > + Debug("MTTGDS proxy successful / not 500\n");
>> > + %ENV = %ENV_SAVE;
>> > + return $response;
>> > + }
>> > + Debug("MTTGDS proxy unsuccessful -- trying next\n");
>> > +
>> > + # Otherwise, loop around and try again
>> > + Debug("Proxy $ua->{proxy} failed code: " .
>> > + $response->status_line . "\n" . $response->content . "\n");
>> > + }
>> > +
>> > + # Sorry -- nothing got through...
>> > + Debug("MTTGDS proxy totally unsuccessful\n");
>> > + %ENV = %ENV_SAVE;
>> > + return $response;
>> > +}
>> > +
>> > +#--------------------------------------------------------------------------
>> > +
>> > +# Create test file results, and prepare the HTTP file upload
>> > +# request
>> > +
>> > +my $request_count = 0;
>> > +
>> > +sub _prepare_request {
>> > + my ($phase, $report, $form, $attachment )=@_;
>> > +
>> > + my $ini = $MTT::Globals::Internals->{ini};
>> > + my $repository_path = MTT::Values::Value( $ini, "VBench", 'repository_tempdir' );
>> > + my $repository_name = MTT::Values::Value( $ini, "VBench", 'repository_dirname_prefix' );
>> > + my ($fh, $filename);
>> > + my $tmpdir;
>> > +
>> > + # Find a temporary directory for files
>> > + if (!defined($repository_path) || $repository_path eq '')
>> > + {
>> > + $tmpdir = tempdir( CLEANUP => 1);
>> > + ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.yaml' );
>> > + }
>> > + elsif (!defined($repository_name) || $repository_name eq '')
>> > + {
>> > + MTT::Files::mkdir($repository_path) if (! -d $repository_path);
>> > + $tmpdir = tempdir( DIR => "$repository_path", CLEANUP => 0);
>> > + ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.yaml' );
>> > + }
>> > + else
>> > + {
>> > + $request_count++;
>> > + MTT::Files::mkdir($repository_path) if (! -d $repository_path);
>> > + $tmpdir = "${repository_path}/${repository_name}_${request_count}";
>> > + $filename = "$tmpdir/${repository_name}_${request_count}.yaml";
>> > + }
>> > +
>> > + my $raw_filename = ();
>> > +
>> > + MTT::Files::mkdir($tmpdir);
>> > +
>> > + if ( keys %$attachment ) {
>> > + foreach my $file (keys %$attachment) {
>> > + Debug (" Attachment: $file\n");
>> > + MTT::Values::Functions::shell("cp -r $file $tmpdir/$attachment->{$file}");
>> > + }
>> > + $raw_filename = "$tmpdir/data_file.zip";
>> > + }
>> > +
>> > + # Generate YAML file contents
>> > + YAML::XS::DumpFile("$filename", $form);
>> > +
>> > + if ( $raw_filename ne '')
>> > + {
>> > + MTT::Values::Functions::shell(
>> > + "cd $tmpdir; zip -9 -r $raw_filename *");
>> > + }
>> > +
>> > + # Chech Google Datastore put entity limitation
>> > + $raw_filename = '' if 1048576 <= ((-s "$raw_filename") + (-s "$filename"));
>> > +
>> > + my $req;
>> > + # Create the "upload" POST request
>> > + if (-e $raw_filename)
>> > + {
>> > + $req = POST $url,
>> > + Content_Type => 'form-data',
>> > + Content => [
>> > + SUBMIT => 1,
>> > + data => ["$filename"],
>> > + raw => ["$raw_filename"],
>> > + description => "Submit data and raw on the phase <$phase>"
>> > + ];
>> > + }
>> > + else
>> > + {
>> > + $req = POST $url,
>> > + Content_Type => 'form-data',
>> > + Content => [
>> > + SUBMIT => 1,
>> > + data => ["$filename"],
>> > + description => "Submit data only on the phase <$phase>"
>> > + ];
>> > + }
>> > +
>> > + $req->authorization_basic($username, $password);
>> > +
>> > + return (\$req, $filename);
>> > +}
>> > +
>> > +1;
>> > _______________________________________________
>> > mtt-svn mailing list
>> > mtt-svn_at_[hidden]
>> > http://www.open-mpi.org/mailman/listinfo.cgi/mtt-svn
>>
>>
>> --
>> Jeff Squyres
>> jsquyres_at_[hidden]
>> For corporate legal information go to: http://www.cisco.com/web/about/doing_business/legal/cri/
>>
>>
>> _______________________________________________
>> mtt-devel mailing list
>> mtt-devel_at_[hidden]
>> http://www.open-mpi.org/mailman/listinfo.cgi/mtt-devel
>>
>> _______________________________________________
>> mtt-devel mailing list
>> mtt-devel_at_[hidden]
>> http://www.open-mpi.org/mailman/listinfo.cgi/mtt-devel
>
> _______________________________________________
> mtt-devel mailing list
> mtt-devel_at_[hidden]
> http://www.open-mpi.org/mailman/listinfo.cgi/mtt-devel
>
> _______________________________________________
> mtt-devel mailing list
> mtt-devel_at_[hidden]
> http://www.open-mpi.org/mailman/listinfo.cgi/mtt-devel

-- 
Jeff Squyres
jsquyres_at_[hidden]
For corporate legal information go to: http://www.cisco.com/web/about/doing_business/legal/cri/