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) <jsquy...@cisco.com>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.o...@gmail.com> 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 <jsquy...@cisco.com> 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-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/ >> >> >> _______________________________________________ >> mtt-devel mailing list >> mtt-de...@open-mpi.org >> http://www.open-mpi.org/mailman/listinfo.cgi/mtt-devel >> > > _______________________________________________ > mtt-devel mailing list > mtt-de...@open-mpi.org > http://www.open-mpi.org/mailman/listinfo.cgi/mtt-devel > > > _______________________________________________ > mtt-devel mailing list > mtt-de...@open-mpi.org > http://www.open-mpi.org/mailman/listinfo.cgi/mtt-devel >
