<commit_before>#!/usr/bin/env perl

#
#  Copyright 2009-2014 MongoDB, Inc.
#
#  Licensed under the Apache License, Version 2.0 (the "License");
#  you may not use this file except in compliance with the License.
#  You may obtain a copy of the License at
#
#  http://www.apache.org/licenses/LICENSE-2.0
#
#  Unless required by applicable law or agreed to in writing, software
#  distributed under the License is distributed on an "AS IS" BASIS,
#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#  See the License for the specific language governing permissions and
#  limitations under the License.
#

use 5.008;
use strict;
use warnings;

use constant {

    MOST_DOCS => 1000,
    SOME_DOCS => 100,
    CPU_RUN_TIME => 2,
};

my ($profile, $bench, $dataset_path, $lines_to_read, $profile_out, $bench_out);

BEGIN {

=head1 SYNOPSIS

bench.pl [options]

Options:
    -profile            enable profiling
    -profileout         file to output profiling data to (default : mongo-perl-prof.out)
    -bench              enable benchmarking
    -benchout           file to output benchmark data to (default: mongo-perl-bench.csv)
    -dataset            dataset to use. expects a schema to exist in the form of dataset.schema.json
    -lines              lines to read from dataset (default: 1000)

=cut

    $profile = '';
    $bench = '';
    $dataset_path = '';
    $lines_to_read = MOST_DOCS;
    $profile_out = 'mongo-perl-prof.out';
    $bench_out = 'mongo-perl-bench.csv';

    use Getopt::Long;
    use Pod::Usage;
    GetOptions(
        "profile" => \$profile,
        "profileout=s" => \$profile_out,
        "bench" => \$bench,
        "benchout=s" => \$bench_out,
        "dataset=s" => \$dataset_path,
        "lines=i" => \$lines_to_read,
    ) or pod2usage(2);

    $ENV{NYTPROF} = "file=$profile_out";
}

use Devel::NYTProf;
use Benchmark qw/:all/;
use Path::Class qw/file/;
use IO::Handle qw//;
use JSON::XS;
use MongoDB;
use version;
our $VERSION = 'v0.0.1';

my $client = MongoDB::MongoClient->new;
my $db = $client->get_database("benchdb");
$db->drop;

# Print test info
my $build = $client->get_database( 'admin' )->get_collection( '$cmd' )->find_one( { buildInfo => 1 } );
my ($version_str) = $build->{version} =~ m{^([0-9.]+)};
my $server_version = version->parse("v$version_str");
print "Driver $MongoDB::VERSION, Perl v$], MongoDB $server_version\n";

my %bench_results; # treated as a global

if ($dataset_path) {

    my ($dataset_size, $schema, @data) = get_data_from_json($dataset_path, $lines_to_read);
    my %dataset = create_dataset(\@data);
    print "Dataset: " . file($dataset_path)->basename . ", size: $dataset_size\n";

    # Fill db for read with dataset
    {
        print "Importing dataset...";
        STDOUT->flush();

        my $read_coll = $db->get_collection("read");
        $read_coll->drop;
        $read_coll->insert($_) for @{$dataset{all_docs}};
        print " done\n";
    }

    # Creating
    # These benchmarks should be bottlenecked by BSON encoding
    # based on the dataset provided.
    {
        my $insert_coll = $db->get_collection("inserts");

        my @small_doc_some = ($dataset{smallest_doc}) x SOME_DOCS;
        my @small_doc_most = ($dataset{smallest_doc}) x MOST_DOCS;
        my @large_doc_some = ($dataset{largest_doc}) x SOME_DOCS;
        my @large_doc_most = ($dataset{largest_doc}) x MOST_DOCS;

        my $data = [
            ["single insert" => $dataset{single_doc}],
            ["batch insert ".SOME_DOCS." docs" => $dataset{some_docs}],
            ["batch insert ".MOST_DOCS." docs" => $dataset{most_docs}],
            ["single insert small doc" => $dataset{smallest_doc}],
            ["batch insert ".SOME_DOCS." small doc" => \@small_doc_some],
            ["batch insert ".MOST_DOCS." small doc"=> \@small_doc_most],
            ["single insert large doc" => $dataset{largest_doc}],
            ["batch insert ".SOME_DOCS." large doc" => \@large_doc_some],
            ["batch insert ".MOST_DOCS." large doc" => \@large_doc_most],
        ];

        for my $benchmark (@$data) {

            run_test($benchmark->[0], sub { $insert_coll->insert($benchmark->[1]) } );
        }
    }

    # Reading
    # These benchmarks should be bottlenecked by BSON decoding
    # based on the dataset provided.
    {
        my $read_coll = $db->get_collection("read");


        run_test("find_one simple", sub { $read_coll->find_one } );

        run_test("find_one query", sub { $read_coll->find_one($schema->{find_spec}) } );

        run_test("find all and iterate", sub {

            my $cursor = $read_coll->find();
            () while $cursor->next;
        });

        run_test("find on query and iterate", sub {

            my $cursor = $read_coll->find($schema->{find_spec});
            () while $cursor->next;
        });
    }

    # Updating
    {
        # We're about to clobber read so these tests should be performed last.
        my $read_coll = $db->get_collection("read");

        run_test("update one w/ inc" => sub { $read_coll->update({}, {'$inc' => {"newField" => 123}}) } );

        run_test("update all w/ inc" => sub { $read_coll->update({}, {'$inc' => {"newField" => 123}}) }, {'multiple' => 1} );

        run_test("update one w/ small doc" => sub { $read_coll->update({}, $dataset{smallest_doc}) } );

        run_test("update one w/ large doc", sub { $read_coll->update({}, $dataset{largest_doc}) } );
    }

} else {

    print "Running against known dataset since none was provided\n";

    # BSON
    # These benchmarks indirectly test BSON through insert and find.
    {
        use MongoDB::BSON::Binary;

        my $doc_size = 100;
<commit_msg>Add bulk tests<commit_after>#!/usr/bin/env perl

#
#  Copyright 2009-2014 MongoDB, Inc.
#
#  Licensed under the Apache License, Version 2.0 (the "License");
#  you may not use this file except in compliance with the License.
#  You may obtain a copy of the License at
#
#  http://www.apache.org/licenses/LICENSE-2.0
#
#  Unless required by applicable law or agreed to in writing, software
#  distributed under the License is distributed on an "AS IS" BASIS,
#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#  See the License for the specific language governing permissions and
#  limitations under the License.
#

use 5.008;
use strict;
use warnings;

use constant {

    MOST_DOCS => 1000,
    SOME_DOCS => 100,
    CPU_RUN_TIME => 2,
};

my ($profile, $bench, $dataset_path, $lines_to_read, $profile_out, $bench_out);

BEGIN {

=head1 SYNOPSIS

bench.pl [options]

Options:
    -profile            enable profiling
    -profileout         file to output profiling data to (default : mongo-perl-prof.out)
    -bench              enable benchmarking
    -benchout           file to output benchmark data to (default: mongo-perl-bench.csv)
    -dataset            dataset to use. expects a schema to exist in the form of dataset.schema.json
    -lines              lines to read from dataset (default: 1000)

=cut

    $profile = '';
    $bench = '';
    $dataset_path = '';
    $lines_to_read = MOST_DOCS;
    $profile_out = 'mongo-perl-prof.out';
    $bench_out = 'mongo-perl-bench.csv';

    use Getopt::Long;
    use Pod::Usage;
    GetOptions(
        "profile" => \$profile,
        "profileout=s" => \$profile_out,
        "bench" => \$bench,
        "benchout=s" => \$bench_out,
        "dataset=s" => \$dataset_path,
        "lines=i" => \$lines_to_read,
    ) or pod2usage(2);

    $ENV{NYTPROF} = "file=$profile_out";
}

use Devel::NYTProf;
use Benchmark qw/:all/;
use Path::Class qw/file/;
use IO::Handle qw//;
use JSON::XS;
use MongoDB;
use version;
our $VERSION = 'v0.0.1';

my $client = MongoDB::MongoClient->new;
my $db = $client->get_database("benchdb");
$db->drop;

# Print test info
my $build = $client->get_database( 'admin' )->get_collection( '$cmd' )->find_one( { buildInfo => 1 } );
my ($version_str) = $build->{version} =~ m{^([0-9.]+)};
my $server_version = version->parse("v$version_str");
print "Driver $MongoDB::VERSION, Perl v$], MongoDB $server_version\n";

my %bench_results; # treated as a global

if ($dataset_path) {

    my ($dataset_size, $schema, @data) = get_data_from_json($dataset_path, $lines_to_read);
    my %dataset = create_dataset(\@data);
    print "Dataset: " . file($dataset_path)->basename . ", size: $dataset_size\n";

    my $read_coll = $db->get_collection("read");
    my $insert_coll = $db->get_collection("inserts");

    # Fill db for read with dataset
    {
        print "Importing dataset...";
        STDOUT->flush();

        $read_coll->drop;
        my $bulk = $read_coll->initialize_ordered_bulk_op;
        $bulk->insert($_) for @{$dataset{all_docs}};
        $bulk->execute;
        print " done\n";
    }

    # Creating
    # These benchmarks should be bottlenecked by BSON encoding
    # based on the dataset provided.
    {

        my @small_doc_some = ($dataset{smallest_doc}) x SOME_DOCS;
        my @small_doc_most = ($dataset{smallest_doc}) x MOST_DOCS;
        my @large_doc_some = ($dataset{largest_doc}) x SOME_DOCS;
        my @large_doc_most = ($dataset{largest_doc}) x MOST_DOCS;

        my $data = [
            ["single insert" => $dataset{single_doc}],
            ["batch insert ".SOME_DOCS." docs" => $dataset{some_docs}],
            ["batch insert ".MOST_DOCS." docs" => $dataset{most_docs}],
            ["single insert small docs" => $dataset{smallest_doc}],
            ["batch insert ".SOME_DOCS." small docs" => \@small_doc_some],
            ["batch insert ".MOST_DOCS." small docs"=> \@small_doc_most],
            ["single insert large docs" => $dataset{largest_doc}],
            ["batch insert ".SOME_DOCS." large docs" => \@large_doc_some],
            ["batch insert ".MOST_DOCS." large docs" => \@large_doc_most],
        ];

        for my $benchmark (@$data) {

            run_test($benchmark->[0], sub { $insert_coll->insert($benchmark->[1]) } );
        }

        # Bulk creation
        {
            my $bulk_data = [
                ["all docs" => $dataset{all_docs}],
                [SOME_DOCS." small docs" => \@small_doc_some],
                [MOST_DOCS." small docs"=> \@small_doc_most],
                [SOME_DOCS." large docs" => \@large_doc_some],
                [MOST_DOCS." large docs" => \@large_doc_most],
            ];

            for my $method (qw/initialize_ordered_bulk_op initialize_unordered_bulk_op/) {

                for my $benchmark (@$bulk_data) {

                    run_test("$method on $benchmark->[0]", sub {

                        my $bulk = $insert_coll->$method;
                        $bulk->insert($_) for @{$benchmark->[1]};
                        $bulk->execute;
                    });
                }
            }
        }
    }

    # Reading
    # These benchmarks should be bottlenecked by BSON decoding
    # based on the dataset provided.
    {
        run_test("find_one simple", sub { $read_coll->find_one } );

        run_test("find_one query", sub { $read_coll->find_one($schema->{find_spec}) } );

        run_test("find all and iterate", sub {

            my $cursor = $read_coll->find();
            () while $cursor->next;
        });

        run_test("find on query and iterate", sub {

            my $cursor = $read_coll->find($schema->{find_spec});
            () while $cursor->next;
        });
    }

    # Updating
    {
        # We're about to clobber read so these tests should be performed last.
        run_test("update one w/ inc" => sub { $read_coll->update({}, {'$inc' => {"newField" => 123}}) } );

        run_test("update all w/ inc" => sub { $read_coll->update({}, {'$inc' => {"newField" => 123}}) }, {'multiple' => 1} );

        run_test("update one w/ small doc" => sub { $read_coll->update({}, $dataset{smallest_doc}) } );

        run_test("update one w/ large doc", sub { $read_coll->update({}, $dataset{largest_doc}) } );
    }

} else {

    print "Running against known dataset since none was provided\n";

    # BSON
    # These benchmarks indirectly test BSON through insert and find.
    {
        use MongoDB::BSON::Binary;

        my $doc_size = 100;

{'fraction_non_alphanumeric': 0.1479416106281778, 'fraction_numerical': 0.008200754469411186, 'mean_word_length': 2.6058545239503252, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 129, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2311638', 'n_tokens_mistral': 4098, 'n_tokens_neox': 3869, 'n_words': 1039}