Hi,

We are switching from datastore (feature we added a couple of years ago) to
MongoDB NoSQL DB to keep mtt results.

We are adding some "regression" capability based on  MTT and MongoDB
reporter:

- run mtt
- when mtt finishes, extract results for previous runs of the same test
with same parameters
- compare performance metrics and generate regression report (excel)
- attach regression report to the mtt email report

So, we are adding all lego-like utils to support this:

- save results to OO storage (for comfort using from Perl)
- create Analyzers for various well-known tests
- query results, group them and generate regression statistics, place
report into excel (mongo-query.pl)
- Generate report which can be attached to mtt report (breport.pl)


So, we have reporter and query tool for Mongo, which is simple and
customizable.

regards
M


On Wed, Aug 1, 2012 at 2:00 PM, Jeff Squyres <jsquy...@cisco.com> wrote:

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

Reply via email to