Sounds sweet!

Will you guys be contributing This stuff, perchance?

Sent from my phone. No type good. 

On Aug 4, 2012, at 11:56 AM, "Mike Dubman" <mike.ompi@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 <jsquyres@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-mailer@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-svn@open-mpi.org
> http://www.open-mpi.org/mailman/listinfo.cgi/mtt-svn


--
Jeff Squyres
jsquyres@cisco.com
For corporate legal information go to: http://www.cisco.com/web/about/doing_business/legal/cri/


_______________________________________________
mtt-devel mailing list
mtt-devel@open-mpi.org
http://www.open-mpi.org/mailman/listinfo.cgi/mtt-devel

_______________________________________________
mtt-devel mailing list
mtt-devel@open-mpi.org
http://www.open-mpi.org/mailman/listinfo.cgi/mtt-devel