File Coverage

blib/lib/Metabrik/Client/Mongodb.pm
Criterion Covered Total %
statement 9 49 18.3
branch 0 28 0.0
condition 0 6 0.0
subroutine 3 10 30.0
pod 1 7 14.2
total 13 100 13.0


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # client::mongodb Brik
5             #
6             package Metabrik::Client::Mongodb;
7 1     1   867 use strict;
  1         3  
  1         30  
8 1     1   5 use warnings;
  1         2  
  1         27  
9              
10 1     1   5 use base qw(Metabrik);
  1         3  
  1         655  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             host => [ qw(host) ],
20             port => [ qw(port) ],
21             client => [ qw(INTERNAL) ],
22             database => [ qw(database) ],
23             collection => [ qw(collection) ],
24             },
25             attributes_default => {
26             host => 'localhost',
27             port => 27017,
28             },
29             commands => {
30             connect => [ qw(host|OPTIONAL port|OPTIONAL) ],
31             list_database_names => [ ],
32             list_database_collection_names => [ qw(database) ],
33             get_database => [ qw(database) ],
34             get_database_collection => [ qw(database collection) ],
35             get_database_collection_find_all => [ qw(database collection) ],
36             },
37             require_modules => {
38             MongoDB => [ ],
39             },
40             };
41             }
42              
43             #
44             # Some search examples:
45             # https://metacpan.org/pod/distribution/MongoDB/lib/MongoDB/Examples.pod
46             #
47              
48             sub connect {
49 0     0 0   my $self = shift;
50 0           my ($host, $port) = @_;
51              
52 0   0       $host ||= $self->host;
53 0   0       $port ||= $self->port;
54              
55 0           my $client = MongoDB::MongoClient->new(
56             host => "mongodb://$host:$port",
57             );
58              
59 0           return $self->client($client);
60             }
61              
62             sub list_database_names {
63 0     0 0   my $self = shift;
64              
65 0           my $client = $self->client;
66 0 0         $self->brik_help_run_undef_arg('connect', $client) or return;
67              
68 0           return [ $client->database_names ];
69             }
70              
71             sub list_database_collection_names {
72 0     0 0   my $self = shift;
73 0           my ($database) = @_;
74              
75 0           my $client = $self->client;
76 0 0         $self->brik_help_run_undef_arg('connect', $client) or return;
77 0 0         $self->brik_help_run_undef_arg('list_database_collection_names', $database) or return;
78              
79 0 0         my $db = $self->get_database($database) or return;
80              
81 0           return [ $db->collection_names ];
82             }
83              
84             sub get_database {
85 0     0 0   my $self = shift;
86 0           my ($database) = @_;
87              
88 0           my $client = $self->client;
89 0 0         $self->brik_help_run_undef_arg('connect', $client) or return;
90 0 0         $self->brik_help_run_undef_arg('get_database', $database) or return;
91              
92 0           return $client->get_database($database);
93             }
94              
95             sub get_database_collection {
96 0     0 0   my $self = shift;
97 0           my ($database, $collection) = @_;
98              
99 0           my $client = $self->client;
100 0 0         $self->brik_help_run_undef_arg('connect', $client) or return;
101 0 0         $self->brik_help_run_undef_arg('get_database_collection', $database) or return;
102 0 0         $self->brik_help_run_undef_arg('get_database_collection', $collection) or return;
103              
104 0 0         my $db = $self->get_database($database) or return;
105              
106 0           return $db->get_collection($collection);
107             }
108              
109             sub get_database_collection_find_all {
110 0     0 0   my $self = shift;
111 0           my ($database, $collection) = @_;
112              
113 0           my $client = $self->client;
114 0 0         $self->brik_help_run_undef_arg('connect', $client) or return;
115 0 0         $self->brik_help_run_undef_arg('get_database_collection', $database) or return;
116 0 0         $self->brik_help_run_undef_arg('get_database_collection', $collection) or return;
117              
118 0 0         my $coll = $self->get_database_collection($database, $collection) or return;
119              
120 0           return [ $coll->find()->all() ];
121             }
122              
123             1;
124              
125             __END__