diff -Nru libcatmandu-store-mongodb-perl-0.0700/Build.PL libcatmandu-store-mongodb-perl-0.0802/Build.PL --- libcatmandu-store-mongodb-perl-0.0700/Build.PL 2017-03-23 13:38:25.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/Build.PL 2019-02-08 15:16:45.000000000 +0000 @@ -1,5 +1,5 @@ -# This file was automatically generated by Dist::Zilla::Plugin::ModuleBuild v6.008. +# This file was automatically generated by Dist::Zilla::Plugin::ModuleBuild v6.012. use strict; use warnings; @@ -18,7 +18,7 @@ "Nicolas Steenlant, C<< >>" ], "dist_name" => "Catmandu-Store-MongoDB", - "dist_version" => "0.07", + "dist_version" => "0.0802", "license" => "perl", "module_name" => "Catmandu::Store::MongoDB", "recursive_test_files" => 1, diff -Nru libcatmandu-store-mongodb-perl-0.0700/Changes libcatmandu-store-mongodb-perl-0.0802/Changes --- libcatmandu-store-mongodb-perl-0.0700/Changes 2017-03-23 13:38:25.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/Changes 2019-02-08 15:16:45.000000000 +0000 @@ -1,5 +1,17 @@ Revision history for Catmandu-Store-MongoDB +0.0802 2019-02-08 16:16:42 CET + - transaction method is now list/scalar context aware + +0.0801 2019-02-08 14:01:49 CET + - fix bug in get method + +0.08 2019-02-05 15:44:53 CET + - support for MongoDB 4.0 transactions + +0.0701 2019-01-18 15:04:24 CET + - use count_documents instead of deprecated count method + 0.07 2017-03-23 14:38:15 CET - use the new Catmandu::CQLSearchable role diff -Nru libcatmandu-store-mongodb-perl-0.0700/debian/changelog libcatmandu-store-mongodb-perl-0.0802/debian/changelog --- libcatmandu-store-mongodb-perl-0.0700/debian/changelog 2017-10-02 18:15:56.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/debian/changelog 2019-02-19 23:22:12.000000000 +0000 @@ -1,3 +1,33 @@ +libcatmandu-store-mongodb-perl (0.0802-1) unstable; urgency=medium + + [ upstream ] + * New release(s). + + [ Salvatore Bonaccorso ] + * Update Vcs-* headers for switch to salsa.debian.org. + + [ gregor herrmann ] + * Update GitHub URLs to use HTTPS. + + [ Jonas Smedegaard ] + * Update watch file: Rewrite usage comment. + * Simplify rules. + Stop build-depend on cdbs. + * Relax to (build-)depend unversioned on libcql-parser-perl + libmoo-perl libnamespace-clean-perl libtest-exception-perl: + Needed versions satisfied even in oldstable. + * Set Rules-Requires-Root: no. + * Declare compliance with Debian Policy 4.3.0. + * Stop build-depend on dh-buildinfo. + * Mark build-dependencies needed only for testsuite as such. + * Wrap and sort control file. + * Explain Catmandu last in long description. + * Update copyright info: + + Extend coverage of packaging. + + Bump (yes, not extend) coverage for main upstream author. + + -- Jonas Smedegaard Wed, 20 Feb 2019 00:22:12 +0100 + libcatmandu-store-mongodb-perl (0.0700-1) unstable; urgency=medium [ upstream ] diff -Nru libcatmandu-store-mongodb-perl-0.0700/debian/control libcatmandu-store-mongodb-perl-0.0802/debian/control --- libcatmandu-store-mongodb-perl-0.0700/debian/control 2017-10-02 18:15:56.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/debian/control 2019-02-19 23:18:41.000000000 +0000 @@ -1,40 +1,50 @@ Source: libcatmandu-store-mongodb-perl Maintainer: Debian Perl Group -Uploaders: Jonas Smedegaard +Uploaders: + Jonas Smedegaard , Section: perl Testsuite: autopkgtest-pkg-perl Priority: optional -Build-Depends: cdbs, - perl, - libmodule-build-perl, +Build-Depends: debhelper, - dh-buildinfo, - libcql-parser-perl (>= 1.12), - libcatmandu-perl (>= 1.0400), - libcpanel-json-xs-perl (>= 3.0213), - libmongodb-perl (>= 1.6.1), - libmoo-perl (>= 1.006000), - libnamespace-clean-perl (>= 0.24), - libsoftware-license-perl, - perl (>= 5.21.1) | libtest-simple-perl (>= 1.001003), - libtest-exception-perl (>= 0.32), - libtest-pod-perl, - libtest-warn-perl -Standards-Version: 4.1.1 -Vcs-Browser: https://anonscm.debian.org/git/pkg-perl/packages/libcatmandu-store-mongodb-perl.git -Vcs-Git: https://anonscm.debian.org/git/pkg-perl/packages/libcatmandu-store-mongodb-perl.git + libcatmandu-perl (>= 1.0400) , + libcpanel-json-xs-perl (>= 3.0213) , + libcql-parser-perl , + libmodule-build-perl, + libmongodb-perl (>= 1.6.1) , + libmoo-perl , + libnamespace-clean-perl , + libsoftware-license-perl , + libtest-exception-perl , + libtest-pod-perl , + libtest-warn-perl , + perl, + perl (>= 5.21.1) | libtest-simple-perl (>= 1.001003) , +Standards-Version: 4.3.0 +Vcs-Browser: https://salsa.debian.org/perl-team/modules/packages/libcatmandu-store-mongodb-perl +Vcs-Git: https://salsa.debian.org/perl-team/modules/packages/libcatmandu-store-mongodb-perl.git Homepage: https://github.com/LibreCat/Catmandu-Store-MongoDB +Rules-Requires-Root: no Package: libcatmandu-store-mongodb-perl Architecture: all -Depends: ${cdbs:Depends}, +Depends: + libcatmandu-perl (>= 1.0400), + libcpanel-json-xs-perl (>= 3.0213), + libcql-parser-perl, + libmongodb-perl (>= 1.6.1), + libmoo-perl, + libnamespace-clean-perl, ${misc:Depends}, - ${perl:Depends} -Enhances: ${cdbs:Enhances} + ${perl:Depends}, +Enhances: + libcatmandu-perl, Description: searchable store backed by MongoDB - Catmandu provides a suite of Perl modules to ease the import, storage, - retrieval, export and transformation of metadata records. - . - Catmandu::Store::MongoDB is a Perl package that can store data into - MongoDB databases. The database as a whole is called a 'store'. + Catmandu::Store::MongoDB is a Perl package + that can store data into MongoDB databases. + The database as a whole is called a 'store'. Databases also have compartments (e.g. tables) called Catmandu::Bag-s. + . + Catmandu provides a suite of Perl modules + to ease the import, storage, retrieval, export and transformation + of metadata records. diff -Nru libcatmandu-store-mongodb-perl-0.0700/debian/control.in libcatmandu-store-mongodb-perl-0.0802/debian/control.in --- libcatmandu-store-mongodb-perl-0.0700/debian/control.in 2017-10-02 18:10:02.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/debian/control.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,25 +0,0 @@ -Source: libcatmandu-store-mongodb-perl -Maintainer: Debian Perl Group -Uploaders: Jonas Smedegaard -Section: perl -Testsuite: autopkgtest-pkg-perl -Priority: optional -Build-Depends: @cdbs@ -Standards-Version: 4.1.1 -Vcs-Browser: https://anonscm.debian.org/git/pkg-perl/packages/libcatmandu-store-mongodb-perl.git -Vcs-Git: https://anonscm.debian.org/git/pkg-perl/packages/libcatmandu-store-mongodb-perl.git -Homepage: https://github.com/LibreCat/Catmandu-Store-MongoDB - -Package: libcatmandu-store-mongodb-perl -Architecture: all -Depends: ${cdbs:Depends}, - ${misc:Depends}, - ${perl:Depends} -Enhances: ${cdbs:Enhances} -Description: searchable store backed by MongoDB - Catmandu provides a suite of Perl modules to ease the import, storage, - retrieval, export and transformation of metadata records. - . - Catmandu::Store::MongoDB is a Perl package that can store data into - MongoDB databases. The database as a whole is called a 'store'. - Databases also have compartments (e.g. tables) called Catmandu::Bag-s. diff -Nru libcatmandu-store-mongodb-perl-0.0700/debian/copyright libcatmandu-store-mongodb-perl-0.0802/debian/copyright --- libcatmandu-store-mongodb-perl-0.0700/debian/copyright 2017-10-02 18:15:56.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/debian/copyright 2019-02-19 23:21:59.000000000 +0000 @@ -2,31 +2,37 @@ Upstream-Name: Catmandu::Store::MongoDB Upstream-Contact: https://github.com/LibreCat/Catmandu-Store-MongoDB/issues Source: https://github.com/LibreCat/Catmandu-Store-MongoDB - git://github.com/LibreCat/Catmandu-Store-MongoDB + https://github.com/LibreCat/Catmandu-Store-MongoDB Files: * -Copyright: 2017, Nicolas Steenlant +Copyright: 2019, Nicolas Steenlant License-Grant: - This program is free software; you can redistribute it and/or modify it - under the terms of either: the GNU General Public License as published - by the Free Software Foundation; or the Artistic License. + This program is free software; + you can redistribute it and/or modify it + under the terms of either: + the GNU General Public License + as published by the Free Software Foundation; + or the Artistic License. License: Artistic or GPL-1+ Files: t/lib/MongoDBTest.pm Copyright: 2009-2013, 10gen, Inc License-Grant: - 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 + 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 License: Apache-2.0 Files: debian/* -Copyright: 2014-2017, Jonas Smedegaard +Copyright: 2014-2017,2019, Jonas Smedegaard License-Grant: - This program is free software: you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by the - Free Software Foundation; either version 3, or (at your option) any - later version. + This program is free software; + you can redistribute it and/or modify it + under the terms of the GNU General Public License + as published by the Free Software Foundation; + either version 3, or (at your option) any later version. License: GPL-3+ License: Artistic diff -Nru libcatmandu-store-mongodb-perl-0.0700/debian/copyright_hints libcatmandu-store-mongodb-perl-0.0802/debian/copyright_hints --- libcatmandu-store-mongodb-perl-0.0700/debian/copyright_hints 2017-10-02 18:15:56.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/debian/copyright_hints 2019-02-19 23:22:12.000000000 +0000 @@ -1,4 +1,4 @@ -Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ Upstream-Name: FIXME Upstream-Contact: FIXME Source: FIXME @@ -10,11 +10,11 @@ META.json META.yml cpanfile - debian/README.source debian/compat debian/control - debian/control.in + debian/docs debian/gbp.conf + debian/rules debian/source/format debian/watch dist.ini @@ -30,13 +30,6 @@ License: UNKNOWN FIXME -Files: debian/copyright-check - debian/rules -Copyright: 2014-2017, Jonas Smedegaard - 2016-2017, Jonas Smedegaard -License: GPL-3+ - FIXME - Files: t/lib/MongoDBTest.pm Copyright: 2009-2013, 10gen, Inc. License: Apache-2.0 @@ -56,7 +49,7 @@ Copyright: 1989, Free Software Foundation, Inc. 19xx name of author 19yy - 2017, Nicolas Steenlant. + 2019, Nicolas Steenlant. disclaimer" for the program, if ed by the Free interest in the @@ -65,12 +58,16 @@ License: Artistic or GPL-1+ FIXME +Files: debian/copyright-check +Copyright: 2016-2017, Jonas Smedegaard +License: GPL-3+ + FIXME + Files: debian/source/lintian-overrides -Copyright: Apache-2.+ +Copyright: Apache-2.0 Artistic GPL-1+ GPL-3+ - LGPL-2.1+ apache-2.0 artistic gpl-1+ diff -Nru libcatmandu-store-mongodb-perl-0.0700/debian/docs libcatmandu-store-mongodb-perl-0.0802/debian/docs --- libcatmandu-store-mongodb-perl-0.0700/debian/docs 1970-01-01 00:00:00.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/debian/docs 2019-02-19 09:01:13.000000000 +0000 @@ -0,0 +1 @@ +README diff -Nru libcatmandu-store-mongodb-perl-0.0700/debian/README.source libcatmandu-store-mongodb-perl-0.0802/debian/README.source --- libcatmandu-store-mongodb-perl-0.0700/debian/README.source 2017-10-02 17:20:44.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/debian/README.source 1970-01-01 00:00:00.000000000 +0000 @@ -1,11 +0,0 @@ -CDBS+git-buildpackage ---------------------- - -This source package uses CDBS and git-buildpackage. NMUs need not (but -are encouraged to) make special use of these tools. In particular, the -debian/control.in file can be completely ignored. - -More info here: http://wiki.debian.org/CDBS+git-buildpackage - - - -- Jonas Smedegaard Mon, 18 Feb 2013 12:55:37 +0100 diff -Nru libcatmandu-store-mongodb-perl-0.0700/debian/rules libcatmandu-store-mongodb-perl-0.0802/debian/rules --- libcatmandu-store-mongodb-perl-0.0700/debian/rules 2017-10-02 18:09:21.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/debian/rules 2019-02-07 01:17:13.000000000 +0000 @@ -1,42 +1,4 @@ #!/usr/bin/make -f -# -*- mode: makefile; coding: utf-8 -*- -# Copyright © 2014-2017 Jonas Smedegaard -# Description: Main Debian packaging script for Catmandu::Store::MongoDB -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . -include /usr/share/cdbs/1/class/perl-build.mk -include /usr/share/cdbs/1/rules/debhelper.mk - -pkg = $(DEB_SOURCE_PACKAGE) - -# Needed by upstream build and (always) at runtime -deps = libcql-parser-perl (>= 1.12) -deps +=, libcatmandu-perl (>= 1.0400) -deps +=, libcpanel-json-xs-perl (>= 3.0213) -deps +=, libmongodb-perl (>= 1.6.1) -deps +=, libmoo-perl (>= 1.006000) -deps +=, libnamespace-clean-perl (>= 0.24) - -# Needed by upstream build -bdeps +=, libsoftware-license-perl - -# Needed by upstream testsuite -deps-test = perl (>= 5.21.1) | libtest-simple-perl (>= 1.001003) -deps-test +=, libtest-exception-perl (>= 0.32) -deps-test +=, libtest-pod-perl, libtest-warn-perl - -CDBS_BUILD_DEPENDS +=, $(deps), $(bdeps), $(deps-test) -CDBS_DEPENDS_$(pkg) = $(deps) -CDBS_ENHANCES_$(pkg) = libcatmandu-perl +%: + dh $@ diff -Nru libcatmandu-store-mongodb-perl-0.0700/debian/watch libcatmandu-store-mongodb-perl-0.0802/debian/watch --- libcatmandu-store-mongodb-perl-0.0700/debian/watch 2017-10-02 17:32:18.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/debian/watch 2019-02-19 23:09:20.000000000 +0000 @@ -1,5 +1,8 @@ -# run "uscan --report" to check or "gpb import-orig --uscan" to update version=4 -opts="versionmangle=s/^\d+\.\d\d\b\K/00/" \ - https://metacpan.org/release/Catmandu-Store-MongoDB \ - .*/Catmandu-Store-MongoDB@ANY_VERSION@@ARCHIVE_EXT@ +# check: uscan --report +# update: gbp import-orig --upstream-vcs-tag=vX.Y.Z --uscan + +opts=\ +versionmangle=s/^\d+\.\d\d\b\K/00/ \ +https://metacpan.org/release/Catmandu-Store-MongoDB \ +.*/Catmandu-Store-MongoDB@ANY_VERSION@@ARCHIVE_EXT@ diff -Nru libcatmandu-store-mongodb-perl-0.0700/lib/Catmandu/Store/MongoDB/Bag.pm libcatmandu-store-mongodb-perl-0.0802/lib/Catmandu/Store/MongoDB/Bag.pm --- libcatmandu-store-mongodb-perl-0.0700/lib/Catmandu/Store/MongoDB/Bag.pm 2017-03-23 13:38:25.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/lib/Catmandu/Store/MongoDB/Bag.pm 2019-02-08 15:16:45.000000000 +0000 @@ -2,25 +2,25 @@ use Catmandu::Sane; -our $VERSION = '0.07'; +our $VERSION = '0.0802'; use Catmandu::Util qw(:is); use Catmandu::Store::MongoDB::Searcher; use Catmandu::Hits; use Cpanel::JSON::XS qw(decode_json); use Moo; -use Data::Dumper; use Catmandu::Store::MongoDB::CQL; use namespace::clean; with 'Catmandu::Bag'; +with 'Catmandu::Droppable'; with 'Catmandu::CQLSearchable'; has collection => ( - is => 'ro', + is => 'ro', init_arg => undef, - lazy => 1, - builder => '_build_collection', + lazy => 1, + builder => '_build_collection', ); has cql_mapping => (is => 'ro'); @@ -30,11 +30,23 @@ $self->store->database->get_collection($self->name); } +sub _options { + my ($self, $opts) = @_; + $opts //= {}; + $opts->{session} = $self->store->session if $self->store->has_session; + $opts; +} + +sub _cursor { + my ($self, $filter, $opts) = @_; + $self->collection->find($filter // {}, $self->_options($opts)); +} + sub generator { my ($self) = @_; sub { state $cursor = do { - my $c = $self->collection->find; + my $c = $self->_cursor; $c->immortal(1); $c; }; @@ -44,14 +56,14 @@ sub to_array { my ($self) = @_; - my @all = $self->collection->find->all; + my @all = $self->_cursor->all; \@all; } sub each { my ($self, $sub) = @_; - my $cursor = $self->collection->find; - my $n = 0; + my $cursor = $self->_cursor; + my $n = 0; while (my $data = $cursor->next) { $sub->($data); $n++; @@ -60,7 +72,8 @@ } sub count { - $_[0]->collection->count({}); + my ($self) = @_; + $self->collection->count_documents({}, $self->_options); } # efficiently handle: @@ -71,10 +84,12 @@ my ($orig, $self, $arg1, $arg2) = @_; if (is_string($arg1)) { if (is_value($arg2) || is_regex_ref($arg2)) { - return $self->collection->find_one({$arg1 => $arg2}); + return $self->collection->find_one({$arg1 => $arg2}, + {}, $self->_options); } if (is_array_ref($arg2)) { - return $self->collection->find_one({$arg1 => {'$in' => $arg2}}); + return $self->collection->find_one({$arg1 => {'$in' => $arg2}}, + {}, $self->_options); } } $self->$orig($arg1, $arg2); @@ -88,16 +103,25 @@ my ($orig, $self, $arg1, $arg2) = @_; if (is_string($arg1)) { if (is_value($arg2) || is_regex_ref($arg2)) { - return Catmandu::Iterator->new(sub { sub { - state $cursor = $self->collection->find({$arg1 => $arg2}); - $cursor->next; - }}); + return Catmandu::Iterator->new( + sub { + sub { + state $cursor = $self->_cursor({$arg1 => $arg2}); + $cursor->next; + } + } + ); } if (is_array_ref($arg2)) { - return Catmandu::Iterator->new(sub { sub { - state $cursor = $self->collection->find({$arg1 => {'$in' => $arg2}}); - $cursor->next; - }}); + return Catmandu::Iterator->new( + sub { + sub { + state $cursor + = $self->_cursor({$arg1 => {'$in' => $arg2}}); + $cursor->next; + } + } + ); } } $self->$orig($arg1, $arg2); @@ -110,16 +134,26 @@ my ($orig, $self, $arg1, $arg2) = @_; if (is_string($arg1)) { if (is_value($arg2)) { - return Catmandu::Iterator->new(sub { sub { - state $cursor = $self->collection->find({$arg1 => {'$ne' => $arg2}}); - $cursor->next; - }}); + return Catmandu::Iterator->new( + sub { + sub { + state $cursor + = $self->_cursor({$arg1 => {'$ne' => $arg2}}); + $cursor->next; + } + } + ); } if (is_array_ref($arg2)) { - return Catmandu::Iterator->new(sub { sub { - state $cursor = $self->collection->find({$arg1 => {'$nin' => $arg2}}); - $cursor->next; - }}); + return Catmandu::Iterator->new( + sub { + sub { + state $cursor + = $self->_cursor({$arg1 => {'$nin' => $arg2}}); + $cursor->next; + } + } + ); } } $self->$orig($arg1, $arg2); @@ -127,69 +161,78 @@ sub pluck { my ($self, $key) = @_; - Catmandu::Iterator->new(sub { sub { - state $cursor = $self->collection->find->fields({$key => 1}); - ($cursor->next || return)->{$key}; - }}); + Catmandu::Iterator->new( + sub { + sub { + state $cursor + = $self->_cursor({}, {projection => {$key => 1}}); + ($cursor->next || return)->{$key}; + } + } + ); } sub get { my ($self, $id) = @_; - $self->collection->find_one({_id => $id}); + $self->collection->find_one({_id => $id}, {}, $self->_options); } sub add { my ($self, $data) = @_; - $self->collection->replace_one({_id => $data->{_id}}, $data, {upsert => 1}); + $self->collection->replace_one({_id => $data->{_id}}, + $data, $self->_options({upsert => 1})); } sub delete { my ($self, $id) = @_; - $self->collection->delete_one({_id => $id}); + $self->collection->delete_one({_id => $id}, $self->_options); } sub delete_all { my ($self) = @_; - $self->collection->delete_many({}); + $self->collection->delete_many({}, $self->_options); } sub delete_by_query { my ($self, %args) = @_; - $self->collection->delete_many($args{query}); + $self->collection->delete_many($args{query}, $self->_options); } sub search { my ($self, %args) = @_; - my $query = $args{query}; - my $start = $args{start}; - my $limit = $args{limit}; - my $bag = $args{reify}; + my $query = $args{query}; + my $start = $args{start}; + my $limit = $args{limit}; + my $bag = $args{reify}; my $fields = $args{fields}; - my $cursor = $self->collection->find($query)->skip($start)->limit($limit); - if ($bag) { # only retrieve _id - $cursor->fields({}) + my $cursor = $self->_cursor($query)->skip($start)->limit($limit); + if ($bag) { # only retrieve _id + $cursor->fields({}); } - elsif ($fields) { # only retrieve specified fields + elsif ($fields) { # only retrieve specified fields $cursor->fields($fields); } - if (my $sort = $args{sort}) { + if (my $sort = $args{sort}) { $cursor->sort($sort); } my @hits = $cursor->all; if ($bag) { - @hits = map { $bag->get($_->{_id}) } @hits; + @hits = map {$bag->get($_->{_id})} @hits; } - Catmandu::Hits->new({ - start => $start, - limit => $limit, - total => $self->collection->count($query), - hits => \@hits, - }); + Catmandu::Hits->new( + { + start => $start, + limit => $limit, + total => + $self->collection->count_documents($query, $self->_options), + hits => \@hits, + } + ); } sub searcher { @@ -199,15 +242,18 @@ sub translate_sru_sortkeys { my ($self, $sortkeys) = @_; - $self->log->debug("translating sort_keys: $sortkeys"); - my $keys = - [ grep { defined $_ } map { $self->_translate_sru_sortkey($_) } split /\s+/, $sortkeys ]; + my $keys = [ + grep {defined $_} map {$self->_translate_sru_sortkey($_)} split /\s+/, + $sortkeys + ]; my $mongo_sort = []; - # flatten sort keys + + # flatten sortkeys for (@$keys) { - push @$mongo_sort , @$_; + push @$mongo_sort, @$_; } - $self->log->debug("mongo_sort : " . Dumper($mongo_sort)); + $self->log->debugf("translating sortkeys '$sortkeys' to mongo sort: %s", + $mongo_sort); $mongo_sort; } @@ -218,28 +264,33 @@ ($asc && ($asc == 1 || $asc == -1)) || return; if (my $map = $self->cql_mapping) { $field = lc $field; - $field =~ s/(?<=[^_])_(?=[^_])//g if $map->{strip_separating_underscores}; + $field =~ s/(?<=[^_])_(?=[^_])//g + if $map->{strip_separating_underscores}; $map = $map->{indexes} || return; $map = $map->{$field} || return; $map->{sort} || return; if (ref $map->{sort} && $map->{sort}{field}) { $field = $map->{sort}{field}; - } elsif (ref $map->{field}) { + } + elsif (ref $map->{field}) { $field = $map->{field}->[0]; - } elsif ($map->{field}) { + } + elsif ($map->{field}) { $field = $map->{field}; } } + # Use a bad trick to force $asc interpreted as an integer - [ $field => $asc + 0 ]; + [$field => $asc + 0]; } sub translate_cql_query { - my($self,$query) = @_; - $self->log->debug("translating cql: $query"); - my $mongo_query = - Catmandu::Store::MongoDB::CQL->new(mapping => $self->cql_mapping)->parse($query); - $self->log->debug("mongo_query : " . Dumper($mongo_query)); + my ($self, $query) = @_; + my $mongo_query + = Catmandu::Store::MongoDB::CQL->new(mapping => $self->cql_mapping) + ->parse($query); + $self->log->debugf("translating cql '$query' to mongo query: %s", + $mongo_query); $mongo_query; } @@ -271,6 +322,6 @@ =head1 SEE ALSO -L, L +L, L, L =cut diff -Nru libcatmandu-store-mongodb-perl-0.0700/lib/Catmandu/Store/MongoDB/CQL.pm libcatmandu-store-mongodb-perl-0.0802/lib/Catmandu/Store/MongoDB/CQL.pm --- libcatmandu-store-mongodb-perl-0.0700/lib/Catmandu/Store/MongoDB/CQL.pm 2017-03-23 13:38:25.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/lib/Catmandu/Store/MongoDB/CQL.pm 2019-02-08 15:16:45.000000000 +0000 @@ -22,18 +22,17 @@ sub parse { my ($self, $query) = @_; - my $node = eval { - $self->parser->parse($query) - } or do { + my $node = eval {$self->parser->parse($query)} or do { my $error = $@; die "cql error: $error"; }; my $mongo_query = $self->visit($node); - if ( $self->log->is_debug() ) { + if ($self->log->is_debug()) { - $self->log->debug("CQL query: $query, translated into mongo query: ".Dumper($mongo_query)); + $self->log->debug("CQL query: $query, translated into mongo query: " + . Dumper($mongo_query)); } @@ -72,8 +71,9 @@ #fields to search for if ($qualifier =~ $any_field) { + #set default field explicitely - if ( $self->mapping && $self->mapping->{default_index} ) { + if ($self->mapping && $self->mapping->{default_index}) { $search_field = $self->mapping->{default_index}; } else { @@ -84,15 +84,20 @@ $search_field = $qualifier; #change search field - $search_field =~ s/(?<=[^_])_(?=[^_])//g if $self->mapping && $self->mapping->{strip_separating_underscores}; - my $q_mapping = $indexes->{$search_field} or confess "cql error: unknown index $search_field"; - $q_mapping->{op}->{$base} or confess "cql error: relation $base not allowed"; + $search_field =~ s/(?<=[^_])_(?=[^_])//g + if $self->mapping + && $self->mapping->{strip_separating_underscores}; + my $q_mapping = $indexes->{$search_field} + or confess "cql error: unknown index $search_field"; + $q_mapping->{op}->{$base} + or confess "cql error: relation $base not allowed"; my $op = $q_mapping->{op}->{$base}; if (ref $op && $op->{field}) { $search_field = $op->{field}; - } elsif ($q_mapping->{field}) { + } + elsif ($q_mapping->{field}) { $search_field = $q_mapping->{field}; } @@ -125,55 +130,55 @@ } #field search - my $unmasked = array_includes([map { $_->[1] } @modifiers],"cql.unmasked"); + my $unmasked + = array_includes([map {$_->[1]} @modifiers], "cql.unmasked"); # trick to force numeric values interpreted as integers $term = $term + 0 if ($term =~ /^[1-9]\d*$/); if ($base eq '=' or $base eq 'scr') { - unless($unmasked){ - $term = _is_wildcard( $term ) ? - _wildcard_to_regex( $term ) : - $term; + unless ($unmasked) { + $term + = _is_wildcard($term) ? _wildcard_to_regex($term) : $term; } - $search_clause = +{ $search_field => $term }; + $search_clause = +{$search_field => $term}; } elsif ($base eq '<') { - $search_clause = +{ $search_field => { '$lt' => $term } }; + $search_clause = +{$search_field => {'$lt' => $term}}; } elsif ($base eq '>') { - $search_clause = +{ $search_field => { '$gt' => $term } }; + $search_clause = +{$search_field => {'$gt' => $term}}; } elsif ($base eq '<=') { - $search_clause = +{ $search_field => { '$lte' => $term } }; + $search_clause = +{$search_field => {'$lte' => $term}}; } elsif ($base eq '>=') { - $search_clause = +{ $search_field => { '$gte' => $term } }; + $search_clause = +{$search_field => {'$gte' => $term}}; } elsif ($base eq '<>') { - $search_clause = +{ $search_field => { '$ne' => $term } }; + $search_clause = +{$search_field => {'$ne' => $term}}; } elsif ($base eq 'exact') { - $search_clause = +{ $search_field => $term }; + $search_clause = +{$search_field => $term}; } elsif ($base eq 'all') { my @terms = split /\s+/, $term; - #query $all in mongo means exact matching, so we always need regular expressions here - for(my $i = 0; $i < scalar(@terms) ; $i++){ +#query $all in mongo means exact matching, so we always need regular expressions here + for (my $i = 0; $i < scalar(@terms); $i++) { my $term = $terms[$i]; - if ( $unmasked ) { + if ($unmasked) { - $term = _quote_wildcard( $term ); + $term = _quote_wildcard($term); $term = qr($term); } - elsif ( _is_wildcard( $term ) ) { + elsif (_is_wildcard($term)) { - $term = _wildcard_to_regex( $term ); + $term = _wildcard_to_regex($term); } else { @@ -186,25 +191,25 @@ } - $search_clause = +{ $search_field => { '$all' => \@terms } }; + $search_clause = +{$search_field => {'$all' => \@terms}}; } elsif ($base eq 'any') { my @terms = split /\s+/, $term; - #query $in in mongo means exact matching, so we always need regular expressions here - for(my $i = 0; $i < scalar(@terms) ; $i++){ +#query $in in mongo means exact matching, so we always need regular expressions here + for (my $i = 0; $i < scalar(@terms); $i++) { my $term = $terms[$i]; - if ( $unmasked ) { + if ($unmasked) { - $term = _quote_wildcard( $term ); + $term = _quote_wildcard($term); $term = qr($term); } - elsif ( _is_wildcard( $term ) ) { + elsif (_is_wildcard($term)) { - $term = _wildcard_to_regex( $term ); + $term = _wildcard_to_regex($term); } else { @@ -217,65 +222,62 @@ } - $search_clause = +{ $search_field => { '$in' => \@terms } }; + $search_clause = +{$search_field => {'$in' => \@terms}}; } elsif ($base eq 'within') { my @range = split /\s+/, $term; if (@range == 1) { - $search_clause = +{ $search_field => $term }; + $search_clause = +{$search_field => $term}; } else { - $search_clause = +{ - $search_field => { - '$gte' => $range[0], - '$lte' => $range[1] - } - }; + $search_clause + = +{$search_field => + {'$gte' => $range[0], '$lte' => $range[1]} + }; } } + #as $base is always set, this code should be removed? else { - unless($unmasked){ - $term = _is_wildcard( $term ) ? - _wildcard_to_regex( $term ) : - $term; + unless ($unmasked) { + $term + = _is_wildcard($term) ? _wildcard_to_regex($term) : $term; } - $search_clause = +{ $search_field => $term }; + $search_clause = +{$search_field => $term}; } return $search_clause; } elsif ($node->isa('CQL::ProxNode')) { + # TODO: apply cql_mapping confess "not supported"; } elsif ($node->isa('CQL::BooleanNode')) { - my $lft = $node->left; - my $rgt = $node->right; + my $lft = $node->left; + my $rgt = $node->right; my $lft_q = $self->visit($lft); my $rgt_q = $self->visit($rgt); - my $op = '$'.lc( $node->op ); + my $op = '$' . lc($node->op); - if ( $op eq '$and' || $op eq '$or' ) { - return +{ $op => [ $lft_q, $rgt_q ] }; + if ($op eq '$and' || $op eq '$or') { + return +{$op => [$lft_q, $rgt_q]}; } - elsif ( $op eq '$not' ) { - my($k,$v) = each(%$rgt_q); + elsif ($op eq '$not') { + my ($k, $v) = each(%$rgt_q); - if( $k eq '$or' ){ - return +{ %$lft_q, '$nor' => $v }; - } - elsif ( $k eq '$and' ) { - #$nand not implemented yet (https://jira.mongodb.org/browse/SERVER-15577) - return +{ %$lft_q, '$nor' => [{ - '$and' => $v - }] }; - } else { - return +{ %$lft_q, '$nor' => [{ - '$and' => [{ $k => $v }] - }] }; + if ($k eq '$or') { + return +{%$lft_q, '$nor' => $v}; + } + elsif ($k eq '$and') { + + #$nand not implemented yet (https://jira.mongodb.org/browse/SERVER-15577) + return +{%$lft_q, '$nor' => [{'$and' => $v}]}; + } + else { + return +{%$lft_q, '$nor' => [{'$and' => [{$k => $v}]}]}; } } } @@ -284,10 +286,10 @@ sub _is_wildcard { my $value = $_[0]; - (index($value,'^') == 0) || - (rindex($value,'^') == length($value) - 1) || - (index($value,'*') >= 0) || - (index($value,'?') >= 0); + (index($value, '^') == 0) + || (rindex($value, '^') == length($value) - 1) + || (index($value, '*') >= 0) + || (index($value, '?') >= 0); } sub _wildcard_to_regex { diff -Nru libcatmandu-store-mongodb-perl-0.0700/lib/Catmandu/Store/MongoDB/Searcher.pm libcatmandu-store-mongodb-perl-0.0802/lib/Catmandu/Store/MongoDB/Searcher.pm --- libcatmandu-store-mongodb-perl-0.0700/lib/Catmandu/Store/MongoDB/Searcher.pm 2017-03-23 13:38:25.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/lib/Catmandu/Store/MongoDB/Searcher.pm 2019-02-08 15:16:45.000000000 +0000 @@ -2,7 +2,7 @@ use Catmandu::Sane; -our $VERSION = '0.07'; +our $VERSION = '0.0802'; use Moo; use namespace::clean; @@ -21,11 +21,12 @@ my ($self) = @_; sub { state $cursor = do { - my $c = $self->bag->collection->find($self->query); + my $c = $self->bag->_cursor($self->query); $c->fields($self->fields) if defined $self->fields; + # limit is unused because the perl driver doesn't expose batchSize $c->limit($self->total) if defined $self->total; - $c->sort($self->sort) if defined $self->sort; + $c->sort($self->sort) if defined $self->sort; $c->immortal(1); $c; }; @@ -33,24 +34,24 @@ }; } -sub slice { # TODO constrain total? +sub slice { # TODO constrain total? my ($self, $start, $total) = @_; $start //= 0; $self->new( - bag => $self->bag, - query => $self->query, - start => $self->start + $start, - limit => $self->limit, - total => $total, - sort => $self->sort, + bag => $self->bag, + query => $self->query, + start => $self->start + $start, + limit => $self->limit, + total => $total, + sort => $self->sort, fields => $self->fields, ); } - -sub count { # TODO constrain on start, total? +sub count { # TODO constrain on start, total? my ($self) = @_; - $self->bag->collection->count($self->query); + $self->bag->collection->count_documents($self->query, + $self->bag->_options); } 1; diff -Nru libcatmandu-store-mongodb-perl-0.0700/lib/Catmandu/Store/MongoDB.pm libcatmandu-store-mongodb-perl-0.0802/lib/Catmandu/Store/MongoDB.pm --- libcatmandu-store-mongodb-perl-0.0700/lib/Catmandu/Store/MongoDB.pm 2017-03-23 13:38:25.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/lib/Catmandu/Store/MongoDB.pm 2019-02-08 15:16:45.000000000 +0000 @@ -2,7 +2,7 @@ use Catmandu::Sane; -our $VERSION = '0.07'; +our $VERSION = '0.0802'; use Moo; use Catmandu::Store::MongoDB::Bag; @@ -10,10 +10,15 @@ use namespace::clean; with 'Catmandu::Store'; +with 'Catmandu::Transactional'; -has client => (is => 'ro', lazy => 1, builder => '_build_client'); +has client => (is => 'lazy'); has database_name => (is => 'ro', required => 1); -has database => (is => 'ro', lazy => 1, builder => '_build_database'); +has database => (is => 'lazy', handles => [qw(drop)]); +has session => + (is => 'rw', predicate => 1, clearer => 1, writer => 'set_session'); + +with 'Catmandu::Droppable'; sub _build_client { my $self = shift; @@ -37,15 +42,56 @@ $self->{_args} = {}; for my $key (keys %$args) { - next if $key eq 'client'; - next if $key eq 'database_name'; - next if $key eq 'database'; + next + if $key eq 'client' + || $key eq 'database_name' + || $key eq 'database'; $self->{_args}{$key} = $args->{$key}; } } -sub drop { - $_[0]->database->drop; +sub transaction { + my ($self, $sub) = @_; + + if ($self->has_session) { + return $sub->(); + } + + my $session = $self->client->start_session; + my @res; + + eval { + $self->set_session($session); + $session->start_transaction; + + @res = $sub->(); + + COMMIT: { + eval { + $session->commit_transaction; + 1; + } // do { + my $err = $@; + if ($err->has_error_label("UnknownTransactionCommitResult")) { + redo COMMIT; + } + else { + die $err; + } + }; + } + + $self->clear_session; + + 1; + } // do { + my $err = $@; + $session->abort_transaction; + $self->clear_session; + die $err; + }; + + wantarray ? @res : $res[0]; } 1; @@ -110,7 +156,7 @@ =head1 METHODS -=head2 new(database_name => $name, %connectio_opts) +=head2 new(database_name => $name, %connection_opts) =head2 new(database_name => $name , bags => { data => { cql_mapping => $cql_mapping } }) @@ -182,15 +228,26 @@ Delete the store and all it's bags. +=head2 transaction(\&sub) + +Execute C<$sub> within a transaction. See L. + +Note that only MongoDB databases with feature compatibility >= 4.0 and in a +replica set have support for transactions. See +L +and +L +for more info. + =head1 Search -Search the database: see L. This module supports an additional search parameter: +Search the database: see L and L. This module supports an additional search parameter: - fields => { => <0|1> } : limit fields to return from a query (see L) =head1 SEE ALSO -L, L , L +L, L, L, L, L =head1 AUTHOR diff -Nru libcatmandu-store-mongodb-perl-0.0700/LICENSE libcatmandu-store-mongodb-perl-0.0802/LICENSE --- libcatmandu-store-mongodb-perl-0.0700/LICENSE 2017-03-23 13:38:25.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/LICENSE 2019-02-08 15:16:45.000000000 +0000 @@ -1,4 +1,4 @@ -This software is copyright (c) 2017 by Nicolas Steenlant. +This software is copyright (c) 2019 by Nicolas Steenlant. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. @@ -12,7 +12,7 @@ --- The GNU General Public License, Version 1, February 1989 --- -This software is Copyright (c) 2017 by Nicolas Steenlant. +This software is Copyright (c) 2019 by Nicolas Steenlant. This is free software, licensed under: @@ -272,7 +272,7 @@ --- The Artistic License 1.0 --- -This software is Copyright (c) 2017 by Nicolas Steenlant. +This software is Copyright (c) 2019 by Nicolas Steenlant. This is free software, licensed under: diff -Nru libcatmandu-store-mongodb-perl-0.0700/MANIFEST libcatmandu-store-mongodb-perl-0.0802/MANIFEST --- libcatmandu-store-mongodb-perl-0.0700/MANIFEST 2017-03-23 13:38:25.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/MANIFEST 2019-02-08 15:16:45.000000000 +0000 @@ -1,4 +1,4 @@ -# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.008. +# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.012. Build.PL Changes LICENSE diff -Nru libcatmandu-store-mongodb-perl-0.0700/META.json libcatmandu-store-mongodb-perl-0.0802/META.json --- libcatmandu-store-mongodb-perl-0.0700/META.json 2017-03-23 13:38:25.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/META.json 2019-02-08 15:16:45.000000000 +0000 @@ -4,7 +4,7 @@ "Nicolas Steenlant, C<< >>" ], "dynamic_config" : 0, - "generated_by" : "Dist::Milla version v1.0.17, Dist::Zilla version 6.008, CPAN::Meta::Converter version 2.150005", + "generated_by" : "Dist::Milla version v1.0.20, Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], @@ -36,7 +36,7 @@ }, "develop" : { "requires" : { - "Dist::Milla" : "v1.0.17", + "Dist::Milla" : "v1.0.20", "Test::Pod" : "1.41" } }, @@ -73,7 +73,7 @@ "web" : "https://github.com/LibreCat/Catmandu-Store-MongoDB" } }, - "version" : "0.07", + "version" : "0.0802", "x_contributors" : [ "Johann Rolschewski ", "Nicolas Franck ", @@ -81,6 +81,8 @@ "Nicolas Steenlant ", "Patrick Hochstenbach " ], - "x_serialization_backend" : "Cpanel::JSON::XS version 3.0225" + "x_generated_by_perl" : "v5.28.1", + "x_serialization_backend" : "Cpanel::JSON::XS version 4.08", + "x_static_install" : 0 } diff -Nru libcatmandu-store-mongodb-perl-0.0700/META.yml libcatmandu-store-mongodb-perl-0.0802/META.yml --- libcatmandu-store-mongodb-perl-0.0700/META.yml 2017-03-23 13:38:25.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/META.yml 2019-02-08 15:16:45.000000000 +0000 @@ -12,7 +12,7 @@ configure_requires: Module::Build: '0.28' dynamic_config: 0 -generated_by: 'Dist::Milla version v1.0.17, Dist::Zilla version 6.008, CPAN::Meta::Converter version 2.150005' +generated_by: 'Dist::Milla version v1.0.20, Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -38,11 +38,13 @@ bugtracker: https://github.com/LibreCat/Catmandu-Store-MongoDB/issues homepage: https://github.com/LibreCat/Catmandu-Store-MongoDB repository: https://github.com/LibreCat/Catmandu-Store-MongoDB.git -version: '0.07' +version: '0.0802' x_contributors: - 'Johann Rolschewski ' - 'Nicolas Franck ' - 'Nicolas Steenlant ' - 'Nicolas Steenlant ' - 'Patrick Hochstenbach ' -x_serialization_backend: 'YAML::Tiny version 1.69' +x_generated_by_perl: v5.28.1 +x_serialization_backend: 'YAML::Tiny version 1.73' +x_static_install: 0 diff -Nru libcatmandu-store-mongodb-perl-0.0700/README libcatmandu-store-mongodb-perl-0.0802/README --- libcatmandu-store-mongodb-perl-0.0700/README 2017-03-23 13:38:25.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/README 2019-02-08 15:16:45.000000000 +0000 @@ -54,7 +54,7 @@ METHODS - new(database_name => $name, %connectio_opts) + new(database_name => $name, %connection_opts) new(database_name => $name , bags => { data => { cql_mapping => $cql_mapping } }) @@ -128,16 +128,29 @@ Delete the store and all it's bags. + transaction(\&sub) + + Execute $sub within a transaction. See Catmandu::Transactional. + + Note that only MongoDB databases with feature compatibility >= 4.0 and + in a replica set have support for transactions. See + https://docs.mongodb.com/manual/reference/command/setFeatureCompatibilityVersion/#view-fcv + and + https://docs.mongodb.com/manual/tutorial/convert-standalone-to-replica-set/ + for more info. + Search - Search the database: see Catmandu::Searchable. This module supports an - additional search parameter: + Search the database: see Catmandu::Searchable and + Catmandu::CQLSearchable. This module supports an additional search + parameter: - fields => { => <0|1> } : limit fields to return from a query (see L) SEE ALSO - Catmandu::Bag, Catmandu::Searchable , MongoDB::MongoClient + Catmandu::Bag, Catmandu::CQLSearchable, Catmandu::Droppable, + Catmandu::Transactional, MongoDB::MongoClient AUTHOR diff -Nru libcatmandu-store-mongodb-perl-0.0700/t/01-store.t libcatmandu-store-mongodb-perl-0.0802/t/01-store.t --- libcatmandu-store-mongodb-perl-0.0700/t/01-store.t 2017-03-23 13:38:25.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/t/01-store.t 2019-02-08 15:16:45.000000000 +0000 @@ -18,37 +18,41 @@ ok $store; -my $obj1 = $store->bag->add({ _id => '123' , name => 'Patrick' }); +my $obj1 = $store->bag->add({_id => '123', name => 'Patrick'}); ok $obj1; -is $obj1->{_id} , 123; +is $obj1->{_id}, 123; my $obj2 = $store->bag->get('123'); ok $obj2; -is_deeply $obj2 , { _id => '123' , name => 'Patrick'}; +is_deeply $obj2 , {_id => '123', name => 'Patrick'}; -$store->bag->add({ _id => '456' , name => 'Nicolas' }); +$store->bag->add({_id => '456', name => 'Nicolas'}); -is $store->bag->count , 2; +is $store->bag->count, 2; is $store->bag->search(query => '{"name":"Nicolas"}')->total, 1; $store->bag->delete('123'); -is $store->bag->count , 1; +is $store->bag->count, 1; $store->bag->delete_all; -is $store->bag->count , 0; +is $store->bag->count, 0; -my $obj3 = $store->bag->add({ _id => '789' , char => 'ABC', num => '123' }); +my $obj3 = $store->bag->add({_id => '789', char => 'ABC', num => '123'}); -is_deeply $store->bag->searcher(query => {char => "ABC"}, fields => { num => 1, _id => 0 })->first, { num => '123'}; +is_deeply $store->bag->searcher( + query => {char => "ABC"}, + fields => {num => 1, _id => 0} +)->first, {num => '123'}; -is_deeply $store->bag->search(query => {char => "ABC"}, fields => { _id => 1 })->first, { _id => '789'}; +is_deeply $store->bag->search(query => {char => "ABC"}, fields => {_id => 1}) + ->first, {_id => '789'}; END { if ($db) { diff -Nru libcatmandu-store-mongodb-perl-0.0700/t/02-connect.t libcatmandu-store-mongodb-perl-0.0802/t/02-connect.t --- libcatmandu-store-mongodb-perl-0.0700/t/02-connect.t 2017-03-23 13:38:25.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/t/02-connect.t 2019-02-08 15:16:45.000000000 +0000 @@ -20,6 +20,6 @@ host => 'mongodb://localhost:0' ); -dies_ok { $store->first } 'expecting to die'; +dies_ok {$store->first} 'expecting to die'; done_testing; diff -Nru libcatmandu-store-mongodb-perl-0.0700/t/03-cql-parser.t libcatmandu-store-mongodb-perl-0.0802/t/03-cql-parser.t --- libcatmandu-store-mongodb-perl-0.0700/t/03-cql-parser.t 2017-03-23 13:38:25.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/t/03-cql-parser.t 2019-02-08 15:16:45.000000000 +0000 @@ -7,70 +7,52 @@ my $cql_mapping = +{ default_relation => 'exact', - default_index => "all", - indexes => { - subject_1 => { - filter => ["lowercase"], + default_index => "all", + indexes => { + subject_1 => {filter => ["lowercase"], op => {'=' => 1}}, + subject_2 => {op => {'=' => {filter => ["lowercase"]}}}, + subject_3 => {cb => ["T", "filter_subject"], op => {'=' => 1}}, + subject_4 => {op => {'=' => {cb => ["T", "filter_subject"]}}}, + all => { op => { - '=' => 1 - } - }, - subject_2 => { - op => { - '=' => { filter => ["lowercase"] } - } - }, - subject_3 => { - cb => ["T","filter_subject"], - op => { - '=' => 1 - } - }, - subject_4 => { - op => { - '=' => { cb => ["T","filter_subject"] } - } - }, - all => { - op => { - '=' => 1, + '=' => 1, 'exact' => 1, - '<>' => 1, - 'any' => 1, - 'all' => 1, - within => 1 + '<>' => 1, + 'any' => 1, + 'all' => 1, + within => 1 } }, first_name => { op => { - '=' => 1, + '=' => 1, 'exact' => 1, - '<>' => 1, - 'any' => 1, - 'all' => 1, - within => 1 + '<>' => 1, + 'any' => 1, + 'all' => 1, + within => 1 } }, last_name => { field => "ln", - op => { - '=' => 1, + op => { + '=' => 1, 'exact' => 1, - '<>' => { field => "ln2" }, - 'any' => 1, - 'all' => 1, - within => 1 + '<>' => {field => "ln2"}, + 'any' => 1, + 'all' => 1, + within => 1 } }, year => { op => { - '=' => 1, - exact => 1, - '<>' => 1, - '>' => 1, - '<' => 1, - '>=' => 1, - '<=' => 1, + '=' => 1, + exact => 1, + '<>' => 1, + '>' => 1, + '<' => 1, + '>=' => 1, + '<=' => 1, 'within' => 1 } } @@ -79,26 +61,36 @@ my $parser; -lives_ok(sub{ - $parser = Catmandu::Store::MongoDB::CQL->new( mapping => $cql_mapping ); -},"CQL parser created"); +lives_ok( + sub { + $parser = Catmandu::Store::MongoDB::CQL->new(mapping => $cql_mapping); + }, + "CQL parser created" +); -dies_ok(sub{ +dies_ok( + sub { - $parser->parse(qq(first_name < "a")); + $parser->parse(qq(first_name < "a")); -},"cql - term query on unpermitted relation must die"); -dies_ok(sub{ + }, + "cql - term query on unpermitted relation must die" +); +dies_ok( + sub { - $parser->parse(qq(my_index = "Nicolas")); + $parser->parse(qq(my_index = "Nicolas")); -},"cql - term query on unpermitted index must die"); + }, + "cql - term query on unpermitted index must die" +); is_deeply( $parser->parse(qq(first_name = "Nicolas")), - { first_name => "Nicolas" }, + {first_name => "Nicolas"}, "cql - term query - relation =" ); + #fails for some reason #is_deeply( # $parser->parse(qq(first_name scr "Nicolas")), @@ -107,169 +99,140 @@ #); is_deeply( $parser->parse(qq("Nicolas")), - { all => "Nicolas" }, + {all => "Nicolas"}, "cql - term query - default index" ); is_deeply( $parser->parse(qq(first_name <> "Nicolas")), - { first_name => { '$ne' => "Nicolas" } }, + {first_name => {'$ne' => "Nicolas"}}, "cql - term query - <>" ); is_deeply( $parser->parse(qq(first_name exact "Nicolas")), - { first_name => "Nicolas" }, + {first_name => "Nicolas"}, "cql - term query - exact" ); is_deeply( $parser->parse(qq(first_name any "a b c")), - { first_name => { '$in' => [qr(a),qr(b),qr(c)] } }, + {first_name => {'$in' => [qr(a), qr(b), qr(c)]}}, "cql - term query - any" ); is_deeply( $parser->parse(qq(first_name any "^a b ^c^")), - { first_name => { '$in' => [qr(^a),qr(b),qr(^c$)] } }, + {first_name => {'$in' => [qr(^a), qr(b), qr(^c$)]}}, "cql - term query - any with wildcard" ); is_deeply( $parser->parse(qq(first_name any/cql.unmasked "^a b ^c^")), - { first_name => { '$in' => [qr(\^a),qr(b),qr(\^c\^)] } }, + {first_name => {'$in' => [qr(\^a), qr(b), qr(\^c\^)]}}, "cql - term query - any unmasked" ); is_deeply( $parser->parse(qq(first_name all "a b c")), - { first_name => { '$all' => [qr(a),qr(b),qr(c)] } }, + {first_name => {'$all' => [qr(a), qr(b), qr(c)]}}, "cql - term query - all" ); is_deeply( $parser->parse(qq(first_name all "^a b ^c^")), - { first_name => { '$all' => [qr(^a),qr(b),qr(^c$)] } }, + {first_name => {'$all' => [qr(^a), qr(b), qr(^c$)]}}, "cql - term query - all with wildcard" ); is_deeply( $parser->parse(qq(first_name all/cql.unmasked "^a b ^c^")), - { first_name => { '$all' => [qr(\^a),qr(b),qr(\^c\^)] } }, + {first_name => {'$all' => [qr(\^a), qr(b), qr(\^c\^)]}}, "cql - term query - all unmasked" ); is_deeply( $parser->parse(qq(last_name exact "Franck")), - { ln => "Franck" }, + {ln => "Franck"}, "cql - term query - field mapping 1" ); is_deeply( $parser->parse(qq(last_name <> "Franck")), - { ln2 => { '$ne' => "Franck" } }, + {ln2 => {'$ne' => "Franck"}}, "cql - term query - field mapping 2" ); is_deeply( $parser->parse(qq(year > 2009)), - { year => { '$gt' => 2009 } }, + {year => {'$gt' => 2009}}, "cql - term query - >" ); is_deeply( $parser->parse(qq(year < 2009)), - { year => { '$lt' => 2009 } }, + {year => {'$lt' => 2009}}, "cql - term query - <" ); is_deeply( $parser->parse(qq(year >= 2009)), - { year => { '$gte' => 2009 } }, + {year => {'$gte' => 2009}}, "cql - term query - >=" ); is_deeply( $parser->parse(qq(year <= 2009)), - { year => { '$lte' => 2009 } }, + {year => {'$lte' => 2009}}, "cql - term query - <=" ); is_deeply( $parser->parse(qq(year within "2009 2016")), - { year => { '$gte' => 2009, '$lte' => "2016" } }, + {year => {'$gte' => 2009, '$lte' => "2016"}}, "cql - term query - within" ); is_deeply( $parser->parse(qq(year exact "2009" and first_name = "Nicolas")), - { '$and' => [{ year => 2009 },{ first_name => "Nicolas" }] }, + {'$and' => [{year => 2009}, {first_name => "Nicolas"}]}, "cql - boolean query - and" ); is_deeply( $parser->parse(qq(year exact "2009" or first_name = "Nicolas")), - { '$or' => [{ year => 2009 },{ first_name => "Nicolas" }] }, + {'$or' => [{year => 2009}, {first_name => "Nicolas"}]}, "cql - boolean query - or" ); is_deeply( $parser->parse(qq(year exact "2009" not first_name = "Nicolas")), - { - '$nor' => [ - { - '$and' => [ - { - 'first_name' => 'Nicolas' - } - ] - } - ], - year => 2009 - }, + {'$nor' => [{'$and' => [{'first_name' => 'Nicolas'}]}], year => 2009}, "cql - boolean query - not" ); is_deeply( $parser->parse(qq(year exact "2009" not "Nicolas")), - { - '$nor' => [ - { - '$and' => [ - { - 'all' => 'Nicolas' - } - ] - } - ], - year => 2009 - }, + {'$nor' => [{'$and' => [{'all' => 'Nicolas'}]}], year => 2009}, "cql - boolean query - not all" ); is_deeply( - $parser->parse(qq(year exact "2009" not( first_name = "Nicolas" or last_name = "Franck" ))), - { - '$nor' => [ - { first_name => "Nicolas" },{ ln => "Franck" } - ], - year => 2009 - }, + $parser->parse( + qq(year exact "2009" not( first_name = "Nicolas" or last_name = "Franck" )) + ), + {'$nor' => [{first_name => "Nicolas"}, {ln => "Franck"}], year => 2009}, "cql - boolean query - not boolean or" ); is_deeply( - $parser->parse(qq(year exact "2009" not( first_name = "Nicolas" and last_name = "Franck" ))), + $parser->parse( + qq(year exact "2009" not( first_name = "Nicolas" and last_name = "Franck" )) + ), { - '$nor' => [ - { - '$and' => [ - { first_name => 'Nicolas' }, { ln => 'Franck' } - ] - } - ], - year => 2009 + '$nor' => [{'$and' => [{first_name => 'Nicolas'}, {ln => 'Franck'}]}], + year => 2009 }, "cql - boolean query - not boolean and" ); is_deeply( $parser->parse(qq(subject_1 = "AIRPLANES")), - { subject_1 => "airplanes" }, + {subject_1 => "airplanes"}, "cql - filter term field 1" ); is_deeply( $parser->parse(qq(subject_2 = "AIRPLANES")), - { subject_2 => "airplanes" }, + {subject_2 => "airplanes"}, "cql - filter term field 2" ); is_deeply( $parser->parse(qq(subject_3 = "airplanes")), - { subject_3 => "AIRPLANES" }, + {subject_3 => "AIRPLANES"}, "cql - cb term field 1" ); is_deeply( $parser->parse(qq(subject_4 = "airplanes")), - { subject_4 => "AIRPLANES" }, + {subject_4 => "AIRPLANES"}, "cql - cb term field 2" ); diff -Nru libcatmandu-store-mongodb-perl-0.0700/t/lib/MongoDBTest.pm libcatmandu-store-mongodb-perl-0.0802/t/lib/MongoDBTest.pm --- libcatmandu-store-mongodb-perl-0.0700/t/lib/MongoDBTest.pm 2017-03-23 13:38:25.000000000 +0000 +++ libcatmandu-store-mongodb-perl-0.0802/t/lib/MongoDBTest.pm 2019-02-08 15:16:45.000000000 +0000 @@ -27,45 +27,51 @@ our $conn; # set up connection if we can -BEGIN { +BEGIN { eval { my $host = exists $ENV{MONGOD} ? $ENV{MONGOD} : 'localhost'; - $conn = MongoDB->connect($host, { - ssl => $ENV{MONGO_SSL}, - socket_timeout_ms => 60000, - server_selection_timeout_ms => 2000, - }); + $conn = MongoDB->connect( + $host, + { + ssl => $ENV{MONGO_SSL}, + socket_timeout_ms => 60000, + server_selection_timeout_ms => 2000, + } + ); my $topo = $conn->_topology; $topo->scan_all_servers; my $link; - eval { $link = $topo->get_writable_link } - or die "couldn't connect"; - $conn->get_database("admin")->run_command({ serverStatus => 1 }) - or die "Database has auth enabled\n"; + eval {$link = $topo->get_writable_link} or die "couldn't connect"; + $conn->get_database("admin")->run_command({serverStatus => 1}) + or die "Database has auth enabled\n"; my $server = $link->server; - if ( !$ENV{MONGOD} && $topo->type eq 'Single' && $server->type =~ /^RS/ ) { + if ( !$ENV{MONGOD} + && $topo->type eq 'Single' + && $server->type =~ /^RS/) + { # direct connection to RS member on default, so add set name # via MONGOD environment variable for subsequent use - $ENV{MONGOD} = "mongodb://localhost/?replicaSet=".$server->set_name; + $ENV{MONGOD} + = "mongodb://localhost/?replicaSet=" . $server->set_name; } }; if ($@) { (my $err = $@) =~ s/\n//g; - if ( $err =~ /couldn't connect|connection refused/i ) { - $err = "no mongod on " . ( $ENV{MONGOD} || "localhost:27017" ); + if ($err =~ /couldn't connect|connection refused/i) { + $err = "no mongod on " . ($ENV{MONGOD} || "localhost:27017"); $err .= ' and $ENV{MONGOD} not set' unless $ENV{MONGOD}; } plan skip_all => "$err"; exit 0; } -}; +} # clean up any detritus from failed tests -END { +END { return unless $conn; $conn->get_database('test_database')->drop; -}; +} 1;