File Coverage

blib/lib/Sport/Analytics/NHL/DB.pm

Criterion	Covered	Total	%
statement	36	76	47.3
branch	0	8	0.0
condition	3	29	10.3
subroutine	12	16	75.0
pod	4	4	100.0
total	55	133	41.3

package Sport::Analytics::NHL::DB;

use strict;
use warnings FATAL => 'all';

use Carp;
use POSIX;

use Tie::IxHash;
use boolean;

use Sport::Analytics::NHL::Config;
use Sport::Analytics::NHL::LocalConfig;
use Sport::Analytics::NHL::Util;

use if ! $ENV{HOCKEYDB_NODB} && $MONGO_DB, 'MongoDB';
use if ! $ENV{HOCKEYDB_NODB} && $MONGO_DB, 'MongoDB::OID';
use if ! $ENV{HOCKEYDB_NODB} && $MONGO_DB, 'MongoDB::MongoClient';

=head1 NAME

Sport::Analytics::NHL::DB - Interface to MongoDB to store NHL reports.

=head1 SYNOPSYS

Interface to MongoDB in order to store the semi-structured NHL reports into it. Provides the database handle and most of the bulky database operations. Does not subclass MongoDB - the handle is stored in the class's object.

    use Sport::Analytics::NHL::DB;
    my $db = Sport::Analytics::NHL::DB->new();
    my $team_id = $db->resolve_team_db('San Jose Sharks'); # $team_id becomes 'SJS'.

=head1 METHODS

=over 2

=item C

 Constructor. Sets the database connection. Controlled by global variables:
  * $MONGO_HOST - host of the mongodb server (def. 127.0.0.1)
  * $MONGO_PORT - port of the mongodb server (def. 27017)
  * $MONGO_DB   - name of the mongo database (def 'hockey')
  Also, the database can be specified via $ENV{HOCKEYDB_DBNAME}

 The database handle is stored in the dbh field of the object which is a blessed hashref.

=item C

 Resolves a team by a given possible identifier to a normalized 3-letter identifier. The target identifiers are the keys to the %TEAMS hash in Sport::Analytics::NHL::Config.pm (q.v.)
 Argument: the team identifier/name (e.g. 'Rangers')
 Returns: the system identifier (e.g. NYR)

=item C

 Inserts the collected schedule (see Sport::Analytics::NHL::Scraper), initializing the indexes for the schedule collection if necessary.
 Collections: schedule
 Arguments: the list of scheduled games with their defined fields
 Returns: the number of the inserted games

=item C

 Gets the list of ids of games already in the database
 Collections: games
 Arguments: optional - hashref containing the start_season and stop_season of the query
 Returns: the arrayref of the ids of the existing games

=back

=cut

our $DEFAULT_DB = 'hockey';
our $DEFAULT_HOST = '127.0.0.1';
our $DEFAULT_PORT = 27017;

sub new ($;$) {

	my $class    = shift;
	my $database = shift || $ENV{HOCKEYDB_DBNAME} || $MONGO_DB || $DEFAULT_DB;

	my $self = {};
	my $host = $MONGO_HOST || $DEFAULT_HOST;
	my $port = $MONGO_PORT || $DEFAULT_PORT;
	$self->{client} = MongoDB::MongoClient->new(
		host => sprintf(
			"mongodb://%s:%d", $host, $port
		)
	);
	my $db = $database || $DEFAULT_DB;
	$self->{dbh} = $self->{client}->get_database($db);
	$ENV{HOCKEYDB_DBNAME} = $db;
	verbose "Using Mongo database $db";
	$self->{dbname} = $db;
	bless $self, $class;
	$self;
}

sub resolve_team_db ($$) {

	my $self = shift;
	my $team = shift;

	$team = uc $team;
	my $teams_c = $self->{dbh}->get_collection('teams');

	my $team_db = $teams_c->find_one({
		'$or' => [
			{ _id   => $team },
			{ short => $team },
			{ long  => $team },
			{ full  => $team },
		],
	});
	$team_db ? $team_db->{_id} : undef;
}

sub insert_schedule ($@) {

	my $self  = shift;
	my @games = @_;

	return 0 unless @games;
	my $schedule_c = $self->{dbh}->get_collection('schedule');
	my $schedule_x = $schedule_c->indexes();
	$schedule_x->create_many(
		{ keys => [ game_id => 1 ], options => {unique => 1}  },
		{ keys => [ date    => 1 ],                           },
		{ keys => [ season => 1, stage => 1, season_id => 1 ] },
	);
	@games = grep {
		if ($_->{stage} == $REGULAR || $_->{stage} == $PLAYOFF) {
			$_->{game_id} += 0;
			$_->{ts} += 0;
		}
		else { 0 }
	} map(ref $_ && ref $_ eq 'ARRAY' ? @{$_} : $_, @games);
	$schedule_c->delete_many({_id => { '$in' => [ map {$_->{_id}} @games ] } });
	$schedule_c->insert_many([@games]);
	debug "Inserted " . scalar(@games) . " games for season $games[0]->{season}";
	scalar @games;
}

sub get_existing_game_ids ($;$) {

	my $self = shift;
	my $opts = shift || {
		stop_season => $CURRENT_SEASON, start_season => $CURRENT_SEASON
	};

	my @games = $self->{dbh}->get_collection('games')->find({
		season => {
			'$gte' => $opts->{start_season}+0,
			'$lte' => $opts->{stop_season} +0
		},
	}, {_id => 1})->all();

	[ map($_->{_id}+0,@games) ];
}

1;

=head1 AUTHOR

More Hockey Stats, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Sport::Analytics::NHL::DB


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

Copyright 2018 More Hockey Stats.

This program is released under the following license: gnu

=cut