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-mai...@open-mpi.org> 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@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-...@open-mpi.org > http://www.open-mpi.org/mailman/listinfo.cgi/mtt-svn -- Jeff Squyres jsquy...@cisco.com For corporate legal information go to: http://www.cisco.com/web/about/doing_business/legal/cri/
