KiokuDB-0.56000755001750000144 012237006576 12057 5ustar00doyusers000000000000TODO100644001750000144 2671012237006576 12656 0ustar00doyusers000000000000KiokuDB-0.56=== Small === * move live object leak reporting from Catalyst::Model into mainline * scope directory handles KiokuDB::API * scoped_txn method (txn_do( scope => 1, body => ... ) * test for data migration * two directories, make sure whole graphs and subgraphs can be moved between * especially KiokuDB::Set and other directory aware objects * Attribute traits * KiokuDB::ID (kiokudb_object_id like, but not stored in 'data') * KiokuDB::Backend/KiokuDB::Directory (for directory aware objects) * Doc work * Doc audit * make a doc todo list * especially for backend authors and KiokuDB::Role::* * More command line tool docs * backup, recovery, etc * FAQ and index * where to find information, for instance to do proper backup * procedures for the BDB backend you need to read BerkeleyDB::Manager * Start writing a cookbook * more roles for KiokuX::User * non ID based * allow username to != object ID, so that users can be renamed * email address handling * role based access control * "real" runtime roles, or a list of RBAC role names * integrate with Catalyst::Plugin::Authorization::Roles * high level password change/reset role using auth token objects * inserts an object pointing to the user, that can reset the password for the user * the ID of the token is secret, and can be emailed to the user * an action that then loads the object, resets the password, and then deletes the auth token object * symbolic aliases * KiokuDB::Entry::Alias or somesuch * used to set additional high level IDs for objects, after they are already in the database * Linker api to handle these on load * on insert they are just special objects * simple api in KiokuDB.pm to manage aliases (create, delete, etc). * configuration file support * need to be able to specify: * regular options * typemaps * extra libs to load * shouldn't be hard with MooseX::YAML * KiokuDB->connect("/path/to/my_db.yml"); * KiokuDB->connect("/path/to/dir"); # reads /path/to/dir/kiokudb.yml * subdirectories for standard directory layout: * data/ - actual storage * lib/ - possibly used for typemap defs, etc * RPC backend * simple proxying of backend methods and a KiokuDB::Backend::Remote client * try for a nonblocking api, be able to plug in to a standalone blocking daemon, a larger setup, or into anyevent/POE without horrible performance * we'll need a preforking daemon for the backend performance (Concurrency::POSIX can make this automatic), but ideally we can have a nonblocking api role for most backends (see event based api below) * see also RPC server below * Cache::Bounded for immutable objects * simple hack to keep them live longer than normal * simple profiling hooks * under some debug mode collect timing info for linker & collapser * display this info in Catalyst::Model::KiokuDB's debug output === Medium === * root set membership delegated to typemap * will allow Root and NonRoot roles in MOP typemap entry * top level values for ->store and ->insert still set default * ->set_root always authoritative * Schema versioning * store version in entries * add an upgrade hook to typemap entries * if $Class::VERSION ne $entry->class_version then the upgrade hook is fired * the upgrade hook is responsible for creating a new entry * convenience api: * hash of callbacks: { $version => $per_version_hook $version => $aliased_to_version, # treat objects # with version $version like they are objects # of version $aliased_to_version }, * if a version is missing that is an error * add a schema upgrade command line tool * scans the DB for entries with versions that != current, and loads and then updates those objects * $dir->refresh($object), $dir->deep_refresh($object) * partially done * allow typemaps to disable or completely take over refreshing (i.e. DBIC) * provide a check that compares, if entry data != live entry data, skip * add deep refresh * entry todos: * MOP entry needs a MOP API to clear objects, not yet in CMOP * Set * if shallow downgrade to Deferred and reload IDs assign new member IDs if shallow, downgrade to Deferred * if deep upgrade to Loaded and refresh members * KiokuDB::Server * server side scope tracking * the client informs does scope open/close * the server automatically follows all references for the client, to reduce latency * (no need to actually inflate) * server side filtering * server side transactions * fix the set_root work on immutable/CAS objects bug (the 'root' flag is not written because the object is skipped) * caching support * authoritative cache support * entry caching for slower backends * non authoritative cache * various degrees of correctness (simpledb like "gurantees" ;-) * data sharding * map classes of UIDs to different backends or different tables in a backend * string based i guess, though we could also decorate the entry object with metadata about where it should go in addition * uses: * transient data storage (e.g. web sessions) * grouping of data for scanning purposes * grouping of data for configuration purposes (e.g. different search columns in DBI, content id objects in CAS storage) * actual backend work is more involved but doing the high level is pretty easy * XS acceleration * LiveObjects * implement custom uvar magic hash instead of Scope::Guard all over * should provide significant speed & memory consumption improvements * Linker * inflate_data is actually really ugly in Perl, could be smaller/faster/cleaner in XS due to lack of of code duplication * Data::Visitor * generic acceleration for Data::Visitor, ask nothingmuch for details * affects: * Collapser * $entry->references * jspon? not anymore but could convert back * Set::Object and hash key sharding * each hash entry or set member is an entry/row in a table (BDB and DBI) hash). * This allows finer grained commits (e.g. insertion to a set from two competing transactions does not cause a failed transaction) under MULTIVERSION for BDB. * this also allows to run queries that test for set membership (but we still can't write those queries) * sharding thsould be implemented as a base role that backends can implement * CodeRefs serialization * if the subname of the CV is valid and it has a ->FILE then maybe store as a symbolic ref instead (requiring the file to load it)? * Attribute meta traits * each of these is relatively small and self contained * lazy build attributes (for cached values) * build on store * keep when storing but dont build on store * make sure update() on immutable objects works for this, too * do not serialize * ID attribute * don't store ID twice, once as a field and once in the entry (skip the field) * better than KiokuDB::Role::ID * Digest Part * resistent to subclassing/role composition * however, order must be stable, sort get_all_attributes * order by sort index is provided * rest of attributes sorted: * required attributes before non required ones * sub sort by name * required attributes first, ordered by sort index or name if no sort index is provided * Build on store meta trait === Large === * RDF backend * generate triples * predicates as FQ attr names names * predicates as short attr names * predicates as UUIDs? * disable simple ref collapsing by default? * SPARQL matching for simple search * event based api * linker is almost ready to integrate event based linking * if backend returns a cond var for get() then we can return a cond var for the whole graph. start with an api for it, and slowly implement actual async behavior using a backend role * AnyEvent::BDB, Files and CouchDB backends could benefit * skeptical about performance of DBI with forking * does the live object scope still make sense? probably, but it's much easier to leak it. the event oriented wrapper should keep live object scopes for the user at least for the duration of a callback, in additional to the user tracking to minimize confusion. $lookup->recv could return the scope into which the objects were loaded, along with the results * threading * what happens with a shared KiokuDB directory? i don't think that's a good idea... better that each thread has its own copy? how can we guarantee recursive thread sharing of passthrough/callback objects? * investigate by writing tests and then fixing as appropriate * persistent metaclass * store Moose class definition in code by creating metaclasses which when loaded redefine the class in memory * might need to subclass Moose::Meta::Class to take care of stored code * this allows us to create a smalltalk inspired environment * Garbage collection * Online garbage collection schemes * entries can already enumerate their out links * several possibilities: * refcounting * on store diff $entry->references with $entry->prev->references and update counts * rel index table is another * all references are cross referenced in a table that can be also used to list backrefs. In SQL this table can have delete triggers i guess (ask mugwump), in BDB this would be manual. * incremental scheme * parrot's tricolor garbage collection alrogithm is interesting * the data could be partly maintained during store/delete operations, with a partial sweep performed every time some statistic is tipped * generational GC could make sense here, due to the persistence of the data * Offline schemes * currently we do a full sweep in a single transaction * this is potentially like a global lock, except with the possibility of deadlocking, it would be nice to have an incremental scheme with small transactions * mark & sweep * tri-color using some auxillary table * smaller transactions to update the aux table * online updating of the aux table interleaved * final txn reads the aux table, and deletes in a single txn * allows the sweep to be performed incrementally without locking everything * collection of clusters of data: http://www-sor.inria.fr/publi/GC-PERS-DSM_POS94.html * http://pauillac.inria.fr/~lefessan/dgc/ * http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.32.663 * transactional ref counting: http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.33.2363 === Misc === this is just a link dump really http://www.ietf.org/rfc/rfc1960.txt Changes100644001750000144 3400512237006576 13455 0ustar00doyusers000000000000KiokuDB-0.56Revision history for KiokuDB 0.56 2013-11-07 - stop importing from multiple JSON versions 0.55 2013-11-05 - fix failing tests with newer versions of JSON - convert to dzil 0.54 2013-06-25 - packaging issues 0.53 2013-06-25 - Fix some test issues 0.52 2011-06-27 - Fix an issue where streaming entries can sometimes cause them to disappear. - Fix overlap with the new 'union' keyword in Moose::Util::TypeConstraints. 0.51 2011-03-31 - Die with an error when two objects try and register with the same ID but don't both do the KiokuDB::Role::ID::Content role. 0.50 2010-10-19 - Use new instance api in Moose to allow native traits to inline properly when used with KiokuDB::Class (doy) 0.49 2010-09-09 - Merge NUFFIN/0.48 and FLORA/0.48 0.48 2010-08-24 - (FLORA release) - Avoid warnings from Moose 1.10 0.48 2010-07-31 - (NUFFIN release) - Reupload with proper MANIFEST 0.47 2010-07-29 - Avoid warnings from Moose 1.09 (Dave Rolsky) - Numerous documentation fixes (David Leadbeater) - Move the Japanese translation of the tutorial under POD2::JA to allow perldoc -L ja KiokuDB::Tutorial - Don't allow the live object cache to grow too big 0.46 2010-06-27 - s/_03/ on the version 0.46_03 2010-06-27 - Internals change cleanups regarding weakening $entry->{data} with passthrough objects - fiddle leak tracking code around to avoid keeping temporary refs around, which makes Devel::FindRef more useful in the user's leak tracker 0.46_02 2010-06-27 - Support for caching of live objects (i.e. immutable ones) - Fix the =head1 NAME of Tutorial::JA - Move t/set.t into a standalone test fixture 0.46_01 2010-06-20 - Lots of refactoring to LiveObjects - metadata is keyed by ID, not object - keep_entries attribute allows entries to be discarded once used (defaults to true for compatibility, may change in the future) - clear_leaks/leak_tracker attributes - remove txn_{begin,commit,rollback} methods, as they require maintaining a stack to be properly used (#58166) - KiokuDB::Cmd no longer tries to rerun itself after autoinstall, this is very flakey when the installation is the result of an upgrade instead of a fresh install 0.45 2010-06-05 - Introduce KiokuDB::Backend::Role::GC which allows backends to construct their own garbage collector for the GC command. - name mangle inline classes in tests to avoid false failure reports (e.g. when a Foo.pm is in @INC) - add scoped_txn, txn_begin, txn_commit, txn_rollback 0.44 2010-06-02 - Remove accidental use of namespace::autoclean instead of namespace::clean (doy) - Proper fix for class_version this time =( 0.43 2010-05-26 - Now throws proper error objects instead of unintelligiable hash refs - Fix JSON serialization (omitted keys necessary for version tracking and GIN indexing) - Add a 'clone' method to KiokuDB::Set - Suppress additional recursion and repeated weaken() warnings - Try harder to skip DateTime formatter serialization roundtripping on JSON based backends 0.42 2010-04-16 - Update translation of tutorial (ktat) - use RegexpRef type constraint instead of Regexp (Regexp look blessed but not in C land) (doy) - Force stringification of version objects before serialization - 'mongodb' DSN moniker (omega) - Typemap support for the REF reftype (just an alias for SCALAR) - misc doc fixes 0.41 2010-03-21 - Re-release without extra crap in the tarball. 0.40 2010-03-21 - Allow using a JSON string as a DSN, e.g. '{"dsn":"dbi:SQLite:foo","schema":"MyApp::DB"}' - Added DateTime::Duration to the default typemap 0.39 2010-03-17 - Allow a backend to provide a default typemap in addition to the serializer one - call 'register_handle' on duck-typing backends in KiokuDB::BUILD - plug a leak where the live object set kept an indirect reference to passthrough entries 0.38 2010-03-06 - Fix a bug where object streams would end prematurely (Graham Barr) 0.37 2010-03-03 - Resolve long standing issues with TXN::Memory - TXN::Memory::Scan role now implements proper enumeration - Fixture::TXN::Scan verifies transactional semantics of enumeration for all transactional backends - Re-enable $linker->queue (fixed coderef failure case) - Various doc fixes - Class versioning (disabled by default) 0.36 2010-02-20 - Resolve a bug when deleting objects that are still live, lookup($dead_object_id) would still return the object even though it's not actually in storage. - Don't call $backend->exists with no arguments in FSCK - various API methods now just return; when invoked with no arguments, instead of potentially erroring at the backend level 0.35 2010-02-05 - bump dependency version for MooseX::YAML to prevent bad interaction with MooseX::Blessed::Reconstruct - add insert_nonroot and store_nonroot methods 0.34 2009-10-24 - fix an incorrect conversion to Try::Tiny (Dylan) - remove ciruclar role definition that causes does_role to inf loop - laxen the exception matching regex for missing .pm files in @INC to address CPAN testers reports with a different formatting for that error 0.33 2009-09-23 - Added Japanese tutorial KiokuDB::Tutorial::JA (ktat) - Correct indexing tutorial example (ask) - Use done_testing() instead of no_plan (dandv) - Fix behavior of KiokuDB::Lazy attributes with a trigger (a Moose change caused infinite recursion) - add a refresh method (no deep_refresh yet) 0.32 2009-07-30 - Don't assume all metaclasses have the does_role method - Various documentation fixes - Add no warnings 'recursion' to KiokuDB::Linker 0.31 2009-07-06 - Remove MooseX::Getopt usage from verbosity role - Don't depend on KiokuDB::Cmd in makefile, just warn (avoids recursive dependency) 0.30 2009-07-05 - Split KiokuDB::Cmd into a separate distribution 0.29 2009-06-27 - work around Test::Exception leak relating to closures in 5.8 - fix various new warnings with Moose 0.28 2009-06-26 - YAML serializer no longer stores extra data - MooseX::Clone is available for entry/reference - TypeMap::Entry::Std role was split up to smaller roles - TXN::Memory implements get() properly now (but not iterations yet) - ->connect("/path/to/config.yml") is now supported - propagate errors when loading classes in the linker - core reftypes (ARRAY, HASH etc) are handled by the typemap - SCALAR refs can be stored in JSON by using a custom typemap - Support for serializing closures 0.27 2009-04-20 - Add roles for digest based IDs - Change dep versions of IO and Tie::RefHash::Weak (they were wrong under 5.8) (Thanks to Otto Hirr) - KiokuDB::Lazy did not have any effect unless the value was a first class objects. Now it works for all refs (e.g. arrays of objects) - TODO list updated - correct dry_run option in WithDSN when transactions are unsupported 0.26 2009-04-08 - avoid using deprecated Moose/Class::MOP features - bump deps on Moose and Class::MOP 0.25 2009-03-27 - attempt to reduce memory usage by using a custom destruction guard - only run concurrency stress test if env var is set - various doc fixes 0.24 2009-02-28 - various doc fixes (Dan Dascalescu) - fix semantics when a Set::Deferred outlives the scope in which it was created and then gets vivified - add a test for MooseX::Traits - doc improvements - concurrency stress test - txn_do takes a 'scope' arg (calls new_scope automatically) - various doc fixes - add KiokuDB::Role::API 0.23 2009-01-25 - Add KiokuDB::DoNotSerialize trait (MooseX::Storage trait is still respected) - add Collapser::Buffer, which replaces the various temp attrs. Changes from the buffer are only written to live objects after a successful write to the backend. This also fixes duplicate ID::Content objects being inserted when one is already live. - Various doc improvements 0.22 2009-01-17 - Add TXN::Memory role to provide memory bufferred transactions to backends only supporting atomicity guarantees (e.g. CouchDB) - Documentation improvements - Allow skipping of test suite fixtures on broken backends - Various minor fixes and improvements 0.21 2009-01-14 - Readded the dependency on JSON in addition to JSON::XS 0.20 2009-01-13 - Refactored KiokuDB::TypeMap::Composite out of KiokuDB::TypeMap::Default - Added KiokuDB::TypeMap::Entry::StorableHook, which allows reusing of existing STORABLE_freeze hooks - Fixed handling of 'root' flag (was not being properly preserved) - Added 'is_root', 'set_root', 'unset_root' - Added a 'deep_update' method - Now depends on YAML::XS and JSON::XS (not optional deps anymore) - Various improvements to command line roles - Added a new GC command and a naive mark & sweep collector - Added a new Edit command using Proc::InvokeEditor to do a dump and a load in a single transaction - Added KiokuDB::Role::Intrinsic for objects which want to be collapsed intrinsically - Added KiokuDB::Role::Immutable for objects which never change after being inserted - Added KiokUDB::Role::ID::Content for content addressible objects - Test suite cleanups - Added ID enumeration to Scan role - Added 'allow_classes', 'allow_bases' and 'allow_class_builders' options to KiokuDB allowing for easy typemap creation. 0.19 2009-01-05 - Introduce KiokuDB::Stream::Objects, a Data::Stream::Bulk for objects that automatically creates a new scope for each block. This makes it much harder to leak when iterating through C. 0.18 2009-01-04 - Fix KiokUDB->connect("foo", @args) when the dsn string has no parameters (@args were being ignored) - Add a fixture to test that overwriting an entry is not allowed. 0.17 2008-12-30 - More docs - remove KiokuDB::Backend::Null which was historically used for testing but is long since useless. - remove deprecated command line tools - provide a 'txn_do' method in Role::TXN for backends which only implement txn_begin, txn_rollback and txn_commit - correct plan for t/uuid.t when a module is missing 0.16 2008-12-28 - Lots of docs - Fix KiokuDB::Reference's Storable hook limitation using a simple workaround. Not a real fix yet. - Remove unnecessary code from the UUID generation roles. - In KiokuDB::Cmd::OutputHandle, don't clobber the file before the command has actually run (remove EarlyBuild attr) 0.15 2008-12-28 - Last version was accidentally released off a problematic branch, rereleasing without that change 0.14 2008-12-28 - skip incremental JSON parsing tests if JSON::XS is missing - load IO::Handle to attempt to work around some weird test failures 0.13 2008-12-25 - t/serializer.t was causing bogus failures by not skipping if YAML::XS is unavailable - Cleanup of ( is => 'rw' ) bits in KiokuDB::Entry that should have really had private writers instead - Introduce partial handling of anonymous classes created due to runtime application of roles ( My::Role->meta->apply($instance) ) 0.12 2008-12-24 - Remove a use Devel::PartialDump that accidentally got committed 0.11 2008-12-24 - Fetching now queues items so that the backend's get() method is called fewer times, with more IDs each time. This significantly increases the performance of high latency backends, such as DBI or CouchDB. - fill in SimpleSearch stub fixture - Various fixes for Binary fixture - Make the various fields of the JSPON format customizable - Serialization is now pluggable using the Delegate serialization role 0.10 2008-12-22 - Load classes in the typemap resolution code, so that objects whose classes aren't necessarily loaded at compile time can still be inflated. - add 'import_yaml' to KiokuDB::Util - Refactor parts of the JSPON file backend into a JSON serialization role - Don't load thunks when updating partially loaded objects - No longer dies if txn_do is used but the backend doesn't supports it (implicit noop) - Add a new role and test for nested transaction supporting backends (partial rollback) 0.09 2008-12-17 - Remove KiokuDB::Resolver, moving ID assignment functionality into the collapser and the typemap - Fix bogus failures on 5.8 due to weird leaks (perl bug affecting test suite) 0.08 2008-12-05 - Fix a breakage in inflating passthrough intrinsic objects created with older versions of KiokuDB - Refactor command line tools to use App::Cmd - Add KiokuDB::LinkChecker and a FSCK command 0.07 2008-10-31 - Rename backend roles to KiokuDB::Backend::Role::Foo (omega) - Change entry packing format in Storable to something less idiotic 0.06 2008-10-31 - Use epoch, not ISO 8601 dates in JSPON map by default to avoid issues with DateTime::Format::ISO8601 dependency in testing. Will support both in the future - Fix tied support for JSPON 0.05 2008-10-31 - Add default typemaps for JSON and Storable serialization 0.04 2008-10-30 - Fix ->clear in KiokuDB::GIN 0.03 2008-10-28 - Lots of new docs - Smaller set of dependencies - Many deps are now optional (skips tests) - Some dependencies weren't necessary - Hand written code instead of MooseX::AttributeHelpers in live objects - Fixed an random test failure in live_objects.t that accidentally depended on address space ordering 0.02 2008-10-25 - Lazy meta trait for attributes - DoNotSerialize meta trait is now respected - Documentation updates - Removes several unrelated files form the dist - NoGetopt related fixes for command line tools - Remove JSPON backend files - Dependency fixes - KiokuDB::Role::ID 0.01 2008-10-16 - Initial Release t000755001750000144 012237006576 12243 5ustar00doyusers000000000000KiokuDB-0.56gin.t100644001750000144 157512237006576 13355 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use KiokuDB::Test; use Scalar::Util qw(refaddr); use KiokuDB::GIN; use KiokuDB; use KiokuDB::Backend::Hash; use KiokuDB::Test::Fixture::Small; use Search::GIN::Query::Class; use Search::GIN::Extract::Class; { package KiokuDB_Test_MyGIN; use Moose; extends qw(KiokuDB::Backend::Hash); with ( 'KiokuDB::GIN', 'Search::GIN::Driver::Hash' => { -excludes => 'clear' }, 'Search::GIN::Extract::Delegate', ); sub clear { my $self = shift; # UGH $self->Search::GIN::Driver::Hash::clear(@_); $self->SUPER::clear(@_); } __PACKAGE__->meta->make_immutable; } my $gin = KiokuDB_Test_MyGIN->new( extract => Search::GIN::Extract::Class->new, root_only => 0, ); my $dir = KiokuDB->new( backend => $gin, ); run_all_fixtures($dir); done_testing; ref.t100644001750000144 142112237006576 13342 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Storable qw(nfreeze thaw); use KiokuDB::Reference; foreach my $id ( "foo", 123, "la-la", "3B19C598-E873-4C65-80BA-0D1C4E961DC9", "9170dc3d7a22403e11ff4c8aa1cd14d20c0ebf65", pack("H*", "9170dc3d7a22403e11ff4c8aa1cd14d20c0ebf65"), "foo,bar", ) { foreach my $weak ( 1, 0, '', undef ) { my $ref = KiokuDB::Reference->new( id => $id, defined($weak) ? ( weak => $weak ) : (), ); is( $ref->id, $id, "ID in constructor" ); my $f = nfreeze($ref); isa_ok( my $copy = thaw($f), "KiokuDB::Reference", "thaw" ); is( $copy->id, $id, "ID after thaw" ); is_deeply( $copy, $ref, "eq deeply" ); } } done_testing; LICENSE100644001750000144 4375512237006576 13203 0ustar00doyusers000000000000KiokuDB-0.56This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Suite 500, Boston, MA 02110-1335 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy 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 1, 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, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End dist.ini100644001750000144 271512237006576 13611 0ustar00doyusers000000000000KiokuDB-0.56name = KiokuDB author = Yuval Kogman license = Perl_5 copyright_holder = Yuval Kogman, Infinity Interactive [FileFinder::Filter / WeaverFiles] finder = :InstallModules finder = :ExecFiles skip = \.pod$ [@Filter] -bundle = @DOY -remove = Readme -remove = PodCoverageTests :version = 0.14 dist = KiokuDB repository = github github_user = kiokudb authority = cpan:NUFFIN homepage = http://www.iinteractive.com/kiokudb/ Test::Compile_skip = ^KiokuDB::Role::UUIDs::LibUUID$ PodWeaver_finder = WeaverFiles Git::Tag_tag_format = %N-%v Git::NextVersion_version_regexp = -(.+)$ [AutoPrereqs] skip = ^Authen::Passphrase::SaltedDigest$ skip = ^Class::Accessor$ skip = ^Data::UUID::LibUUID$ skip = ^DateTime skip = ^KiokuDB::Cmd$ skip = ^KiokuDB_Test skip = ^MooseX::Object::Pluggable$ skip = ^MooseX::Storage::Meta::Attribute::Trait::DoNotSerialize$ skip = ^MooseX::Traits$ skip = ^Object::InsideOut$ skip = ^Object::Tiny$ skip = ^Tie::IxHash$ skip = ^URI$ skip = ^URI::WithBase$ [Prereqs / DevelopRequires] Authen::Passphrase = 0 Class::Accessor = 0 Data::UUID::LibUUID = 0.05 DateTime = 0 DateTime::Format::Strptime = 0 MooseX::Object::Pluggable = 0 MooseX::Storage = 0 MooseX::Traits = 0 Object::InsideOut = 0 Object::Tiny = 0 Tie::IxHash = 0 URI = 0 [PerlVersionPrereqs / 5.010] Tie::RefHash::Weak = 0.09 Variable::Magic = 0.24 lazy.t100644001750000144 601712237006576 13553 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Test::Exception; use KiokuDB; use KiokuDB::Backend::Hash; { package KiokuDB_Test_Simple; use KiokuDB::Class; has name => ( is => "rw" ); has foo => ( traits => [qw(KiokuDB::Lazy)], isa => __PACKAGE__, is => "ro", ); has foos => ( traits => [qw(KiokuDB::Lazy)], isa => 'ArrayRef', is => "ro", ); } ok( exists($INC{"KiokuDB/Meta/Attribute/Lazy.pm"}), "KiokuDB::Meta::Attribute::Lazy loaded" ); does_ok( KiokuDB_Test_Simple->meta->get_attribute("foo"), 'KiokuDB::Meta::Attribute::Lazy', '"foo" meta attr does KiokuDB::Meta::Attribute::Lazy' ); does_ok( KiokuDB_Test_Simple->meta->get_attribute("foos"), 'KiokuDB::Meta::Attribute::Lazy', '"foo" meta attr does KiokuDB::Meta::Attribute::Lazy' ); my $dir = KiokuDB->new( backend => KiokuDB::Backend::Hash->new ); { my $s = $dir->new_scope; my ( $foo, @baz ) = map { KiokuDB_Test_Simple->new } 1 .. 3; my $bar = KiokuDB_Test_Simple->new( foo => $foo, foos => \@baz); is( $bar->foo, $foo, "foo attribute" ); $dir->store( foo => $foo, bar => $bar ); } { my $s = $dir->new_scope; is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects", ); my $bar = $dir->lookup("bar"); is_deeply( [ $dir->live_objects->live_objects ], [ $bar ], "only bar is live", ); my $foos = $bar->foos; is_deeply( [ sort $dir->live_objects->live_objects ], [ sort @$foos, $bar ], "all objects are live", ); } { my $s = $dir->new_scope; is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects", ); my $bar = $dir->lookup("bar"); is_deeply( [ $dir->live_objects->live_objects ], [ $bar ], "only bar is live", ); my $foo = $bar->foo; is_deeply( [ sort $dir->live_objects->live_objects ], [ sort $foo, $bar ], "both objects are live", ); } { my $s = $dir->new_scope; is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects", ); my $bar = $dir->lookup("bar"); is_deeply( [ $dir->live_objects->live_objects ], [ $bar ], "only bar is live", ); $bar->name("moose"); $dir->update($bar); is_deeply( [ $dir->live_objects->live_objects ], [ $bar ], "only bar is live", ); } { my $s = $dir->new_scope; is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects", ); my $bar = $dir->lookup("bar"); is( $bar->name, "moose", "name updated" ); is_deeply( [ $dir->live_objects->live_objects ], [ $bar ], "only bar is live", ); my $foo = $bar->foo; is_deeply( [ sort $dir->live_objects->live_objects ], [ sort $foo, $bar ], "both objects are live", ); } done_testing; uuid.t100644001750000144 112012237006576 13530 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; sub check_role ($) { my $role = shift; eval "require $role" || die $@; can_ok( $role, 'generate_uuid' ); ok( my $id = eval { $role->generate_uuid }, "$role generates UUIDs" ); } check_role 'KiokuDB::Role::UUIDs::SerialIDs'; SKIP: { skip $@ => 3, unless eval { require Data::UUID }; check_role 'KiokuDB::Role::UUIDs::DataUUID'; } SKIP: { skip $@ => 3, unless eval { require Data::UUID::LibUUID }; check_role 'KiokuDB::Role::UUIDs::LibUUID'; } check_role 'KiokuDB::Role::UUIDs'; done_testing; hash.t100644001750000144 151712237006576 13517 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use Test::More; use KiokuDB; use KiokuDB::Backend::Hash; use Cache::Ref::CLOCK; use KiokuDB::Test; foreach my $format ( qw(memory storable json), eval { require YAML::XS; "yaml" } ) { foreach my $keep_entries ( 1, 0 ) { foreach my $queue ( 1, 0 ) { foreach my $cache ( Cache::Ref::CLOCK->new( size => 100 ), undef ) { run_all_fixtures( KiokuDB->connect( "hash", serializer => $format, linker_queue => $queue, live_objects => { keep_entries => $keep_entries, ( $cache ? ( cache => $cache ) : () ), }, ), ); } } } } done_testing; tied.t100644001750000144 444712237006576 13526 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Scalar::Util qw(refaddr reftype blessed); use Storable qw(dclone); use KiokuDB::TypeMap::Entry::Callback; use KiokuDB::TypeMap::Entry::Ref; use KiokuDB::TypeMap::Resolver; use KiokuDB::Collapser; use KiokuDB::Linker; use KiokuDB::LiveObjects; use KiokuDB::Backend::Hash; use Tie::RefHash; { package KiokuDB_Test_Foo; use Moose; has bar => ( is => "rw" ); package KiokuDB_Test_Bar; use Moose; has blah => ( is => "rw" ); } tie my %h, 'Tie::RefHash'; $h{KiokuDB_Test_Bar->new( blah => "two" )} = "bar"; my $obj = KiokuDB_Test_Foo->new( bar => \%h, ); for my $i ( 0, 1 ) { my $tr = KiokuDB::TypeMap::Resolver->new( typemap => KiokuDB::TypeMap->new( entries => { 'Tie::RefHash' => KiokuDB::TypeMap::Entry::Callback->new( intrinsic => $i, collapse => "STORABLE_freeze", expand => sub { my ( $class, @args ) = @_; my $self = (bless [], $class); $self->STORABLE_thaw(0, @args); return $self; }, ), ARRAY => KiokuDB::TypeMap::Entry::Ref->new, HASH => KiokuDB::TypeMap::Entry::Ref->new, }, ), ); my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => KiokuDB::LiveObjects->new, typemap_resolver => $tr, ); my $l = KiokuDB::Linker->new( backend => KiokuDB::Backend::Hash->new, live_objects => KiokuDB::LiveObjects->new, typemap_resolver => $tr, ); my $sv = $v->live_objects->new_scope; my $sl = $l->live_objects->new_scope; my ( $buffer, @ids ) = $v->collapse( objects => [ $obj ] ); my $entries = $buffer->_entries; is( scalar(@ids), 1, "one root set ID" ); my $copy = dclone($entries); $l->live_objects->register_entry( $_->id => $_ ) for values %$entries; my $loaded = $l->expand_object($copy->{$ids[0]}); isa_ok( $loaded, "KiokuDB_Test_Foo" ); is( ref(my $h = $loaded->bar), "HASH", "KiokuDB_Test_Foo->bar is a hash" ); isa_ok( tied(%$h), "Tie::RefHash", "tied to Tie::RefHash" ); } done_testing; META.yml100644001750000144 5436712237006576 13450 0ustar00doyusers000000000000KiokuDB-0.56--- abstract: 'Object Graph storage engine' author: - 'Yuval Kogman ' build_requires: Cache::Ref::CART: 0 Cache::Ref::CLOCK: 0 Data::Dumper: 0 Data::Stream::Bulk::Callback: 0 File::Spec: 0 IO::Handle: 0 IPC::Open3: 0 Search::GIN::Driver::Hash: 0 Search::GIN::Extract::Class: 0 Search::GIN::Extract::Delegate: 0 Test::More: 0.88 base: 0 if: 0 configure_requires: ExtUtils::MakeMaker: 6.30 dynamic_config: 1 generated_by: 'Dist::Zilla version 5.006, CPAN::Meta::Converter version 2.132830' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: KiokuDB provides: KiokuDB: file: lib/KiokuDB.pm version: 0.56 KiokuDB::Backend: file: lib/KiokuDB/Backend.pm version: 0.56 KiokuDB::Backend::Hash: file: lib/KiokuDB/Backend/Hash.pm version: 0.56 KiokuDB::Backend::Role::BinarySafe: file: lib/KiokuDB/Backend/Role/BinarySafe.pm version: 0.56 KiokuDB::Backend::Role::Broken: file: lib/KiokuDB/Backend/Role/Broken.pm version: 0.56 KiokuDB::Backend::Role::Clear: file: lib/KiokuDB/Backend/Role/Clear.pm version: 0.56 KiokuDB::Backend::Role::Concurrency::POSIX: file: lib/KiokuDB/Backend/Role/Concurrency/POSIX.pm version: 0.56 KiokuDB::Backend::Role::GC: file: lib/KiokuDB/Backend/Role/GC.pm version: 0.56 KiokuDB::Backend::Role::Prefetch: file: lib/KiokuDB/Backend/Role/Prefetch.pm version: 0.56 KiokuDB::Backend::Role::Query: file: lib/KiokuDB/Backend/Role/Query.pm version: 0.56 KiokuDB::Backend::Role::Query::GIN: file: lib/KiokuDB/Backend/Role/Query/GIN.pm version: 0.56 KiokuDB::Backend::Role::Query::Simple: file: lib/KiokuDB/Backend/Role/Query/Simple.pm version: 0.56 KiokuDB::Backend::Role::Query::Simple::Linear: file: lib/KiokuDB/Backend/Role/Query/Simple/Linear.pm version: 0.56 KiokuDB::Backend::Role::Scan: file: lib/KiokuDB/Backend/Role/Scan.pm version: 0.56 KiokuDB::Backend::Role::TXN: file: lib/KiokuDB/Backend/Role/TXN.pm version: 0.56 KiokuDB::Backend::Role::TXN::Memory: file: lib/KiokuDB/Backend/Role/TXN/Memory.pm version: 0.56 KiokuDB::Backend::Role::TXN::Memory::Scan: file: lib/KiokuDB/Backend/Role/TXN/Memory/Scan.pm version: 0.56 KiokuDB::Backend::Role::TXN::Nested: file: lib/KiokuDB/Backend/Role/TXN/Nested.pm version: 0.56 KiokuDB::Backend::Role::UnicodeSafe: file: lib/KiokuDB/Backend/Role/UnicodeSafe.pm version: 0.56 KiokuDB::Backend::Serialize: file: lib/KiokuDB/Backend/Serialize.pm version: 0.56 KiokuDB::Backend::Serialize::Delegate: file: lib/KiokuDB/Backend/Serialize/Delegate.pm version: 0.56 KiokuDB::Backend::Serialize::JSON: file: lib/KiokuDB/Backend/Serialize/JSON.pm version: 0.56 KiokuDB::Backend::Serialize::JSPON: file: lib/KiokuDB/Backend/Serialize/JSPON.pm version: 0.56 KiokuDB::Backend::Serialize::JSPON::Collapser: file: lib/KiokuDB/Backend/Serialize/JSPON/Collapser.pm version: 0.56 KiokuDB::Backend::Serialize::JSPON::Converter: file: lib/KiokuDB/Backend/Serialize/JSPON/Converter.pm version: 0.56 KiokuDB::Backend::Serialize::JSPON::Expander: file: lib/KiokuDB/Backend/Serialize/JSPON/Expander.pm version: 0.56 KiokuDB::Backend::Serialize::Memory: file: lib/KiokuDB/Backend/Serialize/Memory.pm version: 0.56 KiokuDB::Backend::Serialize::Null: file: lib/KiokuDB/Backend/Serialize/Null.pm version: 0.56 KiokuDB::Backend::Serialize::Storable: file: lib/KiokuDB/Backend/Serialize/Storable.pm version: 0.56 KiokuDB::Backend::Serialize::YAML: file: lib/KiokuDB/Backend/Serialize/YAML.pm version: 0.56 KiokuDB::Backend::TypeMap::Default: file: lib/KiokuDB/Backend/TypeMap/Default.pm version: 0.56 KiokuDB::Backend::TypeMap::Default::JSON: file: lib/KiokuDB/Backend/TypeMap/Default/JSON.pm version: 0.56 KiokuDB::Backend::TypeMap::Default::Storable: file: lib/KiokuDB/Backend/TypeMap/Default/Storable.pm version: 0.56 KiokuDB::Class: file: lib/KiokuDB/Class.pm version: 0.56 KiokuDB::Collapser: file: lib/KiokuDB/Collapser.pm version: 0.56 KiokuDB::Collapser::Buffer: file: lib/KiokuDB/Collapser/Buffer.pm version: 0.56 KiokuDB::Entry: file: lib/KiokuDB/Entry.pm version: 0.56 KiokuDB::Entry::Skip: file: lib/KiokuDB/Entry/Skip.pm version: 0.56 KiokuDB::Error: file: lib/KiokuDB/Error.pm version: 0.56 KiokuDB::Error::MissingObjects: file: lib/KiokuDB/Error/MissingObjects.pm version: 0.56 KiokuDB::Error::UnknownObjects: file: lib/KiokuDB/Error/UnknownObjects.pm version: 0.56 KiokuDB::GC::Naive: file: lib/KiokuDB/GC/Naive.pm version: 0.56 KiokuDB::GC::Naive::Mark: file: lib/KiokuDB/GC/Naive/Mark.pm version: 0.56 KiokuDB::GC::Naive::Mark::Results: file: lib/KiokuDB/GC/Naive/Mark.pm version: 0.56 KiokuDB::GC::Naive::Sweep: file: lib/KiokuDB/GC/Naive/Sweep.pm version: 0.56 KiokuDB::GC::Naive::Sweep::Results: file: lib/KiokuDB/GC/Naive/Sweep.pm version: 0.56 KiokuDB::GIN: file: lib/KiokuDB/GIN.pm version: 0.56 KiokuDB::LinkChecker: file: lib/KiokuDB/LinkChecker.pm version: 0.56 KiokuDB::LinkChecker::Results: file: lib/KiokuDB/LinkChecker/Results.pm version: 0.56 KiokuDB::Linker: file: lib/KiokuDB/Linker.pm version: 0.56 KiokuDB::LiveObjects: file: lib/KiokuDB/LiveObjects.pm version: 0.56 KiokuDB::LiveObjects::Guard: file: lib/KiokuDB/LiveObjects/Guard.pm version: 0.56 KiokuDB::LiveObjects::Scope: file: lib/KiokuDB/LiveObjects/Scope.pm version: 0.56 KiokuDB::LiveObjects::TXNScope: file: lib/KiokuDB/LiveObjects/TXNScope.pm version: 0.56 KiokuDB::Meta::Attribute::DoNotSerialize: file: lib/KiokuDB/Meta/Attribute/DoNotSerialize.pm version: 0.56 KiokuDB::Meta::Attribute::Lazy: file: lib/KiokuDB/Meta/Attribute/Lazy.pm version: 0.56 KiokuDB::Meta::Instance: file: lib/KiokuDB/Meta/Instance.pm version: 0.56 KiokuDB::Reference: file: lib/KiokuDB/Reference.pm version: 0.56 KiokuDB::Role::API: file: lib/KiokuDB/Role/API.pm version: 0.56 KiokuDB::Role::Cacheable: file: lib/KiokuDB/Role/Cacheable.pm version: 0.56 KiokuDB::Role::ID: file: lib/KiokuDB/Role/ID.pm version: 0.56 KiokuDB::Role::ID::Content: file: lib/KiokuDB/Role/ID/Content.pm version: 0.56 KiokuDB::Role::ID::Digest: file: lib/KiokuDB/Role/ID/Digest.pm version: 0.56 KiokuDB::Role::Immutable: file: lib/KiokuDB/Role/Immutable.pm version: 0.56 KiokuDB::Role::Immutable::Transitive: file: lib/KiokuDB/Role/Immutable/Transitive.pm version: 0.56 KiokuDB::Role::Intrinsic: file: lib/KiokuDB/Role/Intrinsic.pm version: 0.56 KiokuDB::Role::Scan: file: lib/KiokuDB/Role/Scan.pm version: 0.56 KiokuDB::Role::TypeMap: file: lib/KiokuDB/Role/TypeMap.pm version: 0.56 KiokuDB::Role::UUIDs: file: lib/KiokuDB/Role/UUIDs.pm version: 0.56 KiokuDB::Role::UUIDs::DataUUID: file: lib/KiokuDB/Role/UUIDs/DataUUID.pm version: 0.56 KiokuDB::Role::UUIDs::LibUUID: file: lib/KiokuDB/Role/UUIDs/LibUUID.pm version: 0.56 KiokuDB::Role::UUIDs::SerialIDs: file: lib/KiokuDB/Role/UUIDs/SerialIDs.pm version: 0.56 KiokuDB::Role::Upgrade::Data: file: lib/KiokuDB/Role/Upgrade/Data.pm version: 0.56 KiokuDB::Role::Upgrade::Handlers: file: lib/KiokuDB/Role/Upgrade/Handlers.pm version: 0.56 KiokuDB::Role::Upgrade::Handlers::Table: file: lib/KiokuDB/Role/Upgrade/Handlers/Table.pm version: 0.56 KiokuDB::Role::Verbosity: file: lib/KiokuDB/Role/Verbosity.pm version: 0.56 KiokuDB::Role::WithDigest: file: lib/KiokuDB/Role/WithDigest.pm version: 0.56 KiokuDB::Serializer: file: lib/KiokuDB/Serializer.pm version: 0.56 KiokuDB::Serializer::JSON: file: lib/KiokuDB/Serializer/JSON.pm version: 0.56 KiokuDB::Serializer::Memory: file: lib/KiokuDB/Serializer/Memory.pm version: 0.56 KiokuDB::Serializer::Storable: file: lib/KiokuDB/Serializer/Storable.pm version: 0.56 KiokuDB::Serializer::YAML: file: lib/KiokuDB/Serializer/YAML.pm version: 0.56 KiokuDB::Set: file: lib/KiokuDB/Set.pm version: 0.56 KiokuDB::Set::Base: file: lib/KiokuDB/Set/Base.pm version: 0.56 KiokuDB::Set::Deferred: file: lib/KiokuDB/Set/Deferred.pm version: 0.56 KiokuDB::Set::Loaded: file: lib/KiokuDB/Set/Loaded.pm version: 0.56 KiokuDB::Set::Storage: file: lib/KiokuDB/Set/Storage.pm version: 0.56 KiokuDB::Set::Stored: file: lib/KiokuDB/Set/Stored.pm version: 0.56 KiokuDB::Set::Transient: file: lib/KiokuDB/Set/Transient.pm version: 0.56 KiokuDB::Stream::Objects: file: lib/KiokuDB/Stream/Objects.pm version: 0.56 KiokuDB::Test: file: lib/KiokuDB/Test.pm version: 0.56 KiokuDB::Test::BLOB: file: lib/KiokuDB/Test/Fixture/Overwrite.pm version: 0.56 KiokuDB::Test::Company: file: lib/KiokuDB/Test/Company.pm version: 0.56 KiokuDB::Test::Digested: file: lib/KiokuDB/Test/Digested.pm version: 0.56 KiokuDB::Test::Employee: file: lib/KiokuDB/Test/Employee.pm version: 0.56 KiokuDB::Test::Fixture: file: lib/KiokuDB/Test/Fixture.pm version: 0.56 KiokuDB::Test::Fixture::Binary: file: lib/KiokuDB/Test/Fixture/Binary.pm version: 0.56 KiokuDB::Test::Fixture::CAS: file: lib/KiokuDB/Test/Fixture/CAS.pm version: 0.56 KiokuDB::Test::Fixture::Clear: file: lib/KiokuDB/Test/Fixture/Clear.pm version: 0.56 KiokuDB::Test::Fixture::Concurrency: file: lib/KiokuDB/Test/Fixture/Concurrency.pm version: 0.56 KiokuDB::Test::Fixture::GIN::Class: file: lib/KiokuDB/Test/Fixture/GIN/Class.pm version: 0.56 KiokuDB::Test::Fixture::MassInsert: file: lib/KiokuDB/Test/Fixture/MassInsert.pm version: 0.56 KiokuDB::Test::Fixture::ObjectGraph: file: lib/KiokuDB/Test/Fixture/ObjectGraph.pm version: 0.56 KiokuDB::Test::Fixture::Overwrite: file: lib/KiokuDB/Test/Fixture/Overwrite.pm version: 0.56 KiokuDB::Test::Fixture::Refresh: file: lib/KiokuDB/Test/Fixture/Refresh.pm version: 0.56 KiokuDB::Test::Fixture::RootSet: file: lib/KiokuDB/Test/Fixture/RootSet.pm version: 0.56 KiokuDB::Test::Fixture::Scan: file: lib/KiokuDB/Test/Fixture/Scan.pm version: 0.56 KiokuDB::Test::Fixture::Sets: file: lib/KiokuDB/Test/Fixture/Sets.pm version: 0.56 KiokuDB::Test::Fixture::SimpleSearch: file: lib/KiokuDB/Test/Fixture/SimpleSearch.pm version: 0.56 KiokuDB::Test::Fixture::Small: file: lib/KiokuDB/Test/Fixture/Small.pm version: 0.56 KiokuDB::Test::Fixture::TXN: file: lib/KiokuDB/Test/Fixture/TXN.pm version: 0.56 KiokuDB::Test::Fixture::TXN::Nested: file: lib/KiokuDB/Test/Fixture/TXN/Nested.pm version: 0.56 KiokuDB::Test::Fixture::TXN::Scan: file: lib/KiokuDB/Test/Fixture/TXN/Scan.pm version: 0.56 KiokuDB::Test::Fixture::TypeMap::Default: file: lib/KiokuDB/Test/Fixture/TypeMap/Default.pm version: 0.56 KiokuDB::Test::Fixture::Unicode: file: lib/KiokuDB/Test/Fixture/Unicode.pm version: 0.56 KiokuDB::Test::Person: file: lib/KiokuDB/Test/Person.pm version: 0.56 KiokuDB::Thunk: file: lib/KiokuDB/Thunk.pm version: 0.56 KiokuDB::TypeMap: file: lib/KiokuDB/TypeMap.pm version: 0.56 KiokuDB::TypeMap::ClassBuilders: file: lib/KiokuDB/TypeMap/ClassBuilders.pm version: 0.56 KiokuDB::TypeMap::Composite: file: lib/KiokuDB/TypeMap/Composite.pm version: 0.56 KiokuDB::TypeMap::Composite::TypeMapAttr: file: lib/KiokuDB/TypeMap/Composite.pm version: 0.56 KiokuDB::TypeMap::Default: file: lib/KiokuDB/TypeMap/Default.pm version: 0.56 KiokuDB::TypeMap::Default::Canonical: file: lib/KiokuDB/TypeMap/Default/Canonical.pm version: 0.56 KiokuDB::TypeMap::Default::JSON: file: lib/KiokuDB/TypeMap/Default/JSON.pm version: 0.56 KiokuDB::TypeMap::Default::Passthrough: file: lib/KiokuDB/TypeMap/Default/Passthrough.pm version: 0.56 KiokuDB::TypeMap::Default::Storable: file: lib/KiokuDB/TypeMap/Default/Storable.pm version: 0.56 KiokuDB::TypeMap::Entry: file: lib/KiokuDB/TypeMap/Entry.pm version: 0.56 KiokuDB::TypeMap::Entry::Alias: file: lib/KiokuDB/TypeMap/Entry/Alias.pm version: 0.56 KiokuDB::TypeMap::Entry::Callback: file: lib/KiokuDB/TypeMap/Entry/Callback.pm version: 0.56 KiokuDB::TypeMap::Entry::Closure: file: lib/KiokuDB/TypeMap/Entry/Closure.pm version: 0.56 KiokuDB::TypeMap::Entry::Compiled: file: lib/KiokuDB/TypeMap/Entry/Compiled.pm version: 0.56 KiokuDB::TypeMap::Entry::JSON::Scalar: file: lib/KiokuDB/TypeMap/Entry/JSON/Scalar.pm version: 0.56 KiokuDB::TypeMap::Entry::MOP: file: lib/KiokuDB/TypeMap/Entry/MOP.pm version: 0.56 KiokuDB::TypeMap::Entry::Naive: file: lib/KiokuDB/TypeMap/Entry/Naive.pm version: 0.56 KiokuDB::TypeMap::Entry::Passthrough: file: lib/KiokuDB/TypeMap/Entry/Passthrough.pm version: 0.56 KiokuDB::TypeMap::Entry::Ref: file: lib/KiokuDB/TypeMap/Entry/Ref.pm version: 0.56 KiokuDB::TypeMap::Entry::Set: file: lib/KiokuDB/TypeMap/Entry/Set.pm version: 0.56 KiokuDB::TypeMap::Entry::Std: file: lib/KiokuDB/TypeMap/Entry/Std.pm version: 0.56 KiokuDB::TypeMap::Entry::Std::Compile: file: lib/KiokuDB/TypeMap/Entry/Std/Compile.pm version: 0.56 KiokuDB::TypeMap::Entry::Std::Expand: file: lib/KiokuDB/TypeMap/Entry/Std/Expand.pm version: 0.56 KiokuDB::TypeMap::Entry::Std::ID: file: lib/KiokuDB/TypeMap/Entry/Std/ID.pm version: 0.56 KiokuDB::TypeMap::Entry::Std::Intrinsic: file: lib/KiokuDB/TypeMap/Entry/Std/Intrinsic.pm version: 0.56 KiokuDB::TypeMap::Entry::StorableHook: file: lib/KiokuDB/TypeMap/Entry/StorableHook.pm version: 0.56 KiokuDB::TypeMap::Resolver: file: lib/KiokuDB/TypeMap/Resolver.pm version: 0.56 KiokuDB::TypeMap::Shadow: file: lib/KiokuDB/TypeMap/Shadow.pm version: 0.56 KiokuDB::Util: file: lib/KiokuDB/Util.pm version: 0.56 Moose::Meta::Attribute::Custom::Trait::KiokuDB::DoNotSerialize: file: lib/Moose/Meta/Attribute/Custom/Trait/KiokuDB/DoNotSerialize.pm version: 0.56 Moose::Meta::Attribute::Custom::Trait::KiokuDB::Lazy: file: lib/Moose/Meta/Attribute/Custom/Trait/KiokuDB/Lazy.pm version: 0.56 requires: B: 0 B::Deparse: 0 Cache::Ref: 0.02 Carp: 0 Data::Stream::Bulk: 0.08 Data::Stream::Bulk::Util: 0 Data::Swap: 0 Data::UUID: 1.203 Data::Visitor: 0.24 Digest::SHA: 0 Encode: 0 Hash::Util::FieldHash::Compat: 0 IO::Handle: 0 JSON: 2.12 JSON::XS: 2.231 List::Util: 0 Module::Pluggable::Object: 0 Moose: 2.0000 Moose::Exporter: 0 Moose::Role: 0 Moose::Util: 0 Moose::Util::MetaRole: 0 Moose::Util::TypeConstraints: 0 MooseX::Clone: 0.04 MooseX::Clone::Meta::Attribute::Trait::NoClone: 0 MooseX::Role::Parameterized: 0.10 MooseX::YAML: 0.04 POSIX: 0 PadWalker: 1.9 Path::Class: 0 Scalar::Util: 0 Scope::Guard: 0 Search::GIN::Driver: 0 Search::GIN::Extract: 0 Search::GIN::Query::Class: 0.03 Set::Object: 1.26 Storable: 0 Sub::Exporter: 0 Symbol: 0 Test::Exception: 0 Test::Moose: 0 Test::More: 0.88 Throwable: 0 Tie::RefHash: 0 Tie::ToObject: 0 Try::Tiny: 0 YAML::XS: 0.30 constant: 0 namespace::clean: 0.08 overload: 0 strict: 0 utf8: 0 warnings: 0 resources: bugtracker: https://github.com/kiokudb/kiokudb/issues homepage: http://www.iinteractive.com/kiokudb/ repository: git://github.com/kiokudb/kiokudb.git version: 0.56 x_Dist_Zilla: perl: version: 5.018001 plugins: - class: Dist::Zilla::Plugin::FileFinder::Filter name: WeaverFiles version: 5.006 - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: test type: requires name: '@Filter/TestMoreDoneTesting' version: 5.006 - class: Dist::Zilla::Plugin::GatherDir name: '@Filter/GatherDir' version: 5.006 - class: Dist::Zilla::Plugin::PruneCruft name: '@Filter/PruneCruft' version: 5.006 - class: Dist::Zilla::Plugin::ManifestSkip name: '@Filter/ManifestSkip' version: 5.006 - class: Dist::Zilla::Plugin::MetaYAML name: '@Filter/MetaYAML' version: 5.006 - class: Dist::Zilla::Plugin::License name: '@Filter/License' version: 5.006 - class: Dist::Zilla::Plugin::RunExtraTests name: '@Filter/RunExtraTests' version: 0.013 - class: Dist::Zilla::Plugin::ExecDir name: '@Filter/ExecDir' version: 5.006 - class: Dist::Zilla::Plugin::ShareDir name: '@Filter/ShareDir' version: 5.006 - class: Dist::Zilla::Plugin::MakeMaker name: '@Filter/MakeMaker' version: 5.006 - class: Dist::Zilla::Plugin::Manifest name: '@Filter/Manifest' version: 5.006 - class: Dist::Zilla::Plugin::TestRelease name: '@Filter/TestRelease' version: 5.006 - class: Dist::Zilla::Plugin::ConfirmRelease name: '@Filter/ConfirmRelease' version: 5.006 - class: Dist::Zilla::Plugin::MetaConfig name: '@Filter/MetaConfig' version: 5.006 - class: Dist::Zilla::Plugin::MetaJSON name: '@Filter/MetaJSON' version: 5.006 - class: Dist::Zilla::Plugin::NextRelease name: '@Filter/NextRelease' version: 5.006 - class: Dist::Zilla::Plugin::CheckChangesHasContent name: '@Filter/CheckChangesHasContent' version: 0.006 - class: Dist::Zilla::Plugin::PkgVersion name: '@Filter/PkgVersion' version: 5.006 - class: Dist::Zilla::Plugin::Authority name: '@Filter/Authority' version: 1.006 - class: Dist::Zilla::Plugin::PodSyntaxTests name: '@Filter/PodSyntaxTests' version: 5.006 - class: Dist::Zilla::Plugin::NoTabsTests config: Dist::Zilla::Plugin::Test::NoTabs: module_finder: - ':InstallModules' script_finder: - ':ExecFiles' name: '@Filter/NoTabsTests' version: 0.05 - class: Dist::Zilla::Plugin::EOLTests name: '@Filter/EOLTests' version: 0.02 - class: Dist::Zilla::Plugin::Test::Compile config: Dist::Zilla::Plugin::Test::Compile: filename: t/00-compile.t module_finder: - ':InstallModules' script_finder: - ':ExecFiles' name: '@Filter/Test::Compile' version: 2.037 - class: Dist::Zilla::Plugin::Metadata name: '@Filter/Metadata' version: 3.03 - class: Dist::Zilla::Plugin::MetaResources name: '@Filter/MetaResources' version: 5.006 - class: Dist::Zilla::Plugin::Git::Check name: '@Filter/Git::Check' version: 2.016 - class: Dist::Zilla::Plugin::Git::Commit name: '@Filter/Git::Commit' version: 2.016 - class: Dist::Zilla::Plugin::Git::Tag name: '@Filter/Git::Tag' version: 2.016 - class: Dist::Zilla::Plugin::Git::NextVersion name: '@Filter/Git::NextVersion' version: 2.016 - class: Dist::Zilla::Plugin::ContributorsFromGit name: '@Filter/ContributorsFromGit' version: 0.006 - class: Dist::Zilla::Plugin::FinderCode name: '@Filter/MetaProvides::Package/AUTOVIV/:InstallModulesPM' version: 5.006 - class: Dist::Zilla::Plugin::MetaProvides::Package config: Dist::Zilla::Plugin::MetaProvides::Package: {} Dist::Zilla::Role::MetaProvider::Provider: inherit_missing: 1 inherit_version: 1 meta_noindex: 1 name: '@Filter/MetaProvides::Package' version: 1.15000000 - class: Dist::Zilla::Plugin::PodWeaver name: '@Filter/PodWeaver' version: 3.101641 - class: Dist::Zilla::Plugin::UploadToCPAN name: '@Filter/UploadToCPAN' version: 5.006 - class: Dist::Zilla::Plugin::AutoPrereqs name: AutoPrereqs version: 5.006 - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: develop type: requires name: DevelopRequires version: 5.006 - class: Dist::Zilla::Plugin::PerlVersionPrereqs config: Dist::Zilla::Plugin::PerlVersionPrereqs: perl_version: 5.010 name: 5.010 version: 0.01 - class: Dist::Zilla::Plugin::FinderCode name: ':InstallModules' version: 5.006 - class: Dist::Zilla::Plugin::FinderCode name: ':IncModules' version: 5.006 - class: Dist::Zilla::Plugin::FinderCode name: ':TestFiles' version: 5.006 - class: Dist::Zilla::Plugin::FinderCode name: ':ExecFiles' version: 5.006 - class: Dist::Zilla::Plugin::FinderCode name: ':ShareFiles' version: 5.006 - class: Dist::Zilla::Plugin::FinderCode name: ':MainModule' version: 5.006 zilla: class: Dist::Zilla::Dist::Builder config: is_trial: 0 version: 5.006 x_authority: cpan:NUFFIN x_contributors: - 'Andreas Marienborg ' - 'Ask Bjørn Hansen ' - 'Bruno Vecchi ' - 'Dan Dascalescu ' - 'Dan Dascalescu ' - 'Dave Rolsky ' - 'David Leadbeater ' - 'Dylan William Hardison ' - 'Florian Ragwitz ' - 'Frank Wiegand ' - 'Graham Barr ' - 'Jason May ' - 'Jesse Luehrs ' - 'Moritz Lenz ' - 'Pedro Melo ' - 'Piers Cawley ' - 'Rob Hoelz ' - 'Salve J. Nilsen ' - 'Shawn M Moore ' - 'Shlomi Fish ' - 'Thomas Klausner ' - 'Torsten Raudssus ' - 'chromatic ' - 'franck cuny ' - 'jrockway ' - 'ktat ' - 'perigrin ' MANIFEST100644001750000144 1322212237006576 13311 0ustar00doyusers000000000000KiokuDB-0.56Changes LICENSE MANIFEST META.json META.yml Makefile.PL README.mkdn TODO bench/shootout.pl bench/size.pl bench/small.pl bin/kioku dist.ini lib/KiokuDB.pm lib/KiokuDB/Backend.pm lib/KiokuDB/Backend/Hash.pm lib/KiokuDB/Backend/Role/BinarySafe.pm lib/KiokuDB/Backend/Role/Broken.pm lib/KiokuDB/Backend/Role/Clear.pm lib/KiokuDB/Backend/Role/Concurrency/POSIX.pm lib/KiokuDB/Backend/Role/GC.pm lib/KiokuDB/Backend/Role/Prefetch.pm lib/KiokuDB/Backend/Role/Query.pm lib/KiokuDB/Backend/Role/Query/GIN.pm lib/KiokuDB/Backend/Role/Query/Simple.pm lib/KiokuDB/Backend/Role/Query/Simple/Linear.pm lib/KiokuDB/Backend/Role/Scan.pm lib/KiokuDB/Backend/Role/TXN.pm lib/KiokuDB/Backend/Role/TXN/Memory.pm lib/KiokuDB/Backend/Role/TXN/Memory/Scan.pm lib/KiokuDB/Backend/Role/TXN/Nested.pm lib/KiokuDB/Backend/Role/UnicodeSafe.pm lib/KiokuDB/Backend/Serialize.pm lib/KiokuDB/Backend/Serialize/Delegate.pm lib/KiokuDB/Backend/Serialize/JSON.pm lib/KiokuDB/Backend/Serialize/JSPON.pm lib/KiokuDB/Backend/Serialize/JSPON/Collapser.pm lib/KiokuDB/Backend/Serialize/JSPON/Converter.pm lib/KiokuDB/Backend/Serialize/JSPON/Expander.pm lib/KiokuDB/Backend/Serialize/Memory.pm lib/KiokuDB/Backend/Serialize/Null.pm lib/KiokuDB/Backend/Serialize/Storable.pm lib/KiokuDB/Backend/Serialize/YAML.pm lib/KiokuDB/Backend/TypeMap/Default.pm lib/KiokuDB/Backend/TypeMap/Default/JSON.pm lib/KiokuDB/Backend/TypeMap/Default/Storable.pm lib/KiokuDB/Class.pm lib/KiokuDB/Collapser.pm lib/KiokuDB/Collapser/Buffer.pm lib/KiokuDB/Entry.pm lib/KiokuDB/Entry/Skip.pm lib/KiokuDB/Error.pm lib/KiokuDB/Error/MissingObjects.pm lib/KiokuDB/Error/UnknownObjects.pm lib/KiokuDB/GC/Naive.pm lib/KiokuDB/GC/Naive/Mark.pm lib/KiokuDB/GC/Naive/Sweep.pm lib/KiokuDB/GIN.pm lib/KiokuDB/LinkChecker.pm lib/KiokuDB/LinkChecker/Results.pm lib/KiokuDB/Linker.pm lib/KiokuDB/LiveObjects.pm lib/KiokuDB/LiveObjects/Guard.pm lib/KiokuDB/LiveObjects/Scope.pm lib/KiokuDB/LiveObjects/TXNScope.pm lib/KiokuDB/Meta/Attribute/DoNotSerialize.pm lib/KiokuDB/Meta/Attribute/Lazy.pm lib/KiokuDB/Meta/Instance.pm lib/KiokuDB/Reference.pm lib/KiokuDB/Role/API.pm lib/KiokuDB/Role/Cacheable.pm lib/KiokuDB/Role/ID.pm lib/KiokuDB/Role/ID/Content.pm lib/KiokuDB/Role/ID/Digest.pm lib/KiokuDB/Role/Immutable.pm lib/KiokuDB/Role/Immutable/Transitive.pm lib/KiokuDB/Role/Intrinsic.pm lib/KiokuDB/Role/Scan.pm lib/KiokuDB/Role/TypeMap.pm lib/KiokuDB/Role/UUIDs.pm lib/KiokuDB/Role/UUIDs/DataUUID.pm lib/KiokuDB/Role/UUIDs/LibUUID.pm lib/KiokuDB/Role/UUIDs/SerialIDs.pm lib/KiokuDB/Role/Upgrade/Data.pm lib/KiokuDB/Role/Upgrade/Handlers.pm lib/KiokuDB/Role/Upgrade/Handlers/Table.pm lib/KiokuDB/Role/Verbosity.pm lib/KiokuDB/Role/WithDigest.pm lib/KiokuDB/Serializer.pm lib/KiokuDB/Serializer/JSON.pm lib/KiokuDB/Serializer/Memory.pm lib/KiokuDB/Serializer/Storable.pm lib/KiokuDB/Serializer/YAML.pm lib/KiokuDB/Set.pm lib/KiokuDB/Set/Base.pm lib/KiokuDB/Set/Deferred.pm lib/KiokuDB/Set/Loaded.pm lib/KiokuDB/Set/Storage.pm lib/KiokuDB/Set/Stored.pm lib/KiokuDB/Set/Transient.pm lib/KiokuDB/Stream/Objects.pm lib/KiokuDB/Test.pm lib/KiokuDB/Test/Company.pm lib/KiokuDB/Test/Digested.pm lib/KiokuDB/Test/Employee.pm lib/KiokuDB/Test/Fixture.pm lib/KiokuDB/Test/Fixture/Binary.pm lib/KiokuDB/Test/Fixture/CAS.pm lib/KiokuDB/Test/Fixture/Clear.pm lib/KiokuDB/Test/Fixture/Concurrency.pm lib/KiokuDB/Test/Fixture/GIN/Class.pm lib/KiokuDB/Test/Fixture/MassInsert.pm lib/KiokuDB/Test/Fixture/ObjectGraph.pm lib/KiokuDB/Test/Fixture/Overwrite.pm lib/KiokuDB/Test/Fixture/Refresh.pm lib/KiokuDB/Test/Fixture/RootSet.pm lib/KiokuDB/Test/Fixture/Scan.pm lib/KiokuDB/Test/Fixture/Sets.pm lib/KiokuDB/Test/Fixture/SimpleSearch.pm lib/KiokuDB/Test/Fixture/Small.pm lib/KiokuDB/Test/Fixture/TXN.pm lib/KiokuDB/Test/Fixture/TXN/Nested.pm lib/KiokuDB/Test/Fixture/TXN/Scan.pm lib/KiokuDB/Test/Fixture/TypeMap/Default.pm lib/KiokuDB/Test/Fixture/Unicode.pm lib/KiokuDB/Test/Person.pm lib/KiokuDB/Thunk.pm lib/KiokuDB/Tutorial.pod lib/KiokuDB/Tutorial/JA.pod lib/KiokuDB/TypeMap.pm lib/KiokuDB/TypeMap/ClassBuilders.pm lib/KiokuDB/TypeMap/Composite.pm lib/KiokuDB/TypeMap/Default.pm lib/KiokuDB/TypeMap/Default/Canonical.pm lib/KiokuDB/TypeMap/Default/JSON.pm lib/KiokuDB/TypeMap/Default/Passthrough.pm lib/KiokuDB/TypeMap/Default/Storable.pm lib/KiokuDB/TypeMap/Entry.pm lib/KiokuDB/TypeMap/Entry/Alias.pm lib/KiokuDB/TypeMap/Entry/Callback.pm lib/KiokuDB/TypeMap/Entry/Closure.pm lib/KiokuDB/TypeMap/Entry/Compiled.pm lib/KiokuDB/TypeMap/Entry/JSON/Scalar.pm lib/KiokuDB/TypeMap/Entry/MOP.pm lib/KiokuDB/TypeMap/Entry/Naive.pm lib/KiokuDB/TypeMap/Entry/Passthrough.pm lib/KiokuDB/TypeMap/Entry/Ref.pm lib/KiokuDB/TypeMap/Entry/Set.pm lib/KiokuDB/TypeMap/Entry/Std.pm lib/KiokuDB/TypeMap/Entry/Std/Compile.pm lib/KiokuDB/TypeMap/Entry/Std/Expand.pm lib/KiokuDB/TypeMap/Entry/Std/ID.pm lib/KiokuDB/TypeMap/Entry/Std/Intrinsic.pm lib/KiokuDB/TypeMap/Entry/StorableHook.pm lib/KiokuDB/TypeMap/Resolver.pm lib/KiokuDB/TypeMap/Shadow.pm lib/KiokuDB/Util.pm lib/Moose/Meta/Attribute/Custom/Trait/KiokuDB/DoNotSerialize.pm lib/Moose/Meta/Attribute/Custom/Trait/KiokuDB/Lazy.pm lib/POD2/JA/KiokuDB/Tutorial.pod notes/std_layout.txt t/00-compile.t t/coderefs.t t/collapser.t t/digest.t t/directory.t t/entry.t t/gc_naive.t t/gin.t t/hash.t t/hash_backend.t t/jspon_serialization.t t/kiokudb_class_native.t t/lazy.t t/link_checker.t t/link_checker_real.t t/live_objs.t t/moose_triggers.t t/ref.t t/scaling.t t/serializer.t t/stream.t t/tied.t t/typemap.t t/typemap_default_json.t t/typemap_default_storable.t t/typemap_entry_callback.t t/typemap_entry_mop.t t/typemap_entry_naive.t t/typemap_entry_passthrough.t t/typemap_entry_storable.t t/typemap_extra.t t/typemap_resolver.t t/typemap_values.t t/uuid.t t/versioning.t xt/release/eol.t xt/release/no-tabs.t xt/release/pod-syntax.t entry.t100644001750000144 744012237006576 13736 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Storable qw(dclone); use KiokuDB::Entry; use KiokuDB::Reference; use KiokuDB::LiveObjects; { package KiokuDB_Test_Foo; use Moose; has oi => ( is => "rw" ); } my $x = KiokuDB_Test_Foo->new( oi => "vey" ); my $l = KiokuDB::LiveObjects->new; { foreach my $ent ( KiokuDB::Entry->new( id => "foo", root => 1, class => "KiokuDB_Test_Foo", data => { oi => "vey" }, object => $x, class_meta => { roles => [qw(KiokuDB_Test_Bar)] }, ), KiokuDB::Entry->new( id => "bar", data => [ 1 .. 3 ], ), KiokuDB::Entry->new( id => "goner", deleted => 1 ), KiokuDB::Entry->new( id => "bondage", tied => "H", data => KiokuDB::Entry->new( class => "KiokuDB_Test_Foo", data => {}, ), ), #KiokuDB::Entry->new( # id => "bondage", # tied => "HASH", # data => KiokuDB::Entry->new( # class => "KiokuDB_Test_Foo", # data => {}, # ), #), KiokuDB::Entry->new( id => "bar", data => [ 1 .. 3 ], backend_data => ["lalalal"], ), KiokuDB::Entry->new( id => "bar", data => [ 1 .. 3 ], prev => KiokuDB::Entry->new( id => "bar" ), ), ( map { KiokuDB::Entry->new( id => $_, data => { } ) } "foo", 123, "la-la", "3B19C598-E873-4C65-80BA-0D1C4E961DC9", "9170dc3d7a22403e11ff4c8aa1cd14d20c0ebf65", pack("H*", "9170dc3d7a22403e11ff4c8aa1cd14d20c0ebf65"), "foo,bar", ), ) { my $copy = dclone($ent); foreach my $transient ( qw(object prev) ) { my $attr = KiokuDB::Entry->meta->find_attribute_by_name($transient); ok( !$attr->has_value($copy), "no $transient in copy" ); $attr->clear_value($ent); } is( $copy->id, $ent->id, "ID is the same" ); is_deeply( $copy, $ent, "copy is_deeply orig" ); is_deeply( dclone($copy), $copy, "round trip of copy" ); unless ( $ent->id =~ /,/ ) { my $new = KiokuDB::Entry->new; $new->_unpack( $ent->_pack_old ); foreach my $field (qw(id class root deleted tied ) ) { is( $new->$field, $ent->$field, "$field in old pack format" ); } } } } my ( $foo, $bar, $gorch ) = map { KiokuDB::Reference->new( id => $_ ) } qw(foo bar gorch); is_deeply( [ KiokuDB::Entry->new( data => $foo )->references ], [ $foo ], "simple ref", ); is_deeply( [ KiokuDB::Entry->new( data => { foo => $foo } )->references ], [ $foo ], "simple ref in hash", ); is_deeply( [ sort KiokuDB::Entry->new( data => { foo => [ $foo, $bar ] } )->references ], [ sort $foo, $bar ], "multiple refs", ); is_deeply( [ KiokuDB::Entry->new( data => { foo => KiokuDB::Entry->new( data => [ $foo ] ) } )->references ], [ $foo ], "intrinsic entry", ); is_deeply( [ KiokuDB::Entry->new( data => { foo => KiokuDB::Entry->new( data => [ $foo ] ) } )->referenced_ids ], [ $foo->id ], "intrinsic entry (ids)", ); is_deeply( [ KiokuDB::Entry->new( data => [qw(foo bar)], class => 'KiokuDB::Set::Stored', id => 'the_set', )->references ], [ $foo, $bar ], "set entry", ); is_deeply( [ KiokuDB::Entry->new( data => [qw(foo bar)], class => 'KiokuDB::Set::Stored', id => 'the_set', )->referenced_ids ], [ $foo->id, $bar->id ], "set entry (ids)", ); done_testing; bin000755001750000144 012237006576 12550 5ustar00doyusers000000000000KiokuDB-0.56kioku100755001750000144 173312237006576 13764 0ustar00doyusers000000000000KiokuDB-0.56/bin#!/usr/bin/perl use strict; use warnings; # PODNAME: kioku use KiokuDB; use Try::Tiny; unless ( try_run() ) { if ( $INC{"KiokuDB/Cmd.pm"} ) { print "KiokuDB::Cmd is not up to date ($KiokuDB::REQUIRED_CMD_VERSION is required, $KiokuDB::Cmd::VERSION installed)\n"; } else { print "KiokuDB::Cmd is not installed (it's now shipped in a separate distribution).\n"; } } print "\nPlease install an up to date KiokuDB::Cmd from CPAN\n"; exit 1; sub try_run { return unless try { require KiokuDB::Cmd; 1 }; return unless KiokuDB::Cmd->is_up_to_date; KiokuDB::Cmd->run; exit; } __END__ =pod =head1 NAME kioku =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut META.json100644001750000144 10177612237006576 13635 0ustar00doyusers000000000000KiokuDB-0.56{ "abstract" : "Object Graph storage engine", "author" : [ "Yuval Kogman " ], "dynamic_config" : 1, "generated_by" : "Dist::Zilla version 5.006, CPAN::Meta::Converter version 2.132830", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "KiokuDB", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.30" } }, "develop" : { "requires" : { "Authen::Passphrase" : "0", "Class::Accessor" : "0", "Data::UUID::LibUUID" : "0.05", "DateTime" : "0", "DateTime::Format::Strptime" : "0", "MooseX::Object::Pluggable" : "0", "MooseX::Storage" : "0", "MooseX::Traits" : "0", "Object::InsideOut" : "0", "Object::Tiny" : "0", "Test::More" : "0", "Test::NoTabs" : "0", "Test::Pod" : "1.41", "Tie::IxHash" : "0", "URI" : "0" } }, "runtime" : { "requires" : { "B" : "0", "B::Deparse" : "0", "Cache::Ref" : "0.02", "Carp" : "0", "Data::Stream::Bulk" : "0.08", "Data::Stream::Bulk::Util" : "0", "Data::Swap" : "0", "Data::UUID" : "1.203", "Data::Visitor" : "0.24", "Digest::SHA" : "0", "Encode" : "0", "Hash::Util::FieldHash::Compat" : "0", "IO::Handle" : "0", "JSON" : "2.12", "JSON::XS" : "2.231", "List::Util" : "0", "Module::Pluggable::Object" : "0", "Moose" : "2.0000", "Moose::Exporter" : "0", "Moose::Role" : "0", "Moose::Util" : "0", "Moose::Util::MetaRole" : "0", "Moose::Util::TypeConstraints" : "0", "MooseX::Clone" : "0.04", "MooseX::Clone::Meta::Attribute::Trait::NoClone" : "0", "MooseX::Role::Parameterized" : "0.10", "MooseX::YAML" : "0.04", "POSIX" : "0", "PadWalker" : "1.9", "Path::Class" : "0", "Scalar::Util" : "0", "Scope::Guard" : "0", "Search::GIN::Driver" : "0", "Search::GIN::Extract" : "0", "Search::GIN::Query::Class" : "0.03", "Set::Object" : "1.26", "Storable" : "0", "Sub::Exporter" : "0", "Symbol" : "0", "Test::Exception" : "0", "Test::Moose" : "0", "Test::More" : "0.88", "Throwable" : "0", "Tie::RefHash" : "0", "Tie::ToObject" : "0", "Try::Tiny" : "0", "YAML::XS" : "0.30", "constant" : "0", "namespace::clean" : "0.08", "overload" : "0", "strict" : "0", "utf8" : "0", "warnings" : "0" } }, "test" : { "requires" : { "Cache::Ref::CART" : "0", "Cache::Ref::CLOCK" : "0", "Data::Dumper" : "0", "Data::Stream::Bulk::Callback" : "0", "File::Spec" : "0", "IO::Handle" : "0", "IPC::Open3" : "0", "Search::GIN::Driver::Hash" : "0", "Search::GIN::Extract::Class" : "0", "Search::GIN::Extract::Delegate" : "0", "Test::More" : "0.88", "base" : "0", "if" : "0" } } }, "provides" : { "KiokuDB" : { "file" : "lib/KiokuDB.pm", "version" : "0.56" }, "KiokuDB::Backend" : { "file" : "lib/KiokuDB/Backend.pm", "version" : "0.56" }, "KiokuDB::Backend::Hash" : { "file" : "lib/KiokuDB/Backend/Hash.pm", "version" : "0.56" }, "KiokuDB::Backend::Role::BinarySafe" : { "file" : "lib/KiokuDB/Backend/Role/BinarySafe.pm", "version" : "0.56" }, "KiokuDB::Backend::Role::Broken" : { "file" : "lib/KiokuDB/Backend/Role/Broken.pm", "version" : "0.56" }, "KiokuDB::Backend::Role::Clear" : { "file" : "lib/KiokuDB/Backend/Role/Clear.pm", "version" : "0.56" }, "KiokuDB::Backend::Role::Concurrency::POSIX" : { "file" : "lib/KiokuDB/Backend/Role/Concurrency/POSIX.pm", "version" : "0.56" }, "KiokuDB::Backend::Role::GC" : { "file" : "lib/KiokuDB/Backend/Role/GC.pm", "version" : "0.56" }, "KiokuDB::Backend::Role::Prefetch" : { "file" : "lib/KiokuDB/Backend/Role/Prefetch.pm", "version" : "0.56" }, "KiokuDB::Backend::Role::Query" : { "file" : "lib/KiokuDB/Backend/Role/Query.pm", "version" : "0.56" }, "KiokuDB::Backend::Role::Query::GIN" : { "file" : "lib/KiokuDB/Backend/Role/Query/GIN.pm", "version" : "0.56" }, "KiokuDB::Backend::Role::Query::Simple" : { "file" : "lib/KiokuDB/Backend/Role/Query/Simple.pm", "version" : "0.56" }, "KiokuDB::Backend::Role::Query::Simple::Linear" : { "file" : "lib/KiokuDB/Backend/Role/Query/Simple/Linear.pm", "version" : "0.56" }, "KiokuDB::Backend::Role::Scan" : { "file" : "lib/KiokuDB/Backend/Role/Scan.pm", "version" : "0.56" }, "KiokuDB::Backend::Role::TXN" : { "file" : "lib/KiokuDB/Backend/Role/TXN.pm", "version" : "0.56" }, "KiokuDB::Backend::Role::TXN::Memory" : { "file" : "lib/KiokuDB/Backend/Role/TXN/Memory.pm", "version" : "0.56" }, "KiokuDB::Backend::Role::TXN::Memory::Scan" : { "file" : "lib/KiokuDB/Backend/Role/TXN/Memory/Scan.pm", "version" : "0.56" }, "KiokuDB::Backend::Role::TXN::Nested" : { "file" : "lib/KiokuDB/Backend/Role/TXN/Nested.pm", "version" : "0.56" }, "KiokuDB::Backend::Role::UnicodeSafe" : { "file" : "lib/KiokuDB/Backend/Role/UnicodeSafe.pm", "version" : "0.56" }, "KiokuDB::Backend::Serialize" : { "file" : "lib/KiokuDB/Backend/Serialize.pm", "version" : "0.56" }, "KiokuDB::Backend::Serialize::Delegate" : { "file" : "lib/KiokuDB/Backend/Serialize/Delegate.pm", "version" : "0.56" }, "KiokuDB::Backend::Serialize::JSON" : { "file" : "lib/KiokuDB/Backend/Serialize/JSON.pm", "version" : "0.56" }, "KiokuDB::Backend::Serialize::JSPON" : { "file" : "lib/KiokuDB/Backend/Serialize/JSPON.pm", "version" : "0.56" }, "KiokuDB::Backend::Serialize::JSPON::Collapser" : { "file" : "lib/KiokuDB/Backend/Serialize/JSPON/Collapser.pm", "version" : "0.56" }, "KiokuDB::Backend::Serialize::JSPON::Converter" : { "file" : "lib/KiokuDB/Backend/Serialize/JSPON/Converter.pm", "version" : "0.56" }, "KiokuDB::Backend::Serialize::JSPON::Expander" : { "file" : "lib/KiokuDB/Backend/Serialize/JSPON/Expander.pm", "version" : "0.56" }, "KiokuDB::Backend::Serialize::Memory" : { "file" : "lib/KiokuDB/Backend/Serialize/Memory.pm", "version" : "0.56" }, "KiokuDB::Backend::Serialize::Null" : { "file" : "lib/KiokuDB/Backend/Serialize/Null.pm", "version" : "0.56" }, "KiokuDB::Backend::Serialize::Storable" : { "file" : "lib/KiokuDB/Backend/Serialize/Storable.pm", "version" : "0.56" }, "KiokuDB::Backend::Serialize::YAML" : { "file" : "lib/KiokuDB/Backend/Serialize/YAML.pm", "version" : "0.56" }, "KiokuDB::Backend::TypeMap::Default" : { "file" : "lib/KiokuDB/Backend/TypeMap/Default.pm", "version" : "0.56" }, "KiokuDB::Backend::TypeMap::Default::JSON" : { "file" : "lib/KiokuDB/Backend/TypeMap/Default/JSON.pm", "version" : "0.56" }, "KiokuDB::Backend::TypeMap::Default::Storable" : { "file" : "lib/KiokuDB/Backend/TypeMap/Default/Storable.pm", "version" : "0.56" }, "KiokuDB::Class" : { "file" : "lib/KiokuDB/Class.pm", "version" : "0.56" }, "KiokuDB::Collapser" : { "file" : "lib/KiokuDB/Collapser.pm", "version" : "0.56" }, "KiokuDB::Collapser::Buffer" : { "file" : "lib/KiokuDB/Collapser/Buffer.pm", "version" : "0.56" }, "KiokuDB::Entry" : { "file" : "lib/KiokuDB/Entry.pm", "version" : "0.56" }, "KiokuDB::Entry::Skip" : { "file" : "lib/KiokuDB/Entry/Skip.pm", "version" : "0.56" }, "KiokuDB::Error" : { "file" : "lib/KiokuDB/Error.pm", "version" : "0.56" }, "KiokuDB::Error::MissingObjects" : { "file" : "lib/KiokuDB/Error/MissingObjects.pm", "version" : "0.56" }, "KiokuDB::Error::UnknownObjects" : { "file" : "lib/KiokuDB/Error/UnknownObjects.pm", "version" : "0.56" }, "KiokuDB::GC::Naive" : { "file" : "lib/KiokuDB/GC/Naive.pm", "version" : "0.56" }, "KiokuDB::GC::Naive::Mark" : { "file" : "lib/KiokuDB/GC/Naive/Mark.pm", "version" : "0.56" }, "KiokuDB::GC::Naive::Mark::Results" : { "file" : "lib/KiokuDB/GC/Naive/Mark.pm", "version" : "0.56" }, "KiokuDB::GC::Naive::Sweep" : { "file" : "lib/KiokuDB/GC/Naive/Sweep.pm", "version" : "0.56" }, "KiokuDB::GC::Naive::Sweep::Results" : { "file" : "lib/KiokuDB/GC/Naive/Sweep.pm", "version" : "0.56" }, "KiokuDB::GIN" : { "file" : "lib/KiokuDB/GIN.pm", "version" : "0.56" }, "KiokuDB::LinkChecker" : { "file" : "lib/KiokuDB/LinkChecker.pm", "version" : "0.56" }, "KiokuDB::LinkChecker::Results" : { "file" : "lib/KiokuDB/LinkChecker/Results.pm", "version" : "0.56" }, "KiokuDB::Linker" : { "file" : "lib/KiokuDB/Linker.pm", "version" : "0.56" }, "KiokuDB::LiveObjects" : { "file" : "lib/KiokuDB/LiveObjects.pm", "version" : "0.56" }, "KiokuDB::LiveObjects::Guard" : { "file" : "lib/KiokuDB/LiveObjects/Guard.pm", "version" : "0.56" }, "KiokuDB::LiveObjects::Scope" : { "file" : "lib/KiokuDB/LiveObjects/Scope.pm", "version" : "0.56" }, "KiokuDB::LiveObjects::TXNScope" : { "file" : "lib/KiokuDB/LiveObjects/TXNScope.pm", "version" : "0.56" }, "KiokuDB::Meta::Attribute::DoNotSerialize" : { "file" : "lib/KiokuDB/Meta/Attribute/DoNotSerialize.pm", "version" : "0.56" }, "KiokuDB::Meta::Attribute::Lazy" : { "file" : "lib/KiokuDB/Meta/Attribute/Lazy.pm", "version" : "0.56" }, "KiokuDB::Meta::Instance" : { "file" : "lib/KiokuDB/Meta/Instance.pm", "version" : "0.56" }, "KiokuDB::Reference" : { "file" : "lib/KiokuDB/Reference.pm", "version" : "0.56" }, "KiokuDB::Role::API" : { "file" : "lib/KiokuDB/Role/API.pm", "version" : "0.56" }, "KiokuDB::Role::Cacheable" : { "file" : "lib/KiokuDB/Role/Cacheable.pm", "version" : "0.56" }, "KiokuDB::Role::ID" : { "file" : "lib/KiokuDB/Role/ID.pm", "version" : "0.56" }, "KiokuDB::Role::ID::Content" : { "file" : "lib/KiokuDB/Role/ID/Content.pm", "version" : "0.56" }, "KiokuDB::Role::ID::Digest" : { "file" : "lib/KiokuDB/Role/ID/Digest.pm", "version" : "0.56" }, "KiokuDB::Role::Immutable" : { "file" : "lib/KiokuDB/Role/Immutable.pm", "version" : "0.56" }, "KiokuDB::Role::Immutable::Transitive" : { "file" : "lib/KiokuDB/Role/Immutable/Transitive.pm", "version" : "0.56" }, "KiokuDB::Role::Intrinsic" : { "file" : "lib/KiokuDB/Role/Intrinsic.pm", "version" : "0.56" }, "KiokuDB::Role::Scan" : { "file" : "lib/KiokuDB/Role/Scan.pm", "version" : "0.56" }, "KiokuDB::Role::TypeMap" : { "file" : "lib/KiokuDB/Role/TypeMap.pm", "version" : "0.56" }, "KiokuDB::Role::UUIDs" : { "file" : "lib/KiokuDB/Role/UUIDs.pm", "version" : "0.56" }, "KiokuDB::Role::UUIDs::DataUUID" : { "file" : "lib/KiokuDB/Role/UUIDs/DataUUID.pm", "version" : "0.56" }, "KiokuDB::Role::UUIDs::LibUUID" : { "file" : "lib/KiokuDB/Role/UUIDs/LibUUID.pm", "version" : "0.56" }, "KiokuDB::Role::UUIDs::SerialIDs" : { "file" : "lib/KiokuDB/Role/UUIDs/SerialIDs.pm", "version" : "0.56" }, "KiokuDB::Role::Upgrade::Data" : { "file" : "lib/KiokuDB/Role/Upgrade/Data.pm", "version" : "0.56" }, "KiokuDB::Role::Upgrade::Handlers" : { "file" : "lib/KiokuDB/Role/Upgrade/Handlers.pm", "version" : "0.56" }, "KiokuDB::Role::Upgrade::Handlers::Table" : { "file" : "lib/KiokuDB/Role/Upgrade/Handlers/Table.pm", "version" : "0.56" }, "KiokuDB::Role::Verbosity" : { "file" : "lib/KiokuDB/Role/Verbosity.pm", "version" : "0.56" }, "KiokuDB::Role::WithDigest" : { "file" : "lib/KiokuDB/Role/WithDigest.pm", "version" : "0.56" }, "KiokuDB::Serializer" : { "file" : "lib/KiokuDB/Serializer.pm", "version" : "0.56" }, "KiokuDB::Serializer::JSON" : { "file" : "lib/KiokuDB/Serializer/JSON.pm", "version" : "0.56" }, "KiokuDB::Serializer::Memory" : { "file" : "lib/KiokuDB/Serializer/Memory.pm", "version" : "0.56" }, "KiokuDB::Serializer::Storable" : { "file" : "lib/KiokuDB/Serializer/Storable.pm", "version" : "0.56" }, "KiokuDB::Serializer::YAML" : { "file" : "lib/KiokuDB/Serializer/YAML.pm", "version" : "0.56" }, "KiokuDB::Set" : { "file" : "lib/KiokuDB/Set.pm", "version" : "0.56" }, "KiokuDB::Set::Base" : { "file" : "lib/KiokuDB/Set/Base.pm", "version" : "0.56" }, "KiokuDB::Set::Deferred" : { "file" : "lib/KiokuDB/Set/Deferred.pm", "version" : "0.56" }, "KiokuDB::Set::Loaded" : { "file" : "lib/KiokuDB/Set/Loaded.pm", "version" : "0.56" }, "KiokuDB::Set::Storage" : { "file" : "lib/KiokuDB/Set/Storage.pm", "version" : "0.56" }, "KiokuDB::Set::Stored" : { "file" : "lib/KiokuDB/Set/Stored.pm", "version" : "0.56" }, "KiokuDB::Set::Transient" : { "file" : "lib/KiokuDB/Set/Transient.pm", "version" : "0.56" }, "KiokuDB::Stream::Objects" : { "file" : "lib/KiokuDB/Stream/Objects.pm", "version" : "0.56" }, "KiokuDB::Test" : { "file" : "lib/KiokuDB/Test.pm", "version" : "0.56" }, "KiokuDB::Test::BLOB" : { "file" : "lib/KiokuDB/Test/Fixture/Overwrite.pm", "version" : "0.56" }, "KiokuDB::Test::Company" : { "file" : "lib/KiokuDB/Test/Company.pm", "version" : "0.56" }, "KiokuDB::Test::Digested" : { "file" : "lib/KiokuDB/Test/Digested.pm", "version" : "0.56" }, "KiokuDB::Test::Employee" : { "file" : "lib/KiokuDB/Test/Employee.pm", "version" : "0.56" }, "KiokuDB::Test::Fixture" : { "file" : "lib/KiokuDB/Test/Fixture.pm", "version" : "0.56" }, "KiokuDB::Test::Fixture::Binary" : { "file" : "lib/KiokuDB/Test/Fixture/Binary.pm", "version" : "0.56" }, "KiokuDB::Test::Fixture::CAS" : { "file" : "lib/KiokuDB/Test/Fixture/CAS.pm", "version" : "0.56" }, "KiokuDB::Test::Fixture::Clear" : { "file" : "lib/KiokuDB/Test/Fixture/Clear.pm", "version" : "0.56" }, "KiokuDB::Test::Fixture::Concurrency" : { "file" : "lib/KiokuDB/Test/Fixture/Concurrency.pm", "version" : "0.56" }, "KiokuDB::Test::Fixture::GIN::Class" : { "file" : "lib/KiokuDB/Test/Fixture/GIN/Class.pm", "version" : "0.56" }, "KiokuDB::Test::Fixture::MassInsert" : { "file" : "lib/KiokuDB/Test/Fixture/MassInsert.pm", "version" : "0.56" }, "KiokuDB::Test::Fixture::ObjectGraph" : { "file" : "lib/KiokuDB/Test/Fixture/ObjectGraph.pm", "version" : "0.56" }, "KiokuDB::Test::Fixture::Overwrite" : { "file" : "lib/KiokuDB/Test/Fixture/Overwrite.pm", "version" : "0.56" }, "KiokuDB::Test::Fixture::Refresh" : { "file" : "lib/KiokuDB/Test/Fixture/Refresh.pm", "version" : "0.56" }, "KiokuDB::Test::Fixture::RootSet" : { "file" : "lib/KiokuDB/Test/Fixture/RootSet.pm", "version" : "0.56" }, "KiokuDB::Test::Fixture::Scan" : { "file" : "lib/KiokuDB/Test/Fixture/Scan.pm", "version" : "0.56" }, "KiokuDB::Test::Fixture::Sets" : { "file" : "lib/KiokuDB/Test/Fixture/Sets.pm", "version" : "0.56" }, "KiokuDB::Test::Fixture::SimpleSearch" : { "file" : "lib/KiokuDB/Test/Fixture/SimpleSearch.pm", "version" : "0.56" }, "KiokuDB::Test::Fixture::Small" : { "file" : "lib/KiokuDB/Test/Fixture/Small.pm", "version" : "0.56" }, "KiokuDB::Test::Fixture::TXN" : { "file" : "lib/KiokuDB/Test/Fixture/TXN.pm", "version" : "0.56" }, "KiokuDB::Test::Fixture::TXN::Nested" : { "file" : "lib/KiokuDB/Test/Fixture/TXN/Nested.pm", "version" : "0.56" }, "KiokuDB::Test::Fixture::TXN::Scan" : { "file" : "lib/KiokuDB/Test/Fixture/TXN/Scan.pm", "version" : "0.56" }, "KiokuDB::Test::Fixture::TypeMap::Default" : { "file" : "lib/KiokuDB/Test/Fixture/TypeMap/Default.pm", "version" : "0.56" }, "KiokuDB::Test::Fixture::Unicode" : { "file" : "lib/KiokuDB/Test/Fixture/Unicode.pm", "version" : "0.56" }, "KiokuDB::Test::Person" : { "file" : "lib/KiokuDB/Test/Person.pm", "version" : "0.56" }, "KiokuDB::Thunk" : { "file" : "lib/KiokuDB/Thunk.pm", "version" : "0.56" }, "KiokuDB::TypeMap" : { "file" : "lib/KiokuDB/TypeMap.pm", "version" : "0.56" }, "KiokuDB::TypeMap::ClassBuilders" : { "file" : "lib/KiokuDB/TypeMap/ClassBuilders.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Composite" : { "file" : "lib/KiokuDB/TypeMap/Composite.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Composite::TypeMapAttr" : { "file" : "lib/KiokuDB/TypeMap/Composite.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Default" : { "file" : "lib/KiokuDB/TypeMap/Default.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Default::Canonical" : { "file" : "lib/KiokuDB/TypeMap/Default/Canonical.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Default::JSON" : { "file" : "lib/KiokuDB/TypeMap/Default/JSON.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Default::Passthrough" : { "file" : "lib/KiokuDB/TypeMap/Default/Passthrough.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Default::Storable" : { "file" : "lib/KiokuDB/TypeMap/Default/Storable.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Entry" : { "file" : "lib/KiokuDB/TypeMap/Entry.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Entry::Alias" : { "file" : "lib/KiokuDB/TypeMap/Entry/Alias.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Entry::Callback" : { "file" : "lib/KiokuDB/TypeMap/Entry/Callback.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Entry::Closure" : { "file" : "lib/KiokuDB/TypeMap/Entry/Closure.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Entry::Compiled" : { "file" : "lib/KiokuDB/TypeMap/Entry/Compiled.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Entry::JSON::Scalar" : { "file" : "lib/KiokuDB/TypeMap/Entry/JSON/Scalar.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Entry::MOP" : { "file" : "lib/KiokuDB/TypeMap/Entry/MOP.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Entry::Naive" : { "file" : "lib/KiokuDB/TypeMap/Entry/Naive.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Entry::Passthrough" : { "file" : "lib/KiokuDB/TypeMap/Entry/Passthrough.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Entry::Ref" : { "file" : "lib/KiokuDB/TypeMap/Entry/Ref.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Entry::Set" : { "file" : "lib/KiokuDB/TypeMap/Entry/Set.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Entry::Std" : { "file" : "lib/KiokuDB/TypeMap/Entry/Std.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Entry::Std::Compile" : { "file" : "lib/KiokuDB/TypeMap/Entry/Std/Compile.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Entry::Std::Expand" : { "file" : "lib/KiokuDB/TypeMap/Entry/Std/Expand.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Entry::Std::ID" : { "file" : "lib/KiokuDB/TypeMap/Entry/Std/ID.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Entry::Std::Intrinsic" : { "file" : "lib/KiokuDB/TypeMap/Entry/Std/Intrinsic.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Entry::StorableHook" : { "file" : "lib/KiokuDB/TypeMap/Entry/StorableHook.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Resolver" : { "file" : "lib/KiokuDB/TypeMap/Resolver.pm", "version" : "0.56" }, "KiokuDB::TypeMap::Shadow" : { "file" : "lib/KiokuDB/TypeMap/Shadow.pm", "version" : "0.56" }, "KiokuDB::Util" : { "file" : "lib/KiokuDB/Util.pm", "version" : "0.56" }, "Moose::Meta::Attribute::Custom::Trait::KiokuDB::DoNotSerialize" : { "file" : "lib/Moose/Meta/Attribute/Custom/Trait/KiokuDB/DoNotSerialize.pm", "version" : "0.56" }, "Moose::Meta::Attribute::Custom::Trait::KiokuDB::Lazy" : { "file" : "lib/Moose/Meta/Attribute/Custom/Trait/KiokuDB/Lazy.pm", "version" : "0.56" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/kiokudb/kiokudb/issues" }, "homepage" : "http://www.iinteractive.com/kiokudb/", "repository" : { "type" : "git", "url" : "git://github.com/kiokudb/kiokudb.git", "web" : "https://github.com/kiokudb/kiokudb" } }, "version" : "0.56", "x_Dist_Zilla" : { "perl" : { "version" : "5.018001" }, "plugins" : [ { "class" : "Dist::Zilla::Plugin::FileFinder::Filter", "name" : "WeaverFiles", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "test", "type" : "requires" } }, "name" : "@Filter/TestMoreDoneTesting", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::GatherDir", "name" : "@Filter/GatherDir", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::PruneCruft", "name" : "@Filter/PruneCruft", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::ManifestSkip", "name" : "@Filter/ManifestSkip", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::MetaYAML", "name" : "@Filter/MetaYAML", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::License", "name" : "@Filter/License", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::RunExtraTests", "name" : "@Filter/RunExtraTests", "version" : "0.013" }, { "class" : "Dist::Zilla::Plugin::ExecDir", "name" : "@Filter/ExecDir", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::ShareDir", "name" : "@Filter/ShareDir", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::MakeMaker", "name" : "@Filter/MakeMaker", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::Manifest", "name" : "@Filter/Manifest", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::TestRelease", "name" : "@Filter/TestRelease", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::ConfirmRelease", "name" : "@Filter/ConfirmRelease", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::MetaConfig", "name" : "@Filter/MetaConfig", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::MetaJSON", "name" : "@Filter/MetaJSON", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::NextRelease", "name" : "@Filter/NextRelease", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::CheckChangesHasContent", "name" : "@Filter/CheckChangesHasContent", "version" : "0.006" }, { "class" : "Dist::Zilla::Plugin::PkgVersion", "name" : "@Filter/PkgVersion", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::Authority", "name" : "@Filter/Authority", "version" : "1.006" }, { "class" : "Dist::Zilla::Plugin::PodSyntaxTests", "name" : "@Filter/PodSyntaxTests", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::NoTabsTests", "config" : { "Dist::Zilla::Plugin::Test::NoTabs" : { "module_finder" : [ ":InstallModules" ], "script_finder" : [ ":ExecFiles" ] } }, "name" : "@Filter/NoTabsTests", "version" : "0.05" }, { "class" : "Dist::Zilla::Plugin::EOLTests", "name" : "@Filter/EOLTests", "version" : "0.02" }, { "class" : "Dist::Zilla::Plugin::Test::Compile", "config" : { "Dist::Zilla::Plugin::Test::Compile" : { "filename" : "t/00-compile.t", "module_finder" : [ ":InstallModules" ], "script_finder" : [ ":ExecFiles" ] } }, "name" : "@Filter/Test::Compile", "version" : "2.037" }, { "class" : "Dist::Zilla::Plugin::Metadata", "name" : "@Filter/Metadata", "version" : "3.03" }, { "class" : "Dist::Zilla::Plugin::MetaResources", "name" : "@Filter/MetaResources", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::Git::Check", "name" : "@Filter/Git::Check", "version" : "2.016" }, { "class" : "Dist::Zilla::Plugin::Git::Commit", "name" : "@Filter/Git::Commit", "version" : "2.016" }, { "class" : "Dist::Zilla::Plugin::Git::Tag", "name" : "@Filter/Git::Tag", "version" : "2.016" }, { "class" : "Dist::Zilla::Plugin::Git::NextVersion", "name" : "@Filter/Git::NextVersion", "version" : "2.016" }, { "class" : "Dist::Zilla::Plugin::ContributorsFromGit", "name" : "@Filter/ContributorsFromGit", "version" : "0.006" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : "@Filter/MetaProvides::Package/AUTOVIV/:InstallModulesPM", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::MetaProvides::Package", "config" : { "Dist::Zilla::Plugin::MetaProvides::Package" : {}, "Dist::Zilla::Role::MetaProvider::Provider" : { "inherit_missing" : "1", "inherit_version" : "1", "meta_noindex" : "1" } }, "name" : "@Filter/MetaProvides::Package", "version" : "1.15000000" }, { "class" : "Dist::Zilla::Plugin::PodWeaver", "name" : "@Filter/PodWeaver", "version" : "3.101641" }, { "class" : "Dist::Zilla::Plugin::UploadToCPAN", "name" : "@Filter/UploadToCPAN", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::AutoPrereqs", "name" : "AutoPrereqs", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "develop", "type" : "requires" } }, "name" : "DevelopRequires", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::PerlVersionPrereqs", "config" : { "Dist::Zilla::Plugin::PerlVersionPrereqs" : { "perl_version" : "5.010" } }, "name" : "5.010", "version" : "0.01" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":InstallModules", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":IncModules", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":TestFiles", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExecFiles", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ShareFiles", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":MainModule", "version" : "5.006" } ], "zilla" : { "class" : "Dist::Zilla::Dist::Builder", "config" : { "is_trial" : "0" }, "version" : "5.006" } }, "x_authority" : "cpan:NUFFIN", "x_contributors" : [ "Andreas Marienborg ", "Ask Bj\u00f8rn Hansen ", "Bruno Vecchi ", "Dan Dascalescu ", "Dan Dascalescu ", "Dave Rolsky ", "David Leadbeater ", "Dylan William Hardison ", "Florian Ragwitz ", "Frank Wiegand ", "Graham Barr ", "Jason May ", "Jesse Luehrs ", "Moritz Lenz ", "Pedro Melo ", "Piers Cawley ", "Rob Hoelz ", "Salve J. Nilsen ", "Shawn M Moore ", "Shlomi Fish ", "Thomas Klausner ", "Torsten Raudssus ", "chromatic ", "franck cuny ", "jrockway ", "ktat ", "perigrin " ] } digest.t100644001750000144 140512237006576 14047 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use KiokuDB::Test::Digested; my $foo = KiokuDB::Test::Digested->new( foo => "blaitty4", ); ok( $foo->digest, "got a digest" ); my $bar = KiokuDB::Test::Digested->new( bar => "bar", ); ok( $bar->digest, "got a digest" ); isnt( $foo->digest, $bar->digest, "digests differ" ); my $both = KiokuDB::Test::Digested->new( foo => "blaitty4", bar => "bar", ); isnt( $both->digest, $foo->digest, "digests differ" ); isnt( $both->digest, $bar->digest, "digests differ" ); is( $foo->digest, KiokuDB::Test::Digested->new( foo => "blaitty4" )->digest, "digest is the same for new object" ); use Data::Dumper; like( Dumper($foo->digest_parts), qr/blaitty4/, "contains digest parts" ); done_testing; stream.t100644001750000144 347612237006576 14075 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Exception; use Data::Stream::Bulk::Callback; use KiokuDB; use KiokuDB::Backend::Hash; use KiokuDB::Stream::Objects; { package KiokuDB_Test_Foo; use Moose; has id => (is => 'rw', isa => 'Str'); has num => (is => 'rw', isa => 'Int'); } my $dir = KiokuDB->connect( "hash", serializer => 'memory'); my @objs = ( KiokuDB_Test_Foo->new( id => 'one', num => 1 ), KiokuDB_Test_Foo->new( id => 'two', num => 2 ), KiokuDB_Test_Foo->new( id => 'three', num => 3 ), KiokuDB_Test_Foo->new( id => 'zero', num => 0 ), KiokuDB_Test_Foo->new( id => 'four', num => 4 ), ); my @ids; my @entries; { my $s = $dir->new_scope; foreach my $obj (@objs) { lives_ok { $dir->store( $obj->id => $obj ) } "can store " . $obj->id; } @ids = $dir->live_objects->objects_to_ids(@objs); @entries = map { $_->clone } $dir->live_objects->objects_to_entries(@objs); } sub iter { my @x = @_; Data::Stream::Bulk::Callback->new( callback => sub { return unless @x; return [ shift @x ] })->filter(sub {[grep { $_->can("num") ? $_->num : $_->data->{num} } @$_ ]}); } is_deeply([map { $_->num } iter(@objs)->all],[1,2,3,4], "found 4 objects"); { my $stream = KiokuDB::Stream::Objects ->new( directory => $dir, entry_stream => iter(@entries), ); is_deeply([map { $_->num } $stream->all],[1,2,3,4], "found 4 objects"); } { my $s = $dir->new_scope; my $one = $dir->lookup('one'); my $stream = $dir->grep(sub { 1 }); is_deeply([sort map { $_->num } $stream->all],[0,1,2,3,4], "found all objects"); lives_ok { $dir->delete($one) } "can delete previously live objects"; is_deeply([sort map { $_->num } $dir->root_set->all], [0,2,3,4], "really deleted"); } done_testing; README.mkdn100644001750000144 331412237006576 13751 0ustar00doyusers000000000000KiokuDB-0.56[![Build Status](https://travis-ci.org/kiokudb/kiokudb.png?branch=master)](https://travis-ci.org/kiokudb/kiokudb) # RESOURCES * [#kiokudb](irc://irc.perl.org/#kiokudb) & [#moose](irc://irc.perl.org/#moose) on irc.perl.org * [project homepage](http://www.iinteractive.com/kiokudb) * [architectural overview](http://www.iinteractive.com/kiokudb/arch.html) * [KiokuDB::Tutorial](http://search.cpan.org/perldoc?KiokuDB::Tutorial) # DESCRIPTION [KiokuDB](http://www.iinteractive.com/kiokudb) is a [Moose](http://moose.perl.org) based frontend to various data stores: * [Berkeley DB](http://github.com/nothingmuch/kiokudb-backend-bdb) * [SQL databases](http://github.com/nothingmuch/kiokudb-backend-dbi) * [plain files](http://github.com/nothingmuch/kiokudb-backend-files) * [CouchDB](http://github.com/nothingmuch/kiokudb-backend-couchdb) * [Amazon SimpleDB](http://github.com/omega/kiokudb-backend-aws-sdb) Its purpose is to provide persistence for "regular" Perl objects with as little effort as possible, without sacrificing control over how persistence is actually done, especially for harder to serialize objects. KiokuDB is also non-invasive: it does not use ties, `AUTOLOAD`, overloading, proxy objects or any other type of trickery. KiokuDB is meant to solve two related persistence problems: ## Transparent persistence Store arbitrary objects without changing their class definitions or worrying about schema details, and without needing to conform to the limitations of a relational model. ## Interoperability Persisting arbitrary objects in a way that is compatible with existing data/code (for example interoprating with another app using [CouchDB](http://couchdb.apache.org/) with [JSPON](http://jspon.org) semantics). typemap.t100644001750000144 2076012237006576 14274 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Test::Exception; use KiokuDB::TypeMap; use KiokuDB::TypeMap::Entry::Alias; use KiokuDB::TypeMap::Entry::Naive; { package KiokuDB_Test_Foo; use Moose; package KiokuDB_Test_Bar; use Moose; extends qw(KiokuDB_Test_Foo); package KiokuDB_Test_CA; package KiokuDB_Test_CA::Sub; use base qw(KiokuDB_Test_CA); } { my $n = KiokuDB::TypeMap::Entry::Naive->new; isa_ok( $n, "KiokuDB::TypeMap::Entry::Naive" ); does_ok( $n, "KiokuDB::TypeMap::Entry" ); my $t = KiokuDB::TypeMap->new( entries => { KiokuDB_Test_CA => $n, } ); isa_ok( $t, "KiokuDB::TypeMap" ); is( $t->resolve("KiokuDB_Test_CA"), $n, "resolve regular entry" ); is( $t->resolve("KiokuDB_Test_CA::Sub"), undef, "failed resolution of subclass" ); is( $t->resolve("KiokuDB_Test_Foo"), undef, "failed resolution of unspecified class" ); is( $t->resolve("Blarfla"), undef, "failed resolution of random string" ); } { my $n = KiokuDB::TypeMap::Entry::Naive->new; my $a = KiokuDB::TypeMap::Entry::Alias->new( to => "KiokuDB_Test_CA" ); isa_ok( $a, "KiokuDB::TypeMap::Entry::Alias" ); ok( !$a->does("KiokuDB::TypeMap::Entry"), "alias is not a real type entry" ); my $t = KiokuDB::TypeMap->new( entries => { KiokuDB_Test_CA => $n, KiokuDB_Test_Foo => $a, } ); isa_ok( $t, "KiokuDB::TypeMap" ); is( $t->resolve("KiokuDB_Test_CA"), $n, "resolve regular entry" ); is( $t->resolve("KiokuDB_Test_CA::Sub"), undef, "failed resolution of subclass" ); is( $t->resolve("KiokuDB_Test_Foo"), $n, "alias resolution" ); is( $t->resolve("Blarfla"), undef, "failed resolution of random string" ); } { my $n = KiokuDB::TypeMap::Entry::Naive->new; my $t = KiokuDB::TypeMap->new( isa_entries => { KiokuDB_Test_CA => $n, } ); isa_ok( $t, "KiokuDB::TypeMap" ); is( $t->resolve("KiokuDB_Test_CA"), $n, "resolve isa entry for base class" ); is( $t->resolve("KiokuDB_Test_CA::Sub"), $n, "resolve isa entry for subclass" ); is( $t->resolve("KiokuDB_Test_Foo"), undef, "failed resolution" ); } { my $n = KiokuDB::TypeMap::Entry::Naive->new; my $t = KiokuDB::TypeMap->new( isa_entries => { KiokuDB_Test_CA => $n, KiokuDB_Test_Foo => KiokuDB::TypeMap::Entry::Alias->new( to => "KiokuDB_Test_CA" ), }, entries => { 'Unknown::KiokuDB_Test_Foo' => KiokuDB::TypeMap::Entry::Alias->new( to => "KiokuDB_Test_CA" ), }, ); isa_ok( $t, "KiokuDB::TypeMap" ); is( $t->resolve("KiokuDB_Test_CA"), $n, "resolve isa entry for base class" ); is( $t->resolve("KiokuDB_Test_CA::Sub"), $n, "resolve isa entry for subclass" ); is( $t->resolve("KiokuDB_Test_Foo"), $n, "alias resolution of isa entry" ); is( $t->resolve("KiokuDB_Test_Bar"), $n, "alias resolution of isa entry" ); is( $t->resolve("Blarfla"), undef, "failed resolution of random string" ); is( $t->resolve("Unknown::KiokuDB_Test_Foo"), $n, "alias to isa entry" ); } { # typemap inheritence my $ca = KiokuDB::TypeMap::Entry::Naive->new; my $foo = KiokuDB::TypeMap::Entry::Naive->new; my $t1 = KiokuDB::TypeMap->new( includes => [ KiokuDB::TypeMap->new( entries => { 'KiokuDB_Test_CA' => $ca, }, ), ], entries => { 'KiokuDB_Test_Foo' => $foo, } ); my $t2 = KiokuDB::TypeMap->new( entries => { 'KiokuDB_Test_CA' => $ca, }, includes => [ KiokuDB::TypeMap->new( entries => { 'KiokuDB_Test_Foo' => $foo, } ), ], ); my $t3 = KiokuDB::TypeMap->new( includes => [ KiokuDB::TypeMap->new( entries => { 'KiokuDB_Test_CA' => $ca, }, ), KiokuDB::TypeMap->new( entries => { 'KiokuDB_Test_Foo' => $foo, } ), ], ); my @desc = ( "inherit KiokuDB_Test_CA", "inherit KiokuDB_Test_Foo", "inherit both" ); foreach my $t ( $t1, $t2, $t3 ) { my $desc = "(". shift(@desc) . ")"; isa_ok( $t, "KiokuDB::TypeMap" ); is( $t->resolve("KiokuDB_Test_CA"), $ca, "resolve KiokuDB_Test_CA entry $desc" ); is( $t->resolve("KiokuDB_Test_Foo"), $foo, "resolve KiokuDB_Test_Foo entry $desc" ); is( $t->resolve("KiokuDB_Test_CA::Sub"), undef, "failed resolution $desc" ); is( $t->resolve("KiokuDB_Test_Bar"), undef, "failed resolution $desc" ); } } { # typemap inheritence of isa types my $ca = KiokuDB::TypeMap::Entry::Naive->new; my $foo = KiokuDB::TypeMap::Entry::Naive->new; my $t1 = KiokuDB::TypeMap->new( includes => [ KiokuDB::TypeMap->new( isa_entries => { 'KiokuDB_Test_CA' => $ca, }, ), ], isa_entries => { 'KiokuDB_Test_Foo' => $foo, } ); my $t2 = KiokuDB::TypeMap->new( isa_entries => { 'KiokuDB_Test_CA' => $ca, }, includes => [ KiokuDB::TypeMap->new( isa_entries => { 'KiokuDB_Test_Foo' => $foo, } ), ], ); my $t3 = KiokuDB::TypeMap->new( includes => [ KiokuDB::TypeMap->new( isa_entries => { 'KiokuDB_Test_CA' => $ca, }, ), KiokuDB::TypeMap->new( isa_entries => { 'KiokuDB_Test_Foo' => $foo, } ), ], ); my @desc = ( "inherit KiokuDB_Test_CA", "inherit KiokuDB_Test_Foo", "inherit both" ); foreach my $t ( $t1, $t2, $t3 ) { my $desc = "(". shift(@desc) . ")"; isa_ok( $t, "KiokuDB::TypeMap" ); is_deeply( [ sort @{ $t->all_isa_entry_classes } ], [ qw(KiokuDB_Test_CA KiokuDB_Test_Foo) ], "isa entry classes" ); is( $t->resolve("KiokuDB_Test_CA"), $ca, "resolve KiokuDB_Test_CA entry $desc" ); is( $t->resolve("KiokuDB_Test_Foo"), $foo, "resolve KiokuDB_Test_Foo entry $desc" ); is( $t->resolve("KiokuDB_Test_CA::Sub"), $ca, "resolve KiokuDB_Test_CA entry for subclass $desc" ); is( $t->resolve("KiokuDB_Test_Bar"), $foo, "resolve KiokuDB_Test_Foo entry for subclass $desc" ); } } { # typemap conflicts my $ca = KiokuDB::TypeMap::Entry::Naive->new; throws_ok { KiokuDB::TypeMap->new( entries => { 'KiokuDB_Test_CA' => $ca, }, isa_entries => { 'KiokuDB_Test_CA' => $ca, } ); } qr/\bKiokuDB_Test_CA\b/, "regular conflicting with isa entry"; } { # typemap inheritence conflicts my $ca = KiokuDB::TypeMap::Entry::Naive->new; throws_ok { KiokuDB::TypeMap->new( includes => [ KiokuDB::TypeMap->new( entries => { 'KiokuDB_Test_CA' => $ca, }, ), KiokuDB::TypeMap->new( entries => { 'KiokuDB_Test_CA' => $ca, } ), ], ); } qr/\bKiokuDB_Test_CA\b/, "regular entry conflict"; throws_ok { KiokuDB::TypeMap->new( includes => [ KiokuDB::TypeMap->new( isa_entries => { 'KiokuDB_Test_CA' => $ca, }, ), KiokuDB::TypeMap->new( isa_entries => { 'KiokuDB_Test_CA' => $ca, } ), ], ); } qr/\bKiokuDB_Test_CA\b/, "isa entry conflict"; throws_ok { KiokuDB::TypeMap->new( includes => [ KiokuDB::TypeMap->new( isa_entries => { 'KiokuDB_Test_CA' => $ca, }, ), KiokuDB::TypeMap->new( entries => { 'KiokuDB_Test_CA' => $ca, } ), ], ); } qr/\bKiokuDB_Test_CA\b/, "mixed entry conflict"; } done_testing; scaling.t100644001750000144 323112237006576 14207 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use KiokuDB; use KiokuDB::Test::Fixture::ObjectGraph; use Set::Object qw(set); use Data::Stream::Bulk::Callback; { package KiokuDB::Backend::Hash::Frugal; use Moose; extends qw(KiokuDB::Backend::Hash); override all_entries => sub { my $self = shift; my @entries = super()->all; Data::Stream::Bulk::Callback->new( callback => sub { if ( @entries ) { return [ shift @entries ]; } else { return; } }, ); } } my $f = KiokuDB::Test::Fixture::ObjectGraph->new; my $dir = KiokuDB->new( backend => KiokuDB::Backend::Hash::Frugal->new, ); { my $s = $dir->new_scope; $dir->insert( @{ ($f->create)[0] } ); } my $count = do { my $s = $dir->new_scope; scalar $dir->all_objects->all; }; is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" ); is( $count, 22, "number of objects in DB" ); { my $s = $dir->new_scope; my $stream = $dir->all_objects; is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" ); while ( my $block = $stream->next ) { is( scalar(@$block), 1, "one object loaded" ); my $l = set($dir->live_objects->live_objects); ok( $l->includes($block->[0]), "live objects includes object" ); cmp_ok( $l->size, ">=", 1, "at least one live object " . $l->size ); cmp_ok( $l->size, "<", $count, "less than the total number of objects" ); } is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" ); } done_testing; Makefile.PL100644001750000144 1071312237006576 14134 0ustar00doyusers000000000000KiokuDB-0.56 use strict; use warnings; use ExtUtils::MakeMaker 6.30; my %WriteMakefileArgs = ( "ABSTRACT" => "Object Graph storage engine", "AUTHOR" => "Yuval Kogman ", "BUILD_REQUIRES" => {}, "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => "6.30" }, "DISTNAME" => "KiokuDB", "EXE_FILES" => [ "bin/kioku" ], "LICENSE" => "perl", "NAME" => "KiokuDB", "PREREQ_PM" => { "B" => 0, "B::Deparse" => 0, "Cache::Ref" => "0.02", "Carp" => 0, "Data::Stream::Bulk" => "0.08", "Data::Stream::Bulk::Util" => 0, "Data::Swap" => 0, "Data::UUID" => "1.203", "Data::Visitor" => "0.24", "Digest::SHA" => 0, "Encode" => 0, "Hash::Util::FieldHash::Compat" => 0, "IO::Handle" => 0, "JSON" => "2.12", "JSON::XS" => "2.231", "List::Util" => 0, "Module::Pluggable::Object" => 0, "Moose" => "2.0000", "Moose::Exporter" => 0, "Moose::Role" => 0, "Moose::Util" => 0, "Moose::Util::MetaRole" => 0, "Moose::Util::TypeConstraints" => 0, "MooseX::Clone" => "0.04", "MooseX::Clone::Meta::Attribute::Trait::NoClone" => 0, "MooseX::Role::Parameterized" => "0.10", "MooseX::YAML" => "0.04", "POSIX" => 0, "PadWalker" => "1.9", "Path::Class" => 0, "Scalar::Util" => 0, "Scope::Guard" => 0, "Search::GIN::Driver" => 0, "Search::GIN::Extract" => 0, "Search::GIN::Query::Class" => "0.03", "Set::Object" => "1.26", "Storable" => 0, "Sub::Exporter" => 0, "Symbol" => 0, "Test::Exception" => 0, "Test::Moose" => 0, "Test::More" => "0.88", "Throwable" => 0, "Tie::RefHash" => 0, "Tie::ToObject" => 0, "Try::Tiny" => 0, "YAML::XS" => "0.30", "constant" => 0, "namespace::clean" => "0.08", "overload" => 0, "strict" => 0, "utf8" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "Cache::Ref::CART" => 0, "Cache::Ref::CLOCK" => 0, "Data::Dumper" => 0, "Data::Stream::Bulk::Callback" => 0, "File::Spec" => 0, "IO::Handle" => 0, "IPC::Open3" => 0, "Search::GIN::Driver::Hash" => 0, "Search::GIN::Extract::Class" => 0, "Search::GIN::Extract::Delegate" => 0, "Test::More" => "0.88", "base" => 0, "if" => 0 }, "VERSION" => "0.56", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "B" => 0, "B::Deparse" => 0, "Cache::Ref" => "0.02", "Cache::Ref::CART" => 0, "Cache::Ref::CLOCK" => 0, "Carp" => 0, "Data::Dumper" => 0, "Data::Stream::Bulk" => "0.08", "Data::Stream::Bulk::Callback" => 0, "Data::Stream::Bulk::Util" => 0, "Data::Swap" => 0, "Data::UUID" => "1.203", "Data::Visitor" => "0.24", "Digest::SHA" => 0, "Encode" => 0, "File::Spec" => 0, "Hash::Util::FieldHash::Compat" => 0, "IO::Handle" => 0, "IPC::Open3" => 0, "JSON" => "2.12", "JSON::XS" => "2.231", "List::Util" => 0, "Module::Pluggable::Object" => 0, "Moose" => "2.0000", "Moose::Exporter" => 0, "Moose::Role" => 0, "Moose::Util" => 0, "Moose::Util::MetaRole" => 0, "Moose::Util::TypeConstraints" => 0, "MooseX::Clone" => "0.04", "MooseX::Clone::Meta::Attribute::Trait::NoClone" => 0, "MooseX::Role::Parameterized" => "0.10", "MooseX::YAML" => "0.04", "POSIX" => 0, "PadWalker" => "1.9", "Path::Class" => 0, "Scalar::Util" => 0, "Scope::Guard" => 0, "Search::GIN::Driver" => 0, "Search::GIN::Driver::Hash" => 0, "Search::GIN::Extract" => 0, "Search::GIN::Extract::Class" => 0, "Search::GIN::Extract::Delegate" => 0, "Search::GIN::Query::Class" => "0.03", "Set::Object" => "1.26", "Storable" => 0, "Sub::Exporter" => 0, "Symbol" => 0, "Test::Exception" => 0, "Test::Moose" => 0, "Test::More" => "0.88", "Throwable" => 0, "Tie::RefHash" => 0, "Tie::ToObject" => 0, "Try::Tiny" => 0, "YAML::XS" => "0.30", "base" => 0, "constant" => 0, "if" => 0, "namespace::clean" => "0.08", "overload" => 0, "strict" => 0, "utf8" => 0, "warnings" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; if ($] < 5.010) { $WriteMakefileArgs{PREREQ_PM} = { %{ $WriteMakefileArgs{PREREQ_PM} }, "Variable::Magic" => "0.24", "Tie::RefHash::Weak" => "0.09", }; } WriteMakefile(%WriteMakefileArgs); coderefs.t100644001750000144 2516012237006576 14406 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Exception; my $preloaded; BEGIN { $preloaded = !!$INC{'KiokuDB/Test/Employee.pm'} } use KiokuDB; my $dir = KiokuDB->connect("hash"); { package KiokuDB_Test_WithCodeRef; use KiokuDB::Class; has coderef => ( is => 'rw', isa => 'CodeRef', required => 1, ); sub apply { shift->coderef->(@_) } } sub obj (&) { KiokuDB_Test_WithCodeRef->new( coderef => $_[0] ) } { my $id; { my $obj = obj { 4 + $_[0] }; my $s = $dir->new_scope; lives_ok { $id = $dir->store($obj) } "store object with coderef"; } $dir->live_objects->clear; # non closure coderefs live forever is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" ); { my $s = $dir->new_scope; $id and my $obj = $dir->lookup($id); isa_ok $obj, 'KiokuDB_Test_WithCodeRef'; is eval { $obj->coderef->(38) }, 42, "apply coderef", } } { $dir->live_objects->clear; { my $s = $dir->new_scope; my ( $x, @x, %x ); # these tests cause leaks in 5.8 if they use Test::Exception eval { $dir->store( sv => sub { $x++ } ) }; ok( !$@, "SV" ); eval { $dir->store( av => sub { $x[0]++ } ) }; ok( !$@, "AV" ); eval { $dir->store( hv => sub { $x{foo}++ } ) }; ok( !$@, "HV" ); eval { $dir->store( all => sub { $x++; $x[0]++; $x{foo}++ } ) }; ok( !$@, "SV, AV, HV" ); } { foreach my $id ( qw(sv av hv all) ) { is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" ); my $s = $dir->new_scope; my $sub; lives_ok { $sub = $dir->lookup($id) } "load closure $id"; ok( $sub, "thawed closure" ); is( eval { $sub->() }, 0, "first invocation" ); is( eval { $sub->() }, 1, "second invocation" ); } } } { $dir->live_objects->clear; sub generate_counter { my $i = shift; return obj { return ++$i; } } my $id; { my $obj = generate_counter(0); # kick the counter once with first object. is( $obj->coderef->(), 1, "apply closure before storing" ); my $s = $dir->new_scope; lives_ok { $id = $dir->store($obj) } "store object with closure"; } is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" ); { my $s = $dir->new_scope; $id and my $obj = $dir->lookup($id); is eval { $obj->apply }, 2, "closure variable thawed"; } is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" ); { my $s = $dir->new_scope; $id and my $obj = $dir->lookup($id); is eval { $obj->apply }, 2, "closure variable update not stored without call to update"; ok( $dir->object_to_id($obj->coderef), "code ref has an ID" ); eval { $dir->deep_update($obj->coderef) }; } is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" ); { my $s = $dir->new_scope; $id and my $obj = $dir->lookup($id); is eval { $obj->apply }, 3, "closure variable updated"; } } sub closure_pair { my $i = shift; return ( sub { return ++$i; }, sub { $i }, ); } { my @ids; { my ( $count, $peek ) = map { &obj($_) } closure_pair(0); is( $peek->apply, 0, "peek" ); $count->apply; is( $peek->apply, 1, "peek" ); my $s = $dir->new_scope; lives_ok { @ids = $dir->store( $count, $peek ) } "store pair of closures"; } is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" ); { my $s = $dir->new_scope; my ( $count, $peek ) = $dir->lookup(@ids); ok( $count, "count thawed" ); ok( $peek, "peek thawed" ); is eval { $peek->apply }, 1, "closure sharing";; is eval { $count->apply }, 2, "closure sharing"; is eval { $peek->apply }, 2, "closure sharing thawed"; } } { my @ids; { my ( $count, $peek ) = closure_pair(0); is( $peek->(), 0, "peek" ); $count->(); is( $peek->(), 1, "peek" ); my $s = $dir->new_scope; lives_ok { @ids = $dir->store( $count, $peek ) } "store pair of closures"; } is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" ); { my $s = $dir->new_scope; my ( $count, $peek ) = $dir->lookup(@ids); ok( $count, "count thawed" ); ok( $peek, "peek thawed" ); is eval { $peek->() }, 1, "closure sharing";; is eval { $count->() }, 2, "closure sharing"; is eval { $peek->() }, 2, "closure sharing thawed"; $dir->deep_update($count); } is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" ); { my $s = $dir->new_scope; my ( $count, $peek ) = $dir->lookup(@ids); is eval { $peek->() }, 2, "closure sharing thawed after deep update from other closure"; } } { my @ids; { my ( $count, $peek ) = closure_pair(0); is( $peek->(), 0, "peek" ); $count->(); is( $peek->(), 1, "peek" ); my $s = $dir->new_scope; lives_ok { $ids[0] = $dir->store($count) } "store count closure"; lives_ok { $ids[1] = $dir->store($peek ) } "store peek closures"; } is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" ); { my $s = $dir->new_scope; my ( $count, $peek ) = $dir->lookup(@ids); ok( $count, "count thawed" ); ok( $peek, "peek thawed" ); is eval { $peek->() }, 1, "closure sharing";; is eval { $count->() }, 2, "closure sharing"; is eval { $peek->() }, 2, "closure sharing thawed"; $dir->deep_update($count); } is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" ); { my $s = $dir->new_scope; my ( $count, $peek ) = $dir->lookup(@ids); is eval { $peek->() }, 2, "closure sharing thawed after deep update from other closure"; } } { my @ids; { my ( $count, $peek ) = closure_pair(0); is( $peek->(), 0, "peek" ); $count->(); is( $peek->(), 1, "peek" ); my $s = $dir->new_scope; lives_ok { @ids = $dir->store( $count, $peek ) } "store pair of closures"; } is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" ); { my $s = $dir->new_scope; my $peek = $dir->lookup($ids[1]); ok( $peek, "peek thawed" ); is eval { $peek->() }, 1, "closure sharing";; } { my $s = $dir->new_scope; my $count = $dir->lookup($ids[0]); ok( $count, "count thawed" ); is eval { $count->() }, 2, "closure sharing"; $dir->deep_update($count); } { my $s = $dir->new_scope; my $peek = $dir->lookup($ids[1]); ok( $peek, "peek thawed" ); is eval { $peek->() }, 2, "closure sharing after disjoint update"; } } { my @ids; { my ( $count, $peek ) = closure_pair(0); is( $peek->(), 0, "peek" ); $count->(); is( $peek->(), 1, "peek" ); my $s = $dir->new_scope; lives_ok { @ids = $dir->store( $count, $peek ) } "store pair of closures"; } is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" ); { my $s = $dir->new_scope; my $peek = $dir->lookup($ids[1]); ok( $peek, "peek thawed" ); is eval { $peek->() }, 1, "closure sharing";; my $count = $dir->lookup($ids[0]); ok( $count, "count thawed" ); is eval { $count->() }, 2, "closure sharing"; is eval { $peek->() }, 2, "closure sharing after disjoint update (both values live)"; } } { my ( $set_id, $get_id ); { my %names; ( $set_id, $get_id ) = $dir->txn_do( scope => 1, body => sub { $dir->insert( sub { $names{$_[0]} = $_[1] }, sub { $names{$_[0]} } ); }); is_deeply( [ $dir->live_objects->live_objects ], [ \%names ], "names is live" ); { my $s = $dir->new_scope; my $set = $dir->lookup($set_id); ok( $set, "got set" ); $set->( foo => 42 ); is_deeply( \%names, { foo => 42 }, "still live closure variable updated" ); $dir->update(\%names); } } { my $s = $dir->new_scope; my $get = $dir->lookup($get_id); is( $get->("foo"), 42, "names updated" ); } } sub blah { 42 } { my $blah_id= $dir->txn_do( scope => 1, body => sub { $dir->insert(\&blah) }); $dir->live_objects->clear; { my $s = $dir->new_scope; my $blah = $dir->lookup($blah_id); ok( $blah, "got named sub" ); is( $blah->(), 42, "correct value" ); is( $blah, \&blah, "right refaddr" ); } $dir->live_objects->clear; } { $dir->txn_do( scope => 1, body => sub { $dir->backend->insert( KiokuDB::Entry->new( id => "lalala", data => { package => "KiokuDB::Test::Employee", name => "lalala", }, class => "CODE", ), ); }); { my $s = $dir->new_scope; SKIP: { skip "doesn't work when preloading", 1 if $preloaded; ok( !exists($INC{"KiokuDB/Test/Employee.pm"}), "Employee.pm not loaded" ); } my $sub = $dir->lookup("lalala"); ok( $sub, "loaded sub" ); ok( $INC{"KiokuDB/Test/Employee.pm"}, "Employee.pm loaded" ); is( $sub, \&KiokuDB::Test::Employee::lalala, "right refaddr" ); is( $sub->(), 333, "right value" ); } $dir->live_objects->clear; } { my $sub_id = $dir->txn_do( scope => 1, body => sub { $dir->insert(\&KiokuDB::Test::Employee::company); }); my $entry = $dir->live_objects->id_to_entry($sub_id); ok( !exists($entry->data->{file}), "Moose accessor detected" ); is_deeply( $entry->data, { package => "KiokuDB::Test::Employee", name => "company" }, "FQ reference only" ); $dir->live_objects->clear; } { my $sub_id = $dir->txn_do( scope => 1, body => sub { $dir->insert(\&Scalar::Util::weaken); }); my $entry = $dir->live_objects->id_to_entry($sub_id); ok( !exists($entry->data->{file}), "XSUB detected" ); is_deeply( $entry->data, { package => "Scalar::Util", name => "weaken" }, "FQ reference only" ); $dir->live_objects->clear; } done_testing; gc_naive.t100644001750000144 1026712237006576 14371 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use KiokuDB::GC::Naive; use KiokuDB::Entry; use KiokuDB::Reference; use KiokuDB::Backend::Hash; use Data::Stream::Bulk::Util qw(bulk); { my $b = KiokuDB::Backend::Hash->new; my @entries = KiokuDB::Entry->new( data => [ "foo" ], id => "bar" ); $b->insert(@entries); my $l = KiokuDB::GC::Naive->new( backend => $b ); is( $l->garbage->size, 1, "one garbage ID" ); is_deeply( [ $l->garbage->members ], [ "bar" ], "garbage ID is 'bar'" ); is( $l->root->size, 0, "no root IDs" ); } { my $b = KiokuDB::Backend::Hash->new; my @entries = KiokuDB::Entry->new( data => [ KiokuDB::Reference->new( id => "bar" ) ], id => "bar" ); $b->insert(@entries); my $l = KiokuDB::GC::Naive->new( backend => $b ); is( $l->garbage->size, 1, "one garbage ID (cyclic)" ); is_deeply( [ $l->garbage->members ], [ "bar" ], "garbage ID is 'bar'" ); is( $l->root->size, 0, "no root IDs" ); } { my $b = KiokuDB::Backend::Hash->new; my @entries = ( KiokuDB::Entry->new( data => [ KiokuDB::Reference->new( id => "gorch" ) ], id => "bar" ), KiokuDB::Entry->new( data => "foo", id => "gorch", root => 1 ), ); $b->insert(@entries); my $l = KiokuDB::GC::Naive->new( backend => $b ); is( $l->garbage->size, 1, "one garbage ID)" ); is_deeply( [ $l->garbage->members ], [ "bar" ], "garbage ID is 'bar'" ); is( $l->root->size, 1, "one root ID" ); is_deeply( [ $l->root->members ], [ "gorch" ], "referenced ID is 'gorch'" ); } { my @entries = ( KiokuDB::Entry->new( data => [ KiokuDB::Reference->new( id => "foo" ) ], id => "bar" ), KiokuDB::Entry->new( data => [ KiokuDB::Reference->new( id => "bar" ) ], id => "foo" ), KiokuDB::Entry->new( data => [ KiokuDB::Reference->new( id => "bar" ) ], id => "parent", root => 1, ), ); my $b = KiokuDB::Backend::Hash->new; $b->insert(@entries); foreach my $entries ( \@entries, [ reverse @entries ] ) { my $l = KiokuDB::GC::Naive->new( backend => $b, entries => bulk(@$entries) ); is( $l->garbage->size, 0, "no garbage entries" ); is( $l->seen->size, 3, "three seen IDs" ); is_deeply( [ sort $l->seen->members ], [ sort qw(foo bar parent) ], "seen IDs are 'foo', 'bar' and 'parent'" ); } } { my @entries = ( KiokuDB::Entry->new( data => [ KiokuDB::Reference->new( id => "foo" ) ], id => "bar" ), KiokuDB::Entry->new( data => [ KiokuDB::Reference->new( id => "bar" ) ], id => "foo" ), KiokuDB::Entry->new( data => [ ], id => "parent", root => 1, ), ); my $b = KiokuDB::Backend::Hash->new; $b->insert(@entries); foreach my $entries ( \@entries, [ reverse @entries ] ) { my $l = KiokuDB::GC::Naive->new( backend => $b, entries => bulk(@$entries) ); is( $l->garbage->size, 2, "two garbage entries" ); is_deeply( [ sort $l->garbage->members ], [ sort "foo", "bar" ], "missing ID is 'gorch'" ); is( $l->seen->size, 1, "two seen ID" ); is_deeply( [ sort $l->seen->members ], ['parent'], "seen ID is 'parent'" ); } } { my @entries = ( ( map { KiokuDB::Entry->new( data => [ KiokuDB::Reference->new( id => "foo" ), ], id => $_ ) } 1 .. 1000 ), KiokuDB::Entry->new( data => [ map { KiokuDB::Reference->new( id => $_ ) } 1 .. 1000 ], id => "parent", root => 1, ), KiokuDB::Entry->new( id => "foo", data => [], ), ); my $b = KiokuDB::Backend::Hash->new; $b->insert(@entries); foreach my $entries ( \@entries, [ reverse @entries ] ) { my $l = KiokuDB::GC::Naive->new( backend => $b, entries => bulk(@$entries) ); is( $l->garbage->size, 0, "no garbage entries" ); is( $l->seen->size, 1002, "seen IDs" ); is_deeply( [ sort $l->seen->members ], [ sort qw(foo parent), 1 .. 1000 ], "seen IDs are 'foo', 'bar' and 'parent'" ); } } done_testing; collapser.t100644001750000144 6064712237006576 14611 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Exception; use Try::Tiny; use Scalar::Util qw(weaken isweak); use Storable qw(dclone); use KiokuDB::Entry; use KiokuDB::Collapser; use KiokuDB::LiveObjects; use KiokuDB::TypeMap; use KiokuDB::TypeMap::Resolver; use KiokuDB::TypeMap::Entry::MOP; use KiokuDB::TypeMap::Entry::Callback; use KiokuDB::TypeMap::Entry::Ref; use KiokuDB::Backend::Hash; sub KiokuDB::Entry::BUILD { shift->root }; # force building of root for is_deeply $_->make_mutable, $_->make_immutable for KiokuDB::Entry->meta; # recreate new use Tie::RefHash; sub unknown_ok (&@) { my ( $block, @objects ) = @_; local $@ = ""; try { $block->(); fail("should have died"); } catch { is_deeply( $_, KiokuDB::Error::UnknownObjects->new( objects => \@objects), "correct error" ); }; } { package KiokuDB_Test_Foo; use Moose; # check reserved field clashes has id => ( is => "rw" ); has bar => ( is => "rw" ); has zot => ( is => "rw" ); has moof => ( is => "rw" ); __PACKAGE__->meta->make_immutable; package KiokuDB_Test_Bar; use Moose; has id => ( is => "rw", isa => "Int" ); has blah => ( is => "rw" ); package KiokuDB_Test_Baz; use Moose; with qw(KiokuDB::Role::ID); has id => ( isa => "Str", is => "ro", required => 1 ); sub kiokudb_object_id { shift->id } package KiokuDB_Test_Quxx; use Moose; extends qw(KiokuDB_Test_Baz); with qw(KiokuDB::Role::ID::Content); } { my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => my $lo = KiokuDB::LiveObjects->new, typemap_resolver => KiokuDB::TypeMap::Resolver->new( typemap => KiokuDB::TypeMap->new( entries => { ARRAY => KiokuDB::TypeMap::Entry::Ref->new, HASH => KiokuDB::TypeMap::Entry::Ref->new, }, ), ), ); my $s = $lo->new_scope; my $foo = KiokuDB_Test_Foo->new( id => "oink", zot => "zot", bar => KiokuDB_Test_Bar->new( id => 3, blah => { oink => 3 }, ), ); unknown_ok { $v->collapse( objects => [ $foo ], only_known => 1 ) } $foo; { my $obj = KiokuDB_Test_Foo->new( bar => $foo->bar ); $v->live_objects->insert( foo => $obj ); unknown_ok { $v->collapse( objects => [ $obj ], only_known => 1 ) } $foo->bar; } $v->live_objects->insert( bar => $foo->bar ); unknown_ok { $v->collapse( objects => [ $foo ], only_known => 1 ) } $foo; lives_ok { my ( $buffer ) = $v->collapse( objects => [ $foo->bar ], only_known => 1 ); isa_ok( $buffer, "KiokuDB::Collapser::Buffer" ); is( scalar(values %{ $buffer->_entries }), 1, "one entry for known obj collapse" ); }; my ( $buffer, $id, @rest ) = $v->collapse( objects => [ $foo ] ); ok( $id, "got an id" ); is( scalar(@rest), 0, "no other return values" ); my @entries = sort { $a->id eq $id ? -1 : 1 } $buffer->entries; my $other_id = $entries[1]->id; is( scalar(@entries), 2, "two entries" ); is( $entries[0]->class, 'KiokuDB_Test_Foo', "class" ); is_deeply( $entries[0]->data, { bar => KiokuDB::Reference->new( id => $other_id ), id => "oink", zot => "zot", }, "KiokuDB_Test_Foo object", ); is_deeply( $entries[1]->data, { id => 3, blah => { oink => 3 }, }, "KiokuDB_Test_Bar object", ); } { my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => my $lo = KiokuDB::LiveObjects->new, typemap_resolver => KiokuDB::TypeMap::Resolver->new( typemap => KiokuDB::TypeMap->new( entries => { ARRAY => KiokuDB::TypeMap::Entry::Ref->new, HASH => KiokuDB::TypeMap::Entry::Ref->new, }, ), ), ); my $s = $lo->new_scope; my $x = { name => "shared" }; # shared values must be assigned a UID my $bar = KiokuDB_Test_Bar->new( id => 5, blah => [ $x, $x ], ); my ( $buffer, $id ) = $v->collapse( objects => [ $bar ] ); my @entries = sort { $a->id eq $id ? -1 : 1 } $buffer->entries; is( scalar(@entries), 2, "two entries" ); my $other_id = $entries[1]->id; is_deeply( $entries[0]->data, { id => 5, blah => [ KiokuDB::Reference->new( id => $other_id ), KiokuDB::Reference->new( id => $other_id ), ], }, "parent object", ); is_deeply( $entries[1]->data, { name => "shared", }, "shared ref", ); } { # circular ref my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => my $lo = KiokuDB::LiveObjects->new, typemap_resolver => KiokuDB::TypeMap::Resolver->new( typemap => KiokuDB::TypeMap->new( entries => { ARRAY => KiokuDB::TypeMap::Entry::Ref->new, HASH => KiokuDB::TypeMap::Entry::Ref->new, }, ), ), ); my $s = $lo->new_scope; my $foo = KiokuDB_Test_Foo->new( id => "oink", zot => "zot", bar => KiokuDB_Test_Bar->new( id => 3, ), ); $foo->bar->blah($foo); my ( $buffer, $id ) = $v->collapse( objects => [ $foo ] ); my @entries = sort { $a->id eq $id ? -1 : 1 } $buffer->entries; is( scalar(@entries), 2, "two entries" ); my $other_id = $entries[1]->id; is( $entries[0]->class, 'KiokuDB_Test_Foo', "class" ); is_deeply( $entries[0]->data, { bar => KiokuDB::Reference->new( id => $other_id ), id => "oink", zot => "zot", }, "KiokuDB_Test_Foo object", ); is_deeply( $entries[1]->data, { id => 3, blah => KiokuDB::Reference->new( id => $id ), }, "KiokuDB_Test_Bar object", ); } { my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => my $lo = KiokuDB::LiveObjects->new, typemap_resolver => KiokuDB::TypeMap::Resolver->new( typemap => KiokuDB::TypeMap->new( entries => { ARRAY => KiokuDB::TypeMap::Entry::Ref->new, HASH => KiokuDB::TypeMap::Entry::Ref->new, }, ), ), ); my $s = $lo->new_scope; my $x = { name => "shared" }; # shared values must be assigned a UID my $bar = KiokuDB_Test_Bar->new( id => 5, blah => [ $x, $x ], ); weaken($bar->blah->[0]); my ( $buffer, $id ) = $v->collapse( objects => [ $bar ] ); my @entries = sort { $a->id eq $id ? -1 : 1 } $buffer->entries; is( scalar(@entries), 2, "two entries" ); my $other_id = $entries[1]->id; is_deeply( $entries[0]->data, { id => 5, blah => [ KiokuDB::Reference->new( id => $other_id, is_weak => 1 ), KiokuDB::Reference->new( id => $other_id ), ], }, "parent object", ); is_deeply( $entries[1]->data, { name => "shared", }, "shared ref", ); } { my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => my $lo = KiokuDB::LiveObjects->new, typemap_resolver => KiokuDB::TypeMap::Resolver->new( typemap => KiokuDB::TypeMap->new( entries => { ARRAY => KiokuDB::TypeMap::Entry::Ref->new, HASH => KiokuDB::TypeMap::Entry::Ref->new, }, ), ), ); my $s = $lo->new_scope; my $x = { name => "shared" }; # shared values must be assigned a UID my $bar = KiokuDB_Test_Bar->new( id => 5, blah => [ $x, $x ], ); # second one is weak weaken($bar->blah->[1]); my ( $buffer, $id ) = $v->collapse( objects => [ $bar ] ); my @entries = sort { $a->id eq $id ? -1 : 1 } $buffer->entries; is( scalar(@entries), 2, "two entries" ); my $other_id = $entries[1]->id; is_deeply( $entries[0]->data, { id => 5, blah => [ KiokuDB::Reference->new( id => $other_id ), KiokuDB::Reference->new( id => $other_id, is_weak => 1 ), ], }, "parent object", ); is_deeply( $entries[1]->data, { name => "shared", }, "shared ref", ); } { my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => my $lo = KiokuDB::LiveObjects->new, typemap_resolver => KiokuDB::TypeMap::Resolver->new( typemap => KiokuDB::TypeMap->new( entries => { ARRAY => KiokuDB::TypeMap::Entry::Ref->new, HASH => KiokuDB::TypeMap::Entry::Ref->new, }, ), ), ); my $s = $lo->new_scope; my $data = { }; $data->{self} = $data; my $obj = KiokuDB_Test_Foo->new( bar => $data ); $v->live_objects->insert( obj => $obj ); unknown_ok { $v->collapse( objects => [ $obj ], only_known => 1 ) } $data; } { my $obj = KiokuDB_Test_Foo->new( bar => { foo => "hello" } ); { my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => my $lo = KiokuDB::LiveObjects->new, compact => 0, typemap_resolver => KiokuDB::TypeMap::Resolver->new( typemap => KiokuDB::TypeMap->new( entries => { ARRAY => KiokuDB::TypeMap::Entry::Ref->new, HASH => KiokuDB::TypeMap::Entry::Ref->new, }, ), ), ); my $s = $lo->new_scope; my ( $buffer ) = $v->collapse( objects => [ $obj ] ); is( scalar(keys %{ $buffer->_entries }), 2, "two entries" ); } { my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => my $lo = KiokuDB::LiveObjects->new, compact => 1, typemap_resolver => KiokuDB::TypeMap::Resolver->new( typemap => KiokuDB::TypeMap->new( entries => { ARRAY => KiokuDB::TypeMap::Entry::Ref->new, HASH => KiokuDB::TypeMap::Entry::Ref->new, }, ), ), ); my $s = $lo->new_scope; my ( $buffer ) = $v->collapse( objects => [ $obj ] ); is( scalar(keys %{ $buffer->_entries }), 1, "one entry with compacter" ); } } { my $obj = KiokuDB_Test_Foo->new( foo => "one", bar => KiokuDB_Test_Foo->new( foo => "two" ) ); { my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => my $lo = KiokuDB::LiveObjects->new, typemap_resolver => KiokuDB::TypeMap::Resolver->new( typemap => KiokuDB::TypeMap->new( entries => { ARRAY => KiokuDB::TypeMap::Entry::Ref->new, HASH => KiokuDB::TypeMap::Entry::Ref->new, }, ), ), ); my $s = $lo->new_scope; { my ( $buffer, @ids ) = $v->collapse( objects => [ $obj ] ); is( scalar(keys %{ $buffer->_entries }), 2, "two entries for deep collapse" ); is( scalar(@ids), 1, "one root set ID" ); $buffer->update_entries( in_storage => 1 ); } { my ( $buffer, @ids ) = $v->collapse( objects => [ $obj ], shallow => 1 ); is( scalar(keys %{ $buffer->_entries }), 1, "one entry for shallow collapse" ); is( scalar(@ids), 1, "one root set ID" ); $buffer->update_entries( in_storage => 1 ); } } } { my $obj = KiokuDB_Test_Foo->new( zot => "one", bar => KiokuDB_Test_Bar->new( blah => "two" ) ); { my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => my $lo = KiokuDB::LiveObjects->new, typemap_resolver => KiokuDB::TypeMap::Resolver->new( typemap => KiokuDB::TypeMap->new( entries => { KiokuDB_Test_Bar => KiokuDB::TypeMap::Entry::MOP->new( intrinsic => 1, ), ARRAY => KiokuDB::TypeMap::Entry::Ref->new, HASH => KiokuDB::TypeMap::Entry::Ref->new, }, ), ), ); my $s = $lo->new_scope; my ( $buffer, @ids ) = $v->collapse( objects => [ $obj ] ); my $entries = $buffer->_entries; is( scalar(keys %$entries), 1, "one entries for deep collapse with intrinsic value" ); is( scalar(@ids), 1, "one root set ID" ); is_deeply( $entries->{$ids[0]}->data, { zot => "one", bar => KiokuDB::Entry->new( class => "KiokuDB_Test_Bar", data => { blah => "two" }, object => $obj->bar, ), }, "intrinsic entry data", ); } } { my $bar = KiokuDB_Test_Bar->new( blah => "two" ); my $obj = KiokuDB_Test_Foo->new( zot => "one", bar => $bar, zot => $bar, ); { my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => my $lo = KiokuDB::LiveObjects->new, typemap_resolver => KiokuDB::TypeMap::Resolver->new( typemap => KiokuDB::TypeMap->new( entries => { KiokuDB_Test_Bar => KiokuDB::TypeMap::Entry::MOP->new( intrinsic => 1, ), ARRAY => KiokuDB::TypeMap::Entry::Ref->new, HASH => KiokuDB::TypeMap::Entry::Ref->new, }, ), ), ); my $s = $lo->new_scope; my ( $buffer, @ids ) = $v->collapse( objects => [ $obj ] ); my $entries = $buffer->_entries; is( scalar(keys %$entries), 1, "one entries for deep collapse with shared intrinsic value" ); is( scalar(@ids), 1, "one root set ID" ); is_deeply( $entries->{$ids[0]}->data, { zot => "one", bar => KiokuDB::Entry->new( class => "KiokuDB_Test_Bar", data => { blah => "two" }, object => $obj->bar, ), zot => KiokuDB::Entry->new( class => "KiokuDB_Test_Bar", data => { blah => "two" }, object => $obj->bar, ), }, "intrinsic entry data", ); } } { tie my %h, 'Tie::RefHash'; $h{KiokuDB_Test_Bar->new( blah => "two" )} = "bar"; my $obj = KiokuDB_Test_Foo->new( bar => \%h, ); { my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => my $lo = KiokuDB::LiveObjects->new, typemap_resolver => KiokuDB::TypeMap::Resolver->new( typemap => KiokuDB::TypeMap->new( entries => { 'Tie::RefHash' => KiokuDB::TypeMap::Entry::Callback->new( intrinsic => 1, collapse => "STORABLE_freeze", expand => sub { my ( $class, @args ) = @_; my $self = bless [], $class; $self->STORABLE_thaw(@args); return $self; } ), ARRAY => KiokuDB::TypeMap::Entry::Ref->new, HASH => KiokuDB::TypeMap::Entry::Ref->new, }, ), ), ); my $s = $lo->new_scope; my ( $buffer, @ids ) = $v->collapse( objects => [ $obj ] ); is( scalar(@ids), 1, "one root set ID" ); my $entries = $buffer->_entries; my $root = delete $entries->{$ids[0]}; my $key = (values %$entries)[0]; my $t = Tie::RefHash->TIEHASH( KiokuDB::Reference->new( id => $key->id ) => "bar" ); is_deeply( dclone($root), KiokuDB::Entry->new( id => $ids[0], class => "KiokuDB_Test_Foo", data => { bar => KiokuDB::Entry->new( tied => "H", data => KiokuDB::Entry->new( class => "Tie::RefHash", data => [ $t->STORABLE_freeze ], ), ), }, ), "intrinsic collapsing of Tie::RefHash", ); } } { tie my %h, 'Tie::RefHash'; $h{KiokuDB_Test_Bar->new( blah => "two" )} = "bar"; my $obj = KiokuDB_Test_Foo->new( bar => \%h, ); { my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => my $lo = KiokuDB::LiveObjects->new, typemap_resolver => KiokuDB::TypeMap::Resolver->new( typemap => KiokuDB::TypeMap->new( entries => { 'Tie::RefHash' => KiokuDB::TypeMap::Entry::Callback->new( collapse => "STORABLE_freeze", expand => "STORABLE_thaw", ), ARRAY => KiokuDB::TypeMap::Entry::Ref->new, HASH => KiokuDB::TypeMap::Entry::Ref->new, }, ), ), ); my $s = $lo->new_scope; my ( $buffer, @ids ) = $v->collapse( objects => [ $obj ] ); is( scalar(@ids), 1, "one root set ID" ); my $entries = $buffer->_entries; my $root = $entries->{$ids[0]}; my $tie = (grep { $_->class eq 'Tie::RefHash' } values %$entries)[0]; is_deeply( dclone($root), KiokuDB::Entry->new( id => $ids[0], class => "KiokuDB_Test_Foo", data => { bar => KiokuDB::Entry->new( tied => "H", data => KiokuDB::Reference->new( id => $tie->id ), ), }, ), "first class collapsing of Tie::RefHash", ); } } { my $bar = KiokuDB_Test_Bar->new( blah => "shared" ); my $foo_1 = KiokuDB_Test_Foo->new( zot => "one", bar => $bar, ); my $foo_2 = KiokuDB_Test_Foo->new( zot => "two", bar => $bar, ); my $foo_3 = KiokuDB_Test_Foo->new( zot => "three", bar => $bar, ); my $foo_4 = KiokuDB_Test_Foo->new( zot => "two", bar => $bar, moof => [ KiokuDB_Test_Bar->new( blah => "yay" ), $bar ], ); my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => my $lo = KiokuDB::LiveObjects->new, typemap_resolver => KiokuDB::TypeMap::Resolver->new( typemap => KiokuDB::TypeMap->new( entries => { ARRAY => KiokuDB::TypeMap::Entry::Ref->new, HASH => KiokuDB::TypeMap::Entry::Ref->new, }, ), ), ); my $s = $lo->new_scope; { my ( $buffer, @ids ) = $v->collapse( objects => [ $bar ], only_in_storage => 1 ); my $entries = $buffer->_entries; is( scalar(keys %$entries), 1, "one entry" ); is( scalar(@ids), 1, "one root set ID" ); is( $entries->{$ids[0]}->class, "KiokuDB_Test_Bar", "class" ); $buffer->update_entries( in_storage => 1 ); } { my ( $buffer, @ids ) = $v->collapse( objects => [ $foo_1 ], only_in_storage => 1 ); my $entries = $buffer->_entries; is( scalar(keys %$entries), 1, "one entry with only_in_storage" ); is( scalar(@ids), 1, "one root set ID" ); is( $entries->{$ids[0]}->class, "KiokuDB_Test_Foo", "class" ); $buffer->update_entries( in_storage => 1 ); } { my ( $buffer, @ids ) = $v->collapse( objects => [ $foo_2 ] ); my $entries = $buffer->_entries; is( scalar(keys %$entries), 2, "two entries" ); is( scalar(@ids), 1, "one root set ID" ); is( $entries->{$ids[0]}->class, "KiokuDB_Test_Foo", "class" ); $buffer->update_entries( in_storage => 1 ); } { $lo->insert( foo_3 => $foo_3 ); my ( $buffer, @ids ) = $v->collapse( objects => [ $foo_3 ], only_in_storage => 1 ); my $entries = $buffer->_entries; is( $ids[0], "foo_3", "custom ID for object" ); is( scalar(keys %$entries), 1, "one entry" ); is( scalar(@ids), 1, "one root set ID" ); is( $entries->{$ids[0]}->class, "KiokuDB_Test_Foo", "class" ); $buffer->update_entries( in_storage => 1 ); } lives_ok { my ( $buffer, @ids ) = $v->collapse( objects => [ $foo_4 ], only_in_storage => 1 ); my $entries = $buffer->_entries; is( scalar(keys %$entries), 2, "two entries" ); is( scalar(@ids), 1, "one root set ID" ); is( $entries->{$ids[0]}->class, "KiokuDB_Test_Foo", "class" ); ok( !exists($entries->{$lo->object_to_id($bar)}), "known object doesn't exist in entry set" ); $buffer->update_entries( in_storage => 1 ); is_deeply( $entries->{$ids[0]}->data->{moof}, [ KiokuDB::Reference->new( id => $lo->object_to_id($foo_4->moof->[0]) ), KiokuDB::Reference->new( id => $lo->object_to_id($bar) ), ], "references", ); }; } { my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => my $lo = KiokuDB::LiveObjects->new, typemap_resolver => KiokuDB::TypeMap::Resolver->new( typemap => KiokuDB::TypeMap->new( entries => { ARRAY => KiokuDB::TypeMap::Entry::Ref->new, HASH => KiokuDB::TypeMap::Entry::Ref->new, }, ), ), ); my $s = $lo->new_scope; { my ( $buffer, @ids ) = $v->collapse( objects => [ KiokuDB_Test_Baz->new( id => "foo" ) ] ); my $entries = $buffer->_entries; is( scalar(keys %$entries), 1, "one entry" ); is( scalar(@ids), 1, "one root set ID" ); $buffer->update_entries( in_storage => 1 ); } { throws_ok { $v->collapse( objects => [ KiokuDB_Test_Baz->new( id => "foo" ) ] ); } qr/ID conflict/; } } { my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => my $lo = KiokuDB::LiveObjects->new, typemap_resolver => KiokuDB::TypeMap::Resolver->new( typemap => KiokuDB::TypeMap->new( entries => { ARRAY => KiokuDB::TypeMap::Entry::Ref->new, HASH => KiokuDB::TypeMap::Entry::Ref->new, }, ), ), ); my $s = $lo->new_scope; { my ( $buffer, @ids ) = $v->collapse( objects => [ KiokuDB_Test_Quxx->new( id => "foo" ) ] ); my $entries = $buffer->_entries; is( scalar(keys %$entries), 1, "one entry" ); is( scalar(@ids), 1, "one root set ID" ); $buffer->update_entries( in_storage => 1 ); } { my ( $buffer, @ids ); lives_ok { ( $buffer, @ids ) = $v->collapse( objects => [ KiokuDB_Test_Quxx->new( id => "foo" ) ] ); } qr/ID conflict/; is_deeply( [ $buffer->entries ], [ ], "no entries produced for backend on duplicate CAS object" ); } } done_testing; directory.t100644001750000144 4066012237006576 14622 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Exception; use Try::Tiny; BEGIN { eval 'use Test::Memory::Cycle; 1' or eval 'sub memory_cycle_ok { SKIP: { skip "Test::Memory::Cycle missing", 1 }}' } use Scalar::Util qw(blessed weaken isweak refaddr); BEGIN { $KiokuDB::SERIAL_IDS = 1 } use KiokuDB; use KiokuDB::Backend::Hash; sub no_live_objects { local $Test::Builder::Level = $Test::Builder::Level + 1; our $dir; is_deeply( [ $dir->live_objects->live_objects ], [], "live object set is empty", ); is_deeply( [ $dir->live_objects->live_entries ], [], "live entry set is empty", ); if ( my @entries = $dir->live_objects->live_entries ) { $dir->live_objects->clear; diag Devel::FindRef::track($entries[0], 100); $entries[0]{__destroyed} = Scope::Guard->new(sub { Carp::cluck("finally destroyed") }); diag($dir->live_objects->dump); } } { package KiokuDB_Test_Foo; use Moose; our $VERSION = "0.02"; has foo => ( isa => "Str", is => "rw", ); has bar => ( is => "rw", ); has parent => ( is => "rw", weak_ref => 1, ); __PACKAGE__->meta->make_immutable; } foreach my $keep_entries ( 1, 0 ) { our $dir = KiokuDB->new( live_objects => { keep_entries => $keep_entries, }, check_class_versions => 1, class_version_table => { KiokuDB_Test_Foo => { "0.01" => { class_version => "0.02", data => { foo => "upgraded" }, }, }, }, backend => KiokuDB::Backend::Hash->new, #backend => KiokuDB::Backend::JSPON->new( # dir => temp_root, # pretty => 1, # lock => 0, #), ); my $l = $dir->live_objects; # Pixie ain't got nuthin on us my $id; { my $s = $dir->new_scope; my $x = KiokuDB_Test_Foo->new( foo => "dancing", bar => KiokuDB_Test_Foo->new( foo => "oh", ), ); memory_cycle_ok($x, "no cycles in proto obj" ); $x->bar->parent($x); memory_cycle_ok($x, "cycle is weak"); memory_cycle_ok($s, "no cycles in scope"); memory_cycle_ok($l, "no cycles in live objects"); $id = $dir->store($x); memory_cycle_ok($s, "no cycles in scope"); memory_cycle_ok($l, "no cycles in live objects"); if ( $keep_entries ) { my $entry = $l->object_to_entry($x); ok( $entry, "got an entry for $id" ); is( try { $entry->id }, $id, "with the right entry" ); is( try { $entry->object }, $x, "and the right object" ); } else { is( $l->object_to_entry($x), undef, "no entry" ); } memory_cycle_ok($x, "store did not introduce cycles"); is_deeply( [ sort $l->live_objects ], [ sort $x, $x->bar ], "live object set" ); }; no_live_objects; memory_cycle_ok($l, "no cycles in live objects"); my $weak; { my $s = $dir->new_scope; my $obj = $dir->lookup($id); weaken($weak = $obj); memory_cycle_ok($obj, "no cycles in object"); memory_cycle_ok($s, "no cycles in scope"); memory_cycle_ok($l, "no cycles in live objects"); is( $obj->foo, "dancing", "simple attr" ); isa_ok( $obj->bar, "KiokuDB_Test_Foo", "object attr" ); is( $obj->bar->foo, "oh", "simple attr of sub object" ); isa_ok( $obj->bar->parent, "KiokuDB_Test_Foo", "object attr of sub object" ); is( $obj->bar->parent, $obj, "circular ref" ); } is( $weak, undef, "weak ref to object died" ); no_live_objects; memory_cycle_ok($l, "no cycles in live objects"); { my $s = $dir->new_scope; my $x = KiokuDB_Test_Foo->new( foo => "oink oink", bar => my $y = KiokuDB_Test_Foo->new( foo => "yay", ), ); my @ids = $dir->store($x, $y); is( scalar(@ids), 2, "got two ids" ); $s->clear; undef $x; is( $l->id_to_object($ids[0]), undef, "first object is dead" ); is( $l->id_to_object($ids[1]), $y, "second is still alive" ); { my $s = $dir->new_scope; my @objects = map { $dir->lookup($_) } @ids; isa_ok( $objects[0], "KiokuDB_Test_Foo" ); is( $objects[0]->foo, "oink oink", "object retrieved" ); is( $objects[1], $y, "object is already live" ); is( $objects[0]->bar, $y, "link recreated" ); } } no_live_objects; { my $s = $dir->new_scope; my @ids = do{ my $s = $dir->new_scope; my $shared = KiokuDB_Test_Foo->new( foo => "shared" ); my $first = KiokuDB_Test_Foo->new( foo => "first", bar => $shared ); my $second = KiokuDB_Test_Foo->new( foo => "second", bar => $shared ); $dir->store( $first, $second ); }; no_live_objects; my $first = $dir->lookup($ids[0]); isa_ok( $first, "KiokuDB_Test_Foo" ); is( $first->foo, "first", "normal attr" ); isa_ok( $first->bar, "KiokuDB_Test_Foo", "shared object" ); is( $first->bar->foo, "shared", "normal attr of shared" ); my $second = $dir->lookup($ids[1]); isa_ok( $second, "KiokuDB_Test_Foo" ); is( $second->foo, "second", "normal attr" ); is( $second->bar, $first->bar, "shared object" ); } no_live_objects; { my $s = $dir->new_scope; my @ids = do{ my $s = $dir->new_scope; my $shared = { foo => "shared", object => KiokuDB_Test_Foo->new( foo => "shared child" ) }; $shared->{object}->parent($shared); my $first = KiokuDB_Test_Foo->new( foo => "first", bar => $shared ); my $second = KiokuDB_Test_Foo->new( foo => "second", bar => $shared ); $dir->store( $first, $second ); }; no_live_objects; my $first = $dir->lookup($ids[0]); isa_ok( $first, "KiokuDB_Test_Foo" ); is( $first->foo, "first", "normal attr" ); is( ref($first->bar), "HASH", "shared hash" ); is( $first->bar->{foo}, "shared", "hash data" ); isa_ok( $first->bar->{object}, "KiokuDB_Test_Foo", "indirect shared child" ); my $second = $dir->lookup($ids[1]); isa_ok( $second, "KiokuDB_Test_Foo" ); is( $second->foo, "second", "normal attr" ); is( $second->bar, $first->bar, "shared value" ); } no_live_objects; { my $s = $dir->new_scope; my $id = do{ my $s = $dir->new_scope; my $shared = { foo => "hippies" }; weaken($shared->{self} = $shared); $dir->store( KiokuDB_Test_Foo->new( foo => "blimey", bar => $shared ) ); }; no_live_objects; my $obj = $dir->lookup($id); isa_ok( $obj, "KiokuDB_Test_Foo" ); is( $obj->foo, "blimey", "normal attr" ); is( ref($obj->bar), "HASH", "shared hash" ); is( $obj->bar->{foo}, "hippies", "hash data" ); is( $obj->bar->{self}, $obj->bar, "circular ref" ); ok( isweak($obj->bar->{self}), "weak ref" ); } no_live_objects; { my $s = $dir->new_scope; my $id = $dir->insert( KiokuDB_Test_Foo->new( foo => "henry" ) ); ok( $id, "insert returns ID for new object" ); $s->clear; no_live_objects; my $obj = $dir->lookup($id); is( $obj->foo, "henry", "stored by insert" ); throws_ok { $dir->insert($obj) } qr/already in database/i, "insertion of present object is an error"; } no_live_objects; { my $id = do { my $s = $dir->new_scope; $dir->store( KiokuDB_Test_Foo->new( foo => "blimey" ) ); }; no_live_objects; { my $s = $dir->new_scope; my $obj = $dir->lookup($id); isa_ok( $obj, "KiokuDB_Test_Foo" ); is( $obj->foo, "blimey", "normal attr" ); $obj->foo("fancy"); is( $obj->foo, "fancy", "attr changed" ); } no_live_objects; { my $s = $dir->new_scope; my $obj = $dir->lookup($id); isa_ok( $obj, "KiokuDB_Test_Foo" ); is( $obj->foo, "blimey", "change not saved" ); $obj->foo("pancy"); is( $obj->foo, "pancy", "attr changed" ); throws_ok { $dir->insert($obj) } qr/already in database/i, "insertion of present object is an error"; } no_live_objects; { my $s = $dir->new_scope; my $obj = $dir->lookup($id); isa_ok( $obj, "KiokuDB_Test_Foo" ); is( $obj->foo, "blimey", "change not saved" ); $obj->foo("shmancy"); is( $obj->foo, "shmancy", "attr changed" ); is( $dir->store($obj), $id, "ID" ); } no_live_objects; { my $s = $dir->new_scope; my $obj = $dir->lookup($id); isa_ok( $obj, "KiokuDB_Test_Foo" ); is( $obj->foo, "shmancy", "store saved change" ); is( $obj->bar, undef, "no 'bar' attr" ); $obj->bar( KiokuDB_Test_Foo->new( foo => "child" ) ); is( $dir->store($obj), $id, "ID" ); } no_live_objects; { my $s = $dir->new_scope; my $child; { my $s = $dir->new_scope; my $obj = $dir->lookup($id); isa_ok( $obj, "KiokuDB_Test_Foo" ); isa_ok( $obj->bar, "KiokuDB_Test_Foo" ); is( $obj->bar->foo, "child", "child object's attr" ); $child = $obj->bar; } is_deeply( [ $l->live_objects ], [ $child ], "only child in live object set", ); { my $s = $dir->new_scope; my $obj = $dir->lookup($id); isa_ok( $obj, "KiokuDB_Test_Foo" ); isa_ok( $obj->bar, "KiokuDB_Test_Foo" ); is( $obj->bar->foo, "child", "child object's attr" ); is( refaddr($obj->bar), refaddr($child), "same refaddr as live object" ); is_deeply( [ sort $l->live_objects ], [ sort $child, $obj ], "two objects in live object set", ); $obj->bar( KiokuDB_Test_Foo->new( foo => "third" ) ); $dir->store( $obj->bar ); } { my $s = $dir->new_scope; my $obj = $dir->lookup($id); isa_ok( $obj, "KiokuDB_Test_Foo" ); isa_ok( $obj->bar, "KiokuDB_Test_Foo" ); is( $obj->bar->foo, "child", "child object's attr unchanged" ); is( refaddr($obj->bar), refaddr($child), "same refaddr as live object" ); $obj->bar( KiokuDB_Test_Foo->new( foo => "third" ) ); $dir->store( $obj ); } { my $s = $dir->new_scope; my $obj = $dir->lookup($id); isa_ok( $obj, "KiokuDB_Test_Foo" ); isa_ok( $obj->bar, "KiokuDB_Test_Foo" ); isnt( refaddr($obj->bar), refaddr($child), "same refaddr as live object" ); is( $obj->bar->foo, "third", "child inserted due to parent's update" ); $dir->store( $obj ); } } } no_live_objects; { my $id = do { my $s = $dir->new_scope; $dir->insert( KiokuDB_Test_Foo->new( foo => "hippies" ) ); }; ok( $id, "insert returns ID for new object" ); no_live_objects; { my $s = $dir->new_scope; my $obj = $dir->lookup($id); is( $obj->foo, "hippies", "stored by insert" ); $obj->foo("blah"); } no_live_objects; { my $s = $dir->new_scope; my $obj = $dir->lookup($id); is( $obj->foo, "hippies", "not updated" ); $obj->foo("goddamn"); my $entry; if ( $keep_entries ) { $entry = $l->object_to_entry($obj); ok( $entry, "got an entry" ); is( $entry->id, $id, "right id" ); } else { $entry = $l->object_to_entry($obj); is( $entry, undef, "no entry" ) or diag(Devel::FindRef::track($entry, 100)); } $dir->update($obj); if ( $keep_entries ) { my $update_entry = $l->object_to_entry($obj); ok( $update_entry, "got an update entry" ); is( $update_entry->id, $id, "right id" ); is( $update_entry->prev, $entry, "prev entry" ); } else { is( $l->object_to_entry($obj), undef, "no entry" ); } } no_live_objects; my $child = KiokuDB_Test_Foo->new( foo => "meddling kids" ); { my $s = $dir->new_scope; my $obj = $dir->lookup($id); is( $obj->foo, "goddamn", "updated" ); $obj->bar( $child ); $@ = ""; try { $dir->update($obj); fail("expected error"); } catch { is_deeply( $_, KiokuDB::Error::UnknownObjects->new( objects => [ $child ] ), "update with a partial object" ); }; $dir->insert($child); ok( $l->object_to_id($child), "child has ID now" ); ok( $l->object_in_storage($child), "its in storage" ); if ( $keep_entries ) { isa_ok( $l->object_to_entry($child), "KiokuDB::Entry" ); } else { is( $l->object_to_entry($child), undef, "KiokuDB::Entry" ); } lives_ok { $dir->update($obj) } "no error this time"; } { my $s = $dir->new_scope; my $obj = $dir->lookup($id); is( $obj->bar, $child, "updated" ); undef $child; $obj->bar->foo("OH HAI"); $dir->update( $obj ); } no_live_objects; { my $s = $dir->new_scope; my $obj = $dir->lookup($id); is( $obj->bar->foo, "meddling kids", "update is shallow" ); $obj->bar->foo("three"); $dir->update( $obj->bar ); } no_live_objects; { my $s = $dir->new_scope; my $obj = $dir->lookup($id); is( $obj->bar->foo, "three", "updated" ); } } no_live_objects; { my $s = $dir->new_scope; my $id = do { my $s = $dir->new_scope; $dir->store( KiokuDB_Test_Foo->new( foo => "dancing", bar => KiokuDB_Test_Foo->new( foo => "oh", ), ), ); }; no_live_objects; { my $s = $dir->new_scope; isa_ok( $dir->lookup($id), "KiokuDB_Test_Foo" ); } no_live_objects; $dir->delete($id); no_live_objects; is( $dir->lookup($id), undef, "deleted" ); }; no_live_objects; { my $s = $dir->new_scope; my $id = $dir->store( my $foo = KiokuDB_Test_Foo->new( foo => "dancing", bar => my $bar = KiokuDB_Test_Foo->new( foo => "oh", ), ), ); if ( $keep_entries ) { my @entries = $l->objects_to_entries($foo, $bar); is( scalar(@entries), 2, "two entries" ); is( $entries[0]->object, $foo, "entry object" ); is( $entries[1]->object, $bar, "entry object" ); $dir->delete($foo, $bar); is( $l->object_to_entry($foo), undef, "no entry object" ); is( $l->object_to_entry($bar), undef, "no entry object" ); } else { is_deeply( [ $l->live_entries ], [ ], "no live entries" ); } }; no_live_objects; { my $s = $dir->new_scope; my $id = $dir->store( blah => my $foo = KiokuDB_Test_Foo->new( foo => "dancing" ), ); is( $id, "blah", "custom id" ); is( $l->object_to_id($foo), "blah", "object to id" ); if ( $keep_entries ) { isa_ok( my $entry = $l->object_to_entry($foo), "KiokuDB::Entry" ); ok( $entry->root, "root object" ); } else { is( $l->object_to_entry($foo), undef, "no entry" ); } ok( $dir->is_root($foo), "object is in root set" ); }; no_live_objects; { my $s = $dir->new_scope; my $id = $dir->insert_nonroot( nonroot_object => my $foo = KiokuDB_Test_Foo->new( foo => "lala" ), ); is( $id, "nonroot_object", "custom id" ); is( $l->object_to_id($foo), "nonroot_object", "object to id" ); if ( $keep_entries ) { isa_ok( my $entry = $l->object_to_entry($foo), "KiokuDB::Entry" ); ok( !$entry->root, "not root" ); } else { is( $l->object_to_entry($foo), undef, "no entry" ); } ok( !$dir->is_root($foo), "object is not in root set" ); }; no_live_objects; { { my $s = $dir->new_scope; my $id = $dir->insert( KiokuDB_Test_Foo->new( foo => "blah blah" ) ); my ( $entry ) = $dir->backend->get($id); my $old_entry = $entry->clone( class_version => "0.01", id => "old_object", ); $dir->backend->insert($old_entry); } { my $s = $dir->new_scope; my $obj = $dir->lookup("old_object"); isa_ok( $obj, "KiokuDB_Test_Foo" ); is( $obj->foo, "upgraded", "field upgraded" ); } }; no_live_objects; } done_testing; live_objs.t100644001750000144 2660312237006576 14573 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Exception; use Scalar::Util qw(weaken); use Cache::Ref::CART; use KiokuDB::LiveObjects; use KiokuDB::Entry; { package KiokuDB_Test_Foo; use Moose; has bar => ( is => "rw", weak_ref => 1 ); has strong_ref => ( is => "rw" ); package KiokuDB_Test_Bar; use Moose; has foo => ( is => "rw", weak_ref => 1 ); } { my $l = KiokuDB::LiveObjects->new; is_deeply( [ $l->live_objects ], [ ], "no live objects", ); { my $s = $l->new_scope; my $x = KiokuDB_Test_Foo->new; $l->insert( x => $x ); is_deeply( [ $l->live_objects ], [ $x ], "live object set" ); } is_deeply( [ $l->live_objects ], [ ], "live object set is weak" ); { my $s = $l->new_scope; my %objects = ( ( map { $_ => KiokuDB_Test_Foo->new } ( 'a' .. 'z' ) ), hash => { foo => "bar" }, array => [ 1 .. 3 ], ); $l->insert( %objects ); is_deeply( [ sort $l->live_objects ], [ sort values %objects ], "live object set" ); $l->remove( 'b', $objects{d} ); is_deeply( [ sort $l->live_objects ], [ sort grep { $_ != $objects{d} and $_ != $objects{b} } values %objects ], "remove", ); is_deeply( [ $l->ids_to_objects(qw(f array)) ], [ @objects{qw(f array)} ], "id to object" ); throws_ok { $l->insert( g => $objects{f} ) } qr/already registered/, "double reg under diff ID is an error"; throws_ok { $l->insert( g => KiokuDB_Test_Foo->new ) } qr/already in use/, "id conflict"; throws_ok { $l->insert( foo => "bar" ) } qr/not a ref/, "can't register non ref"; undef $s; my @objects = ( $objects{n}, $objects{hash} ); %objects = (); is_deeply( [ sort $l->live_objects ], [ sort @objects ], "live object set reduced" ); } is_deeply( [ $l->live_objects ], [ ], "live object set is now empty" ); } { my $l = KiokuDB::LiveObjects->new; is( $l->objects_to_ids(KiokuDB_Test_Foo->new), undef, "random object has undef ID" ); is_deeply( [ $l->objects_to_ids(KiokuDB_Test_Foo->new, KiokuDB_Test_Foo->new) ], [ undef, undef ], "random objects have undef IDs" ); } foreach my $keep ( 1, 0 ) { my $l = KiokuDB::LiveObjects->new( keep_entries => $keep ); my $s = $l->new_scope; { my $entry = KiokuDB::Entry->new( id => "oink" ); $l->register_entry( $entry->id, $entry, in_storage => 1 ); is_deeply( [ $l->loaded_ids ], [qw(oink)], "loaded IDs" ); is_deeply( [ $l->known_ids ], [qw(oink)], "known IDs" ); is_deeply( [ $l->ids_to_entries("oink") ], [ $entry ], "ids_to_entries" ); } is_deeply( [ $l->loaded_ids ], [], "loaded IDs" ); is_deeply( [ $l->known_ids ], [], "known IDs" ); } foreach my $keep ( 1, 0 ) { my $l = KiokuDB::LiveObjects->new( keep_entries => $keep ); { my $s = $l->new_scope; { my $entry = KiokuDB::Entry->new( id => "oink" ); $l->register_entry( $entry->id, $entry, in_storage => 1 ); is_deeply( [ $l->loaded_ids ], ["oink"], "loaded IDs" ); is_deeply( [ $l->ids_to_entries("oink") ], [ $entry ], "ids_to_entries" ); $l->register_object( oink => KiokuDB_Test_Foo->new ); } is_deeply( [ $l->loaded_ids ], [ $keep ? ( qw(oink) ) : () ], "loaded IDs" ); is_deeply( [ $l->known_ids ], [qw(oink)], "known IDs" ); if ( $keep ) { isa_ok( $l->id_to_entry("oink"), "KiokuDB::Entry", "entry still live" ); } else { is( $l->id_to_entry("oink"), undef, "entry died" ); } } is_deeply( [ $l->loaded_ids ], [], "loaded IDs" ); is_deeply( [ $l->known_ids ], [], "known IDs" ); is_deeply( [ $l->live_entries ], [], "live_entries" ); is_deeply( [ $l->live_objects ], [], "live_objects" ); } { my $l = KiokuDB::LiveObjects->new; my $s = $l->new_scope; my $entry = KiokuDB::Entry->new( id => "blah" ); my $blah = KiokuDB_Test_Foo->new; $l->insert( $entry => $blah ); is( $l->id_to_object("blah"), $blah, "id to object" ); ok( $l->object_in_storage($blah), "object in storage" ); is_deeply( [ $l->objects_to_entries($blah) ], [ $entry ], "objects to entries" ); is_deeply( [ $l->ids_to_entries("blah") ], [ $entry ], "ids to entries" ); } { my $l = KiokuDB::LiveObjects->new( keep_entries => 0 ); { my $s = $l->new_scope; my $blah = KiokuDB_Test_Foo->new; { my $entry = KiokuDB::Entry->new( id => "blah" ); $l->insert( $entry => $blah ); is( $l->id_to_object("blah"), $blah, "id to object" ); ok( $l->object_in_storage($blah), "object in storage" ); is( $l->object_to_entry($blah), $entry, "object to entry" ); is( $l->id_to_entry("blah"), $entry, "id to entry" ); } is( $l->id_to_object("blah"), $blah, "id to object" ); ok( $l->object_in_storage($blah), "object in storage" ); is( $l->object_to_entry($blah), undef, "object to entry" ); is( $l->id_to_entry("blah"), undef, "id to entry" ); } is_deeply( [ $l->known_ids ], [], "known IDs" ); } { my $l = KiokuDB::LiveObjects->new; my $foo; { my $s = $l->new_scope; my $inner_foo = $foo = KiokuDB_Test_Foo->new; weaken($foo); my $bar = KiokuDB_Test_Bar->new; $foo->bar($bar); $bar->foo($foo); $l->insert( foo => $foo ); is_deeply( [ $l->live_objects ], [ $foo ], "live object set" ); } is_deeply( [ $l->live_objects ], [ ], "live object set is now empty" ); is( $foo, undef, "foo undefined" ); { my $s = $l->new_scope; is( $s->parent, undef, "no parent scope" ); { my $inner_foo = $foo = KiokuDB_Test_Foo->new; weaken($foo); my $bar = KiokuDB_Test_Bar->new; $foo->bar($bar); $bar->foo($foo); $l->insert( foo => $foo ); is( $l->current_scope, $s, "current scope" ); is_deeply( [ $l->live_objects ], [ $foo ], "live object set" ); { my $child_s = $l->new_scope; is( $child_s->parent, $s, "new scope has parent" ); is( $l->current_scope, $child_s, "current scope" ); $l->insert( blah => KiokuDB_Test_Foo->new ); is( scalar($l->live_objects), 2, "two live objects" ); isa_ok( $l->id_to_object("blah"), "KiokuDB_Test_Foo" ); is_deeply( [ sort $l->live_objects ], [ sort $foo, $l->id_to_object("blah") ], "live object set has new anon member" ); } is( $l->current_scope, $s, "current scope" ); is_deeply( [ $l->live_objects ], [ $foo ], "live object set" ); } is_deeply( [ $l->live_objects ], [ $foo ], "live object set" ); } is( $l->current_scope, undef, "scope cleared" ); is( $foo, undef, "foo undefined" ); is_deeply( [ $l->live_objects ], [ ], "live object set is now empty" ); } { my $l = KiokuDB::LiveObjects->new; { my $s = $l->new_scope; my $foo = KiokuDB_Test_Foo->new; $l->insert( foo => $foo ); is_deeply( [ $l->live_objects ], [ $foo ], "live object set" ); is_deeply( [ $s->objects ], [ $foo ], "scope objects" ); $s->detach; is( $l->current_scope, undef, "scope detached:" ); is_deeply( [ $l->live_objects ], [ $foo ], "live object set" ); is_deeply( [ $s->objects ], [ $foo ], "scope objects" ); my $s2 = $l->new_scope; my $bar = KiokuDB_Test_Bar->new; $l->insert( bar => $bar ); is_deeply( [ sort $l->live_objects ], [ sort $foo, $bar ], "live object set" ); is_deeply( [ $s->objects ], [ $foo ], "scope objects" ); is_deeply( [ $s2->objects ], [ $bar ], "second scope objects" ); $s->remove; undef $foo; is_deeply( [ $l->live_objects ], [ $bar ], "disjoint scope death" ); is_deeply( [ $s2->objects ], [ $bar ], "second scope objects" ); } is_deeply( [ $l->live_objects ], [ ], "live object set is now empty" ); } { my $leak_tracker_called; my $l = KiokuDB::LiveObjects->new( clear_leaks => 1, leak_tracker => sub { $leak_tracker_called++; $_->strong_ref(undef) for @_; } ); my $foo = KiokuDB_Test_Foo->new; my $bar = KiokuDB_Test_Foo->new; $foo->strong_ref($bar); $bar->strong_ref($foo); weaken $foo; weaken $bar; ok( defined($foo), "circular refs keep structure alive" ); { my $s = $l->new_scope; { my $s2 = $l->new_scope; $l->insert( foo => $foo ); is_deeply( [ $l->live_objects ], [ $foo ], "live object set" ); is_deeply( [ $s2->objects ], [ $foo ], "scope objects" ); } is_deeply( [ $s->objects ], [ ], "no scope objects" ); my @live = $l->live_objects; is( scalar(@live), 1, "circular ref still live" ); } is( $l->current_scope, undef, "no current scope" ); is_deeply( [ $l->live_objects ], [ ], "live object set is now empty" ); ok( $leak_tracker_called, "leak tracker called" ); is( $foo, undef, "structure has been manually cleared" ); } { my $leak_tracker_called; my $l = KiokuDB::LiveObjects->new( clear_leaks => 1, leak_tracker => sub { $leak_tracker_called++; } ); my $foo = KiokuDB_Test_Foo->new; ok( defined($foo), "circular refs keep structure alive" ); { my $s = $l->new_scope; { my $s2 = $l->new_scope; $l->register_object( foo => $foo, immortal => 1 ); } is_deeply( [ $s->objects ], [ ], "no scope objects" ); my @live = $l->live_objects; is( scalar(@live), 1, "externally referenced object still live" ); } is( $l->current_scope, undef, "no current scope" ); is_deeply( [ $l->live_objects ], [ ], "live object set is now empty" ); ok( !$leak_tracker_called, "leak tracker not called" ); isa_ok( $foo, "KiokuDB_Test_Foo", "immortal object still live" ); } { my $l = KiokuDB::LiveObjects->new( cache => Cache::Ref::CART->new( size => 50 ), ); { my $s = $l->new_scope; my %hash = map { $_ => KiokuDB_Test_Foo->new( name => $_ ) } 1 .. 100; for ( 1 .. 200 ) { $hash{1 + int rand 100}->strong_ref( $hash{1 + int rand 100} ); } $l->register_object( $_ => $hash{$_}, cache => 1 ) for 1 .. 100; cmp_ok( $l->size, '==', 100, "100 live objects" ); } cmp_ok( $l->size, '<=', 1.1 * $l->cache->size, "not too many live objects" ); } done_testing; bench000755001750000144 012237006576 13057 5ustar00doyusers000000000000KiokuDB-0.56size.pl100644001750000144 175712237006576 14540 0ustar00doyusers000000000000KiokuDB-0.56/bench#!/usr/bin/perl use strict; use warnings; use Test::TempDir; use Path::Class; use Storable qw(nstore retrieve); use Scalar::Util qw(blessed); use KiokuDB; my $f = (require KiokuDB::Test::Fixture::ObjectGraph)->new; sub construct { $f->create; } sub run { my $dir = dir(tempdir); #my $files = KiokuDB->connect("files:dir=" . $dir->subdir("files"), create => 1, global_lock => 1 ); my $bdb = KiokuDB->connect("bdb:dir=" . $dir->subdir("bdb"), create => 1 ); #my $sqlite = KiokuDB->connect("dbi:SQLite:dbname=" . $dir->file("sqlite.db"), serializer => "storable" ); #$sqlite->backend->dbh->do("PRAGMA default_synchronous = OFF"); #$sqlite->backend->deploy; for ( my $i = 1; 1; $i++ ) { foreach my $b ( $bdb ) { $b->txn_do(sub { my $s = $b->new_scope; $b->insert(construct()) for 1 .. 20; }); } warn "iteration $i\n"; system("du -sh ${dir}/bdb/objects ${dir}/*"); } } run(); lib000755001750000144 012237006576 12546 5ustar00doyusers000000000000KiokuDB-0.56KiokuDB.pm100644001750000144 7230012237006576 14556 0ustar00doyusers000000000000KiokuDB-0.56/libpackage KiokuDB; BEGIN { $KiokuDB::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::VERSION = '0.56'; } use Moose; # ABSTRACT: Object Graph storage engine use constant SERIAL_IDS => not not our $SERIAL_IDS; use KiokuDB::Backend; use KiokuDB::Collapser; use KiokuDB::Linker; use KiokuDB::LiveObjects; use KiokuDB::TypeMap; use KiokuDB::TypeMap::Shadow; use KiokuDB::TypeMap::Resolver; use KiokuDB::Stream::Objects; use Moose 2.0000 (); use Moose::Util qw(does_role); use Hash::Util::FieldHash::Compat qw(idhash); use Carp qw(croak); use Try::Tiny; use namespace::clean 0.08 -except => [qw(meta SERIAL_IDS)]; # with qw(KiokuDB::Role::API); # moved lower no warnings 'recursion'; our $REQUIRED_CMD_VERSION = "0.03"; sub cmd_is_up_to_date { require KiokuDB::Cmd; try { KiokuDB::Cmd->VERSION($REQUIRED_CMD_VERSION); 1 }; } sub connect { my ( $class, $dsn, @args ) = @_; if ( -d $dsn || $dsn =~ /\.yml$/ ) { return $class->configure($dsn, @args); } else { require KiokuDB::Util; return $class->new( backend => KiokuDB::Util::dsn_to_backend($dsn, @args), @args ); } } sub configure { my ( $class, $base, @args ) = @_; require Path::Class; $base = Path::Class::dir($base) unless blessed $base; require KiokuDB::Util; my $config = KiokuDB::Util::load_config($base); my $backend = KiokuDB::Util::config_to_backend( $config, base => $base, @args ); # FIXME gin extractor, typemap, etc $class->new( %$config, @args, backend => $backend ); } has typemap => ( does => "KiokuDB::Role::TypeMap", is => "ro", ); has allow_class_builders => ( isa => "Bool|HashRef", is => "ro", ); has [qw(allow_classes allow_bases)] => ( isa => "ArrayRef[Str]", is => "ro", ); has merged_typemap => ( does => "KiokuDB::Role::TypeMap", is => "ro", lazy_build => 1, ); sub _find_default_typemaps { my $self = shift; my $b = $self->backend; my @typemaps; if ( $b->can("default_typemap") ) { push @typemaps, $b->default_typemap; } if ( $b->can("serializer") and $b->serializer->can("default_typemap") ) { push @typemaps, $b->serializer->default_typemap; } return @typemaps; } sub _build_merged_typemap { my $self = shift; my @typemaps; if ( my $typemap = $self->typemap ) { push @typemaps, $typemap; } if ( my $classes = $self->allow_classes ) { require KiokuDB::TypeMap::Entry::Naive; push @typemaps, KiokuDB::TypeMap->new( entries => { map { $_ => KiokuDB::TypeMap::Entry::Naive->new } @$classes }, ); } if ( my $classes = $self->allow_bases ) { require KiokuDB::TypeMap::Entry::Naive; push @typemaps, KiokuDB::TypeMap->new( isa_entries => { map { $_ => KiokuDB::TypeMap::Entry::Naive->new } @$classes }, ); } if ( my $opts = $self->allow_class_builders ) { require KiokuDB::TypeMap::ClassBuilders; push @typemaps, KiokuDB::TypeMap::ClassBuilders->new( ref $opts ? %$opts : () ); } push @typemaps, $self->_find_default_typemaps; if ( not @typemaps ) { return KiokuDB::TypeMap->new; } elsif ( @typemaps == 1 ) { return $typemaps[0]; } else { return KiokuDB::TypeMap::Shadow->new( typemaps => \@typemaps ); } } has check_class_versions => ( isa => "Bool", is => "ro", default => 0, ); has class_version_table => ( isa => "HashRef[HashRef[Str|CodeRef|HashRef]]", is => "ro", default => sub { return {} }, ); has typemap_resolver => ( isa => "KiokuDB::TypeMap::Resolver", is => "ro", lazy_build => 1, ); sub _build_typemap_resolver { my $self = shift; KiokuDB::TypeMap::Resolver->new( typemap => $self->merged_typemap, fallback_entry => KiokuDB::TypeMap::Entry::MOP->new( class_version_table => $self->class_version_table, check_class_versions => $self->check_class_versions, ), ); } has live_objects => ( isa => "KiokuDB::LiveObjects", is => "ro", coerce => 1, lazy => 1, builder => "_build_live_objects", # lazy_build => 1 sets clearer handles => { clear_live_objects => "clear", new_scope => "new_scope", object_to_id => "object_to_id", objects_to_ids => "objects_to_ids", id_to_object => "id_to_object", ids_to_objects => "ids_to_objects", id_in_storage => "id_in_storage", object_in_storage => "object_in_storage", }, ); sub _build_live_objects { KiokuDB::LiveObjects->new } has collapser => ( isa => "KiokuDB::Collapser", is => "ro", lazy_build => 1, ); sub _build_collapser { my $self = shift; KiokuDB::Collapser->new( backend => $self->backend, live_objects => $self->live_objects, typemap_resolver => $self->typemap_resolver, ); } has backend => ( does => "KiokuDB::Backend", is => "ro", required => 1, coerce => 1, ); has linker_queue => ( isa => "Bool", is => "ro", default => 1, ); has linker => ( isa => "KiokuDB::Linker", is => "ro", lazy_build => 1, ); sub _build_linker { my $self = shift; KiokuDB::Linker->new( backend => $self->backend, live_objects => $self->live_objects, typemap_resolver => $self->typemap_resolver, queue => $self->linker_queue, ); } sub BUILD { my $self = shift; my $backend = $self->backend; $backend->register_handle($self) if $backend->can("register_handle"); } with qw(KiokuDB::Role::API); sub exists { my ( $self, @ids ) = @_; return unless @ids; my @exists = map { $_ ? 1 : '' } $self->backend->exists(@ids); return ( @ids == 1 ? $exists[0] : @exists ); # FIXME fix for in_storage etc if ( @ids == 1 ) { my $id = $ids[0]; if ( my $entry = $self->live_objects->id_to_entry($ids[0]) ) { return not $entry->deleted; } if ( my $entry = ($self->backend->exists($id))[0] ) { # backend returns a list if ( ref $entry ) { $self->live_objects->register_entry( $id => $entry, in_storage => 1 ); } return 1; } else { return ''; } } else { my ( %entries, %exists ); @entries{@ids} = $self->live_objects->ids_to_entries(@ids); my @missing; foreach my $id ( @ids ) { if ( ref ( my $entry = $entries{$id} ) ) { $exists{$id} = not $entry->deleted; } else { push @missing, $id; } } if ( @missing ) { my @values = $self->backend->exists(@missing); if ( my @entries = grep { ref } @values ) { $self->live_objects->register_entry( $_->id => $_, in_storage => 1 ) for @entries; } @exists{@missing} = map { ref($_) ? 1 : $_ } @values; } return @ids == 1 ? $exists{$ids[0]} : @exists{@ids}; } } sub lookup { my ( $self, @ids ) = @_; return unless @ids; my $linker = $self->linker; try { my @objects = $linker->get_or_load_objects(@ids); if ( @ids == 1 ) { return $objects[0]; } else { return @objects; } } catch { return if blessed($_) and $_->isa("KiokuDB::Error::MissingObjects") and $_->missing_ids_are(@ids); die $_; }; } sub search { my ( $self, @args ) = @_; if ( @args == 1 && ref $args[0] eq 'HASH' ) { return $self->simple_search(@args); } else { return $self->backend_search(@args); } } sub _load_entry_stream { my ( $self, $stream ) = @_; KiokuDB::Stream::Objects->new( directory => $self, entry_stream => $stream, ); } sub simple_search { my ( $self, @args ) = @_; my $b = $self->backend; my $entries = $b->simple_search( @args, live_objects => $self->live_objects ); my $objects = $self->_load_entry_stream($entries); return $b->simple_search_filter($objects, @args); } sub backend_search { my ( $self, @args ) = @_; my $b = $self->backend; my $entries = $b->search( @args, live_objects => $self->live_objects ); my $objects = $self->_load_entry_stream($entries); return $b->search_filter($objects, @args); } sub root_set { my ( $self ) = @_; $self->_load_entry_stream( $self->backend->root_entries( live_objects => $self->live_objects ) ); } sub all_objects { my ( $self ) = @_; $self->_load_entry_stream( $self->backend->all_entries( live_objects => $self->live_objects ) ); } sub grep { my ( $self, $filter ) = @_; my $stream = $self->root_set; $stream->filter(sub { [ grep { $filter->($_) } @$_ ] }); } sub scan { my ( $self, $filter ) = @_; my $stream = $self->root_set; while ( my $items = $stream->next ) { foreach my $item ( @$items ) { $item->$filter(); } } } sub _parse_args { my ( $self, @args ) = @_; my ( %ids, @ret ); while ( @args ) { my $next = shift @args; unless ( ref $next ) { my $obj = shift @args; $ids{$next} = $obj; push @ret, $obj; } else { push @ret, $next; } } return ( \%ids, @ret ); } sub _register { my ( $self, @args ) = @_; my ( $ids, @objs ) = $self->_parse_args(@args); if ( scalar keys %$ids ) { $self->live_objects->insert(%$ids); } return @objs; } sub refresh { my ( $self, @objects ) = @_; return unless @objects; my $l = $self->live_objects; croak "Object not in storage" if grep { not $l->object_in_storage($_) } @objects; $self->linker->refresh_objects(@objects); if ( defined wantarray ) { if ( @objects == 1 ) { return $objects[0]; } else { return @objects; } } } sub _store { my ( $self, $root, @args ) = @_; my @objects = $self->_register(@args); return unless @objects; $self->store_objects( root_set => $root, objects => \@objects ); } sub store { shift->_store( 1, @_ ) } sub store_nonroot { shift->_store( 0, @_ ) } sub _insert { my ( $self, $root, @args ) = @_; my @objects = $self->_register(@args); return unless @objects; my $l = $self->live_objects; # FIXME make optional? if ( my @in_storage = grep { $l->object_in_storage($_) } @objects ) { croak "Objects already in database: @in_storage"; } $self->store_objects( root_set => $root, only_in_storage => 1, objects => \@objects ); # return IDs only for unknown objects if ( defined wantarray ) { return $self->live_objects->objects_to_ids(@objects); } } sub insert { shift->_insert( 1, @_ ) } sub insert_nonroot { shift->_insert( 0, @_ ) } sub update { my ( $self, @args ) = @_; my @objects = $self->_register(@args); my $l = $self->live_objects; croak "Object not in storage" if grep { not $l->object_in_storage($_) } @objects; $self->store_objects( shallow => 1, only_known => 1, objects => \@objects ); } sub deep_update { my ( $self, @args ) = @_; my @objects = $self->_register(@args); my $l = $self->live_objects; croak "Object not in storage" if grep { not $l->object_in_storage($_) } @objects; $self->store_objects( only_known => 1, objects => \@objects ); } sub _derive_entries { my ( $self, %args ) = @_; my @objects = @{ $args{objects} }; my $l = $self->live_objects; my @entries = $l->objects_to_entries( @{ $args{objects} } ); my $method = $args{method} || "derive"; my $derive_args = $args{args} || []; my @args = ref($derive_args) eq 'HASH' ? %$derive_args : @$derive_args; $l->update_entries(map { my $obj = shift @objects; $obj => $_->$method( object => $obj, @args ); } @entries); } sub set_root { my ( $self, @objects ) = @_; $self->_derive_entries( objects => \@objects, args => { root => 1 } ); } sub unset_root { my ( $self, @objects ) = @_; $self->_derive_entries( objects => \@objects, args => { root => 0 } ); } sub is_root { my ( $self, @objects ) = @_; my $l = $self->live_objects; my @is_root = map { $l->id_in_root_set($_) } $l->objects_to_ids(@objects); return @objects == 1 ? $is_root[0] : @is_root; } sub store_objects { my ( $self, %args ) = @_; my $objects = $args{objects}; my ( $buffer, @ids ) = $self->collapser->collapse(%args); $buffer->imply_root(@ids) if $args{root_set}; $buffer->commit($self->backend); if ( @$objects == 1 ) { return $ids[0]; } else { return @ids; } } sub delete { my ( $self, @ids_or_objects ) = @_; return unless @ids_or_objects; my $l = $self->live_objects; my @ids = grep { not ref } @ids_or_objects; my @objects = grep { ref } @ids_or_objects; # FIXME requires 'deleted' flag or somesuch unless ( $l->keep_entries ) { push @ids, $l->objects_to_ids(@objects); @objects = (); } my @entries; for ( @objects ) { croak "Object not in storage" unless $l->object_in_storage($_); } push @entries, $l->objects_to_entries(@objects) if @objects; @entries = map { $_->deletion_entry } @entries; # FIXME ideally if ID is pointing at a live object we should use its entry #push @entries, $l->ids_to_entries(@ids) if @ids; my @ids_or_entries = ( @entries, @ids ); if ( my @new_entries = grep { ref } $self->backend->delete(@ids_or_entries) ) { push @entries, @new_entries; } $l->remove(@ids_or_objects); } sub scoped_txn { my ( $self, $body, @args ) = @_; $self->txn_do(body => $body, scope => 1, @args); } sub txn_do { my ( $self, @args ) = @_; unshift @args, 'body' if @args % 2 == 1; my %args = @args; my $code = delete $args{body}; my $s = $args{scope} && $self->new_scope; my $backend = $self->backend; if ( $backend->can("txn_do") ) { my $scope = $self->live_objects->new_txn; my $rollback = $args{rollback}; $args{rollback} = sub { $scope && $scope->rollback; $rollback && $rollback->() }; return $backend->txn_do( $code, %args ); } else { return $code->(); } } sub directory { my $self = shift; return $self; } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB - Object Graph storage engine =head1 VERSION version 0.56 =head1 SYNOPSIS use KiokuDB; # use a DSN my $d = KiokuDB->connect( $dsn, %args ); # or manually instantiate a backend my $d = KiokuDB->new( backend => KiokuDB::Backend::Files->new( dir => "/tmp/foo", serializer => "yaml", ), ); # create a scope object my $s = $d->new_scope; # takes a snapshot of $some_object my $uuid = $d->store($some_object); # or with a custom ID: $d->store( $id => $some_object ); # $id can be any string # retrieve by ID my $some_object = $d->lookup($uuid); # some backends (like DBI) support simple searches $d->search({ name => "foo" }); # others use GIN queries (DBI supports both) $d->search($gin_query); =head1 DESCRIPTION L is a Moose based frontend to various data stores, somewhere in between L and L. Its purpose is to provide persistence for "regular" objects with as little effort as possible, without sacrificing control over how persistence is actually done, especially for harder to serialize objects. L is also non-invasive: it does not use ties, C, proxy objects, C or any other type of trickery. Many features important for proper Perl space semantics are supported, including shared data, circular structures, weak references, tied structures, etc. L is meant to solve two related persistence problems: =over 4 =item Transparent persistence Store arbitrary objects without changing their class definitions or worrying about schema details, and without needing to conform to the limitations of a relational model. =item Interoperability Persisting arbitrary objects in a way that is compatible with existing data/code (for example interoperating with another app using CouchDB with JSPON semantics). =back =head1 TUTORIAL If you're new to L check out L. =head1 FUNDAMENTAL CONCEPTS In order to use any persistence framework it is important to understand what it does and how it does it. Systems like L or L generally require explicit meta data and use a schema, which makes them fairly predictable. When using transparent systems like L or L it is more important to understand what's going on behind the scenes in order to avoid surprises and limitations. An architectural overview is available on the website: L The process is explained here and in the various component documentation in more detail. =head2 Collapsing When an object is stored using L it's collapsed into an L. An entry is a simplified representation of the object, allowing the data to be saved in formats as simple as JSON. References to other objects are converted to symbolic references in the entry, so objects can be saved independently of each other. The entries are given to the L for actual storage. Collapsing is explained in detail in L. The way an entry is created varies with the object's class. =head2 Linking When objects are loaded, entries are retrieved from the backend using their UIDs. When a UID is already loaded (in the live object set of a L instance, see L) the live object is used. This way references to shared objects are shared in memory regardless of the order the objects were stored or loaded. This process is explained in detail in L. =head1 ROOT SET MEMBERSHIP Any object that is passed to C or C directly is implicitly considered a member of the root set. This flag implies that the object is an identified resource and should not be garbage collected with any of the proposed garbage collection schemes. The root flag may be modified explicitly: $kiokudb->set_root(@objects); # or unset_root $kiokudb->update(@objects); Lastly, root set membership may also be specified explicitly by the typemap. A root set member must be explicitly removed using C or by removing it from the root set. Only non-members of the root set will be purged with any garbage collection scheme. =head1 TRANSACTIONS On supporting backends the C method will execute a block and commit the transaction at its end. Nesting of C blocks is always supported, though rolling back a nested transaction may produce different results on different backends. If the backend does not support transactions C simply executes the code block normally. =head1 CONCURRENCY Most transactional backends are also concurrent. L and L default to serializable transaction isolation and do not suffer from deadlocks, but serialization errors may occur, aborting the transaction (in which case the transaction should be tried again). L provides good concurrency support but will only detect deadlocks on platforms which return C from C. L may provide alternative mechanisms in the future. Concurrency support in L depends on the database. SQLite defaults to serializable transaction isolation out of the box, wheras MySQL and PostgreSQL default to read committed. Depending on your application read committed isolation may be sufficient, but due to the graph structure nature of the data repeatable reads or serializable level isolation is highly recommended. Read committed isolation generally works well when each row in the database is more or less independent of others, and various constraints ensure integrity. Unfortunately this is not the case with the graph layout. To enable stronger isolation guarantees see L for per-database pointers. =head1 ATTRIBUTES L uses a number of delegates which do the actual work. Of these only C is required, the rest have default definitions. Additional attributes that are not commonly used are listed in L. =over 4 =item backend This attribute is required. This must be an object that does L. The backend handles storage and retrieval of entries. =item typemap This is an instance L. The typemap contains entries which control how L and L handle different types of objects. =item allow_classes An array references of extra classes to allow. Objects blessed into these classes will be collapsed using L. =item allow_bases An array references of extra base classes to allow. Objects derived from these classes will be collapsed using L. =item allow_class_builders If true adds L to the merged typemap. It's possible to provide a hash reference of options to give to L. =item check_class_versions Controls whether or not the class versions of objects are checked on load. Defaults to true. =item class_version_table A table of classes and versions that is passed to the default typemap entry for Moose/Class::MOP objects. When a class version has changed between the time that an object was stored and the time it's being retrieved, the data must be converted. See L for more details. =back =head1 METHODS =over 4 =item connect $dsn, %args DWIM wrapper for C. C<$dsn> represents some sort of backend (much like L dsns map to DBDs). An example DSN is: my $dir = KiokuDB->connect("bdb:dir=path/to/data/"); The backend moniker name is extracted by splitting on the colon. The rest of the string is passed to C, which is documented in more detail in L. Typically DSN arguments are separated by C<;>, with C<=> separating keys and values. Arguments with no value are assumed to denote boolean truth (e.g. C means C<< dir => "foo", pretty => 1 >>). However, a backend may override the default parsing, so this is not guaranteed. Extra arguments are passed both to the backend constructor, and the C constructor. Note that if you need a typemap you still need to pass it in: KiokuDB->connect( $dsn, typemap => $typemap ); The DSN can also be a valid L string taking one of the following forms: dsn => '["dbi:SQLite:foo",{"schema":"MyApp::DB"}]' dsn => '{"dsn":"dbi:SQLite:foo","schema":"MyApp::DB"}' This allows more complicated arguments to be specified accurately, or arbitrary options to be specified when the backend has nonstandard DSN parsing (for instance L simply passes the string to L, so this is necessary in order to specify options on the command line). =item configure $config_file, %args TODO =item new %args Creates a new directory object. See L =item new_scope Creates a new object scope. Handled by C. The object scope artificially bumps up the reference count of objects to ensure that they live at least as long as the scope does. This ensures that weak references aren't deleted prematurely, and the object graph doesn't get corrupted without needing to create circular structures and cleaning up leaks manually. =item lookup @ids Fetches the objects for the specified IDs from the live object set or from storage. =item store @objects =item store %objects =item store_nonroot @objects =item store_nonroot %objects Recursively collapses C<@objects> and inserts or updates the entries. This performs a full update of every reachable object from C<@objects>, snapshotting everything. Strings found in the object list are assumed to be IDs for the following objects. The C variant will not mark the objects as members of the root set (therefore they will be subject to garbage collection). =item update @objects Performs a shallow update of @objects (referents are not updated). It is an error to update an object not in the database. =item deep_update @objects Update @objects and all of the objects they reference. All references objects must already be in the database. =item insert @objects =item insert %objects =item insert_nonroot @objects =item insert_nonroot %objects Inserts objects to the database. It is an error to insert objects that are already in the database, all elements of C<@objects> must be new, but their referents don't have to be. C<@objects> will be collapsed recursively, but the collapsing stops at known objects, which will not be updated. The C variant will not mark the objects as members of the root set (therefore they will be subject to garbage collection). =item delete @objects_or_ids Deletes the specified objects from the store. Note that this can cause lookup errors if the object you are deleting is referred to by another object, because that link will be broken. =item set_root @objects =item unset_root @objects Modify the C flag on the associated entries. C must be called for the change to take effect. =item txn_do $code, %args =item txn_do %args =item scoped_txn $code Executes $code within the scope of a transaction. This requires that the backend supports transactions (L). If the backend does not support transactions, the code block will simply be invoked. Transactions may be nested. If the C argument is true an implicit call to C will be made, keeping the scope for the duration of the transaction. The return value is propagated from the code block, with handling of list/scalar/void context. C is like C but sets C to true. =item txn_begin =item txn_commit =item txn_rollback These methods simply call the corresponding methods on the backend. Like C these methods are no-ops if the backend does not support transactions. =item search \%proto =item search @args Searching requires a backend that supports querying. The C<\%proto> form is currently unspecified but in the future should provide a simple but consistent way of looking up objects by attributes. The second form is backend specific querying, for instance L objects passed to L or the generic GIN backend wrapper L. Returns a L of the results. =item root_set Returns a L of all the root objects in the database. =item all_objects Returns a L of all the objects in the database. =item grep $filter Returns a L of the objects in C filtered by C<$filter>. =item scan $callback Iterates the root set calling C<$callback> for each object. =item object_to_id =item objects_to_ids =item id_to_object =item ids_to_objects Delegates to L =item directory Returns C<$self>. This is used when setting up L delegation chains. Calling C on any level of delegator will always return the real L instance no matter how deep. =back =head1 GLOBALS =over 4 =item C<$SERIAL_IDS> If set at compile time, the default UUID generation role will use serial IDs, instead of UUIDs. This is useful for testing, since the same IDs will be issued each run, but is utterly broken in the face of concurrency. =back =head1 INTERNAL ATTRIBUTES These attributes are documented for completeness and should typically not be needed. =over 4 =item collapser L The collapser prepares objects for storage, by creating L objects to pass to the backend. =item linker L The linker links entries into functioning instances, loading necessary dependencies from the backend. =item live_objects L The live object set keeps track of objects and entries for the linker and the resolver. It also creates scope objects that help ensure objects don't garbage collect too early (L, L), and transaction scope objects used by C (L). =item typemap_resolver An instance of L. Handles actual lookup and compilation of typemap entries, using the user typemap. =back =head1 SEE ALSO =head2 Prior Art on the CPAN =over 4 =item L =item L =item L =item L =item L Polymorphic retrieval is possible with L =item L =item L =back =head1 VERSION CONTROL KiokuDB is maintained using Git. Information about the repository is available on L =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut versioning.t100644001750000144 746612237006576 14770 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Exception; use KiokuDB; { package KiokuDB_Test_VersionedPerson; use Moose; extends qw(KiokuDB::Test::Person); with qw(KiokuDB::Role::Upgrade::Handlers::Table); use constant kiokudb_upgrade_handlers_table => { # like the individual entries in class_version_table "0.01" => "0.02", "0.02" => sub { my ( $class, %args ) = @_; $args{entry}->derive( class_version => "0.03", data => { %{ $args{entry}->data }, name => "new name", }, ); }, }; } foreach my $format ( qw(memory storable json), eval { require YAML::XS; "yaml" } ) { my $dir = KiokuDB->connect("hash", check_class_versions => 1, serializer => $format, ); local $KiokuDB_Test_VersionedPerson::VERSION = "0.01"; $dir->txn_do( scope => 1, body => sub { my $p = KiokuDB_Test_VersionedPerson->new( name => "blah blah", ); $dir->insert( person => $p ); is( $dir->live_objects->object_to_entry($p)->class_version, $KiokuDB_Test_VersionedPerson::VERSION, "Class version set" ); }); $dir->typemap_resolver->clear_compiled; KiokuDB::TypeMap::Entry::MOP->clear_version_cache; $dir->txn_do( scope => 1, body => sub { my $p = $dir->lookup("person"); is( $p->name, "blah blah", "no upgrade" ); is( $dir->live_objects->object_to_entry($p)->class_version, $KiokuDB_Test_VersionedPerson::VERSION, "Class version set" ); $dir->update($p); }); $dir->typemap_resolver->clear_compiled; KiokuDB::TypeMap::Entry::MOP->clear_version_cache; local $KiokuDB_Test_VersionedPerson::VERSION = "0.02"; $dir->txn_do( scope => 1, body => sub { my $p = $dir->lookup("person"); is( $p->name, "blah blah", "upgrade to 0.02 is noop" ); is( $dir->live_objects->object_to_entry($p)->class_version, "0.01", "Class version not changed due to noop" ); $dir->update($p); }); $dir->typemap_resolver->clear_compiled; KiokuDB::TypeMap::Entry::MOP->clear_version_cache; $dir->txn_do( scope => 1, body => sub { my $p = $dir->lookup("person"); is( $p->name, "blah blah", "upgrade to 0.02 is noop" ); is( $dir->live_objects->object_to_entry($p)->class_version, $KiokuDB_Test_VersionedPerson::VERSION, "Class version updated in storage" ); }); $dir->typemap_resolver->clear_compiled; KiokuDB::TypeMap::Entry::MOP->clear_version_cache; local $KiokuDB_Test_VersionedPerson::VERSION = "0.03"; $dir->txn_do( scope => 1, body => sub { my $p = $dir->lookup("person"); is( $p->name, "new name", "class upgraded to 0.03" ); is( $dir->live_objects->object_to_entry($p)->class_version, $KiokuDB_Test_VersionedPerson::VERSION, "Class version set" ); $p->name("foobar"); $dir->update($p); }); $dir->typemap_resolver->clear_compiled; KiokuDB::TypeMap::Entry::MOP->clear_version_cache; $dir->txn_do( scope => 1, body => sub { my $p = $dir->lookup("person"); is( $p->name, "foobar", "upgrade handler did not fire twice" ); is( $dir->live_objects->object_to_entry($p)->class_version, $KiokuDB_Test_VersionedPerson::VERSION, "Class version set" ); $dir->update($p); }); $dir->typemap_resolver->clear_compiled; KiokuDB::TypeMap::Entry::MOP->clear_version_cache; local $KiokuDB_Test_VersionedPerson::VERSION = "0.04"; throws_ok { $dir->txn_do( scope => 1, body => sub { $dir->lookup("person"); }); } qr/0\.03/, "no handler for 0.03"; KiokuDB::TypeMap::Entry::MOP->clear_version_cache; } done_testing; # ex: set sw=4 et: serializer.t100644001750000144 313212237006576 14740 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use constant HAVE_YAML => eval { require YAML::XS } ? 1 : 0; use KiokuDB::Serializer; use KiokuDB::Serializer::JSON; use KiokuDB::Serializer::Storable; use if HAVE_YAML, 'KiokuDB::Serializer::YAML'; use KiokuDB::Entry; sub KiokuDB::Entry::BUILD { shift->root }; # force building of root for is_deeply $_->make_mutable, $_->make_immutable for KiokuDB::Entry->meta; # recreate new { foreach my $serializer ( qw(JSON Storable), HAVE_YAML ? "YAML" : () ) { my $s = "KiokuDB::Serializer::$serializer"->new; does_ok( $s, "KiokuDB::Serializer" ); does_ok( $s, "KiokuDB::Backend::Serialize" ); my $entry = KiokuDB::Entry->new( class => "KiokuDB_Test_Foo", data => { foo => "bar" }, ); my $ser = $s->serialize( $entry ); ok( !ref($ser), "non ref" ); ok( length($ser), "got data" ); is_deeply( $s->deserialize($ser), $entry, "round tripping" ); my $buf = ''; open my $out, ">", \$buf; $s->serialize_to_stream($out, $entry) for 1 .. 3; close $out; ok( length($buf), "serialize_to_stream" ); open my $in, "<", \$buf; my @entries; my $n; while ( my @got = $s->deserialize_from_stream($in) ) { $n++; push @entries, @got; } is( scalar(@entries), 3, "three entries from stream ($n reads)" ); isa_ok( $_, "KiokuDB::Entry" ) for @entries; is_deeply( $entries[0], $entry, "round tripping" ); } } done_testing; small.pl100644001750000144 447412237006576 14675 0ustar00doyusers000000000000KiokuDB-0.56/bench#!/usr/bin/perl use strict; use warnings; use KiokuDB; use KiokuDB::Backend::Hash; $| = 1; my $f = (require KiokuDB::Test::Fixture::Small)->new; my $mxsd_hash = KiokuDB->new( backend => KiokuDB::Backend::Hash->new, ); my $q_employee = Search::GIN::Query::Class->new( class => "KiokuDB::Test::Employee" ); sub bench_write { for ( 1 .. 20 ) { my $t = times; until ( times() - $t > 1 ) { for ( 1 .. 10 ) { my $s = $mxsd_hash->new_scope; my @objs = $f->create, $f->create; $mxsd_hash->store(@objs); } } $mxsd_hash->backend->clear; print "."; print " " if $_ % 5 == 0; } print "done\n"; } sub bench_read { my @ids = do { my $s = $mxsd_hash->new_scope; $mxsd_hash->store($f->create, $f->create) }; for ( 1 .. 20 ) { my $t = times; until ( times() - $t > 1 ) { for ( 1 .. 250 ) { my $s = $mxsd_hash->new_scope; my @objs = $mxsd_hash->lookup(@ids); } } print "."; print " " if $_ % 5 == 0; } print "done\n"; } sub bench_search { use KiokuDB::GIN; use KiokuDB; use KiokuDB::Backend::Hash; use Search::GIN::Query::Class; use Search::GIN::Extract::Class; { package MyGIN; use Moose; extends qw(KiokuDB::Backend::Hash); with ( qw( KiokuDB::GIN Search::GIN::Driver::Hash Search::GIN::Extract::Delegate ), ); __PACKAGE__->meta->make_immutable; } my $gin = MyGIN->new( extract => Search::GIN::Extract::Class->new, root_only => 0, ); my $dir = KiokuDB->new( backend => $gin, ); for ( 1 .. 10 ) { my $s = $dir->new_scope; $dir->store($f->create); } my $q_employee = Search::GIN::Query::Class->new( class => "KiokuDB::Test::Employee" ); for ( 1 .. 20 ) { my $t = times; until ( times() - $t > 1 ) { for ( 1 .. 10 ) { my $s = $dir->new_scope; $dir->search($q_employee); } } print "."; print " " if $_ % 5 == 0; } print "done\n"; } #bench_read(); #bench_write(); bench_search(); 00-compile.t100644001750000144 1575612237006576 14473 0ustar00doyusers000000000000KiokuDB-0.56/tuse strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::Compile 2.037 use Test::More tests => 144 + ($ENV{AUTHOR_TESTING} ? 1 : 0); my @module_files = ( 'KiokuDB.pm', 'KiokuDB/Backend.pm', 'KiokuDB/Backend/Hash.pm', 'KiokuDB/Backend/Role/BinarySafe.pm', 'KiokuDB/Backend/Role/Broken.pm', 'KiokuDB/Backend/Role/Clear.pm', 'KiokuDB/Backend/Role/Concurrency/POSIX.pm', 'KiokuDB/Backend/Role/GC.pm', 'KiokuDB/Backend/Role/Prefetch.pm', 'KiokuDB/Backend/Role/Query.pm', 'KiokuDB/Backend/Role/Query/GIN.pm', 'KiokuDB/Backend/Role/Query/Simple.pm', 'KiokuDB/Backend/Role/Query/Simple/Linear.pm', 'KiokuDB/Backend/Role/Scan.pm', 'KiokuDB/Backend/Role/TXN.pm', 'KiokuDB/Backend/Role/TXN/Memory.pm', 'KiokuDB/Backend/Role/TXN/Memory/Scan.pm', 'KiokuDB/Backend/Role/TXN/Nested.pm', 'KiokuDB/Backend/Role/UnicodeSafe.pm', 'KiokuDB/Backend/Serialize.pm', 'KiokuDB/Backend/Serialize/Delegate.pm', 'KiokuDB/Backend/Serialize/JSON.pm', 'KiokuDB/Backend/Serialize/JSPON.pm', 'KiokuDB/Backend/Serialize/JSPON/Collapser.pm', 'KiokuDB/Backend/Serialize/JSPON/Converter.pm', 'KiokuDB/Backend/Serialize/JSPON/Expander.pm', 'KiokuDB/Backend/Serialize/Memory.pm', 'KiokuDB/Backend/Serialize/Null.pm', 'KiokuDB/Backend/Serialize/Storable.pm', 'KiokuDB/Backend/Serialize/YAML.pm', 'KiokuDB/Backend/TypeMap/Default.pm', 'KiokuDB/Backend/TypeMap/Default/JSON.pm', 'KiokuDB/Backend/TypeMap/Default/Storable.pm', 'KiokuDB/Class.pm', 'KiokuDB/Collapser.pm', 'KiokuDB/Collapser/Buffer.pm', 'KiokuDB/Entry.pm', 'KiokuDB/Entry/Skip.pm', 'KiokuDB/Error.pm', 'KiokuDB/Error/MissingObjects.pm', 'KiokuDB/Error/UnknownObjects.pm', 'KiokuDB/GC/Naive.pm', 'KiokuDB/GC/Naive/Mark.pm', 'KiokuDB/GC/Naive/Sweep.pm', 'KiokuDB/GIN.pm', 'KiokuDB/LinkChecker.pm', 'KiokuDB/LinkChecker/Results.pm', 'KiokuDB/Linker.pm', 'KiokuDB/LiveObjects.pm', 'KiokuDB/LiveObjects/Guard.pm', 'KiokuDB/LiveObjects/Scope.pm', 'KiokuDB/LiveObjects/TXNScope.pm', 'KiokuDB/Meta/Attribute/DoNotSerialize.pm', 'KiokuDB/Meta/Attribute/Lazy.pm', 'KiokuDB/Meta/Instance.pm', 'KiokuDB/Reference.pm', 'KiokuDB/Role/API.pm', 'KiokuDB/Role/Cacheable.pm', 'KiokuDB/Role/ID.pm', 'KiokuDB/Role/ID/Content.pm', 'KiokuDB/Role/ID/Digest.pm', 'KiokuDB/Role/Immutable.pm', 'KiokuDB/Role/Immutable/Transitive.pm', 'KiokuDB/Role/Intrinsic.pm', 'KiokuDB/Role/Scan.pm', 'KiokuDB/Role/TypeMap.pm', 'KiokuDB/Role/UUIDs.pm', 'KiokuDB/Role/UUIDs/DataUUID.pm', 'KiokuDB/Role/UUIDs/SerialIDs.pm', 'KiokuDB/Role/Upgrade/Data.pm', 'KiokuDB/Role/Upgrade/Handlers.pm', 'KiokuDB/Role/Upgrade/Handlers/Table.pm', 'KiokuDB/Role/Verbosity.pm', 'KiokuDB/Role/WithDigest.pm', 'KiokuDB/Serializer.pm', 'KiokuDB/Serializer/JSON.pm', 'KiokuDB/Serializer/Memory.pm', 'KiokuDB/Serializer/Storable.pm', 'KiokuDB/Serializer/YAML.pm', 'KiokuDB/Set.pm', 'KiokuDB/Set/Base.pm', 'KiokuDB/Set/Deferred.pm', 'KiokuDB/Set/Loaded.pm', 'KiokuDB/Set/Storage.pm', 'KiokuDB/Set/Stored.pm', 'KiokuDB/Set/Transient.pm', 'KiokuDB/Stream/Objects.pm', 'KiokuDB/Test.pm', 'KiokuDB/Test/Company.pm', 'KiokuDB/Test/Digested.pm', 'KiokuDB/Test/Employee.pm', 'KiokuDB/Test/Fixture.pm', 'KiokuDB/Test/Fixture/Binary.pm', 'KiokuDB/Test/Fixture/CAS.pm', 'KiokuDB/Test/Fixture/Clear.pm', 'KiokuDB/Test/Fixture/Concurrency.pm', 'KiokuDB/Test/Fixture/GIN/Class.pm', 'KiokuDB/Test/Fixture/MassInsert.pm', 'KiokuDB/Test/Fixture/ObjectGraph.pm', 'KiokuDB/Test/Fixture/Overwrite.pm', 'KiokuDB/Test/Fixture/Refresh.pm', 'KiokuDB/Test/Fixture/RootSet.pm', 'KiokuDB/Test/Fixture/Scan.pm', 'KiokuDB/Test/Fixture/Sets.pm', 'KiokuDB/Test/Fixture/SimpleSearch.pm', 'KiokuDB/Test/Fixture/Small.pm', 'KiokuDB/Test/Fixture/TXN.pm', 'KiokuDB/Test/Fixture/TXN/Nested.pm', 'KiokuDB/Test/Fixture/TXN/Scan.pm', 'KiokuDB/Test/Fixture/TypeMap/Default.pm', 'KiokuDB/Test/Fixture/Unicode.pm', 'KiokuDB/Test/Person.pm', 'KiokuDB/Thunk.pm', 'KiokuDB/TypeMap.pm', 'KiokuDB/TypeMap/ClassBuilders.pm', 'KiokuDB/TypeMap/Composite.pm', 'KiokuDB/TypeMap/Default.pm', 'KiokuDB/TypeMap/Default/Canonical.pm', 'KiokuDB/TypeMap/Default/JSON.pm', 'KiokuDB/TypeMap/Default/Passthrough.pm', 'KiokuDB/TypeMap/Default/Storable.pm', 'KiokuDB/TypeMap/Entry.pm', 'KiokuDB/TypeMap/Entry/Alias.pm', 'KiokuDB/TypeMap/Entry/Callback.pm', 'KiokuDB/TypeMap/Entry/Closure.pm', 'KiokuDB/TypeMap/Entry/Compiled.pm', 'KiokuDB/TypeMap/Entry/JSON/Scalar.pm', 'KiokuDB/TypeMap/Entry/MOP.pm', 'KiokuDB/TypeMap/Entry/Naive.pm', 'KiokuDB/TypeMap/Entry/Passthrough.pm', 'KiokuDB/TypeMap/Entry/Ref.pm', 'KiokuDB/TypeMap/Entry/Set.pm', 'KiokuDB/TypeMap/Entry/Std.pm', 'KiokuDB/TypeMap/Entry/Std/Compile.pm', 'KiokuDB/TypeMap/Entry/Std/Expand.pm', 'KiokuDB/TypeMap/Entry/Std/ID.pm', 'KiokuDB/TypeMap/Entry/Std/Intrinsic.pm', 'KiokuDB/TypeMap/Entry/StorableHook.pm', 'KiokuDB/TypeMap/Resolver.pm', 'KiokuDB/TypeMap/Shadow.pm', 'KiokuDB/Util.pm', 'Moose/Meta/Attribute/Custom/Trait/KiokuDB/DoNotSerialize.pm', 'Moose/Meta/Attribute/Custom/Trait/KiokuDB/Lazy.pm' ); my @scripts = ( 'bin/kioku' ); # no fake home requested my $inc_switch = -d 'blib' ? '-Mblib' : '-Ilib'; use File::Spec; use IPC::Open3; use IO::Handle; my @warnings; for my $lib (@module_files) { # see L open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; my $stderr = IO::Handle->new; my $pid = open3($stdin, '>&STDERR', $stderr, $^X, $inc_switch, '-e', "require q[$lib]"); binmode $stderr, ':crlf' if $^O eq 'MSWin32'; my @_warnings = <$stderr>; waitpid($pid, 0); is($?, 0, "$lib loaded ok"); if (@_warnings) { warn @_warnings; push @warnings, @_warnings; } } foreach my $file (@scripts) { SKIP: { open my $fh, '<', $file or warn("Unable to open $file: $!"), next; my $line = <$fh>; close $fh and skip("$file isn't perl", 1) unless $line =~ /^#!.*?\bperl\b\s*(.*)$/; my @flags = $1 ? split(/\s+/, $1) : (); open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; my $stderr = IO::Handle->new; my $pid = open3($stdin, '>&STDERR', $stderr, $^X, $inc_switch, @flags, '-c', $file); binmode $stderr, ':crlf' if $^O eq 'MSWin32'; my @_warnings = <$stderr>; waitpid($pid, 0); is($?, 0, "$file compiled ok"); # in older perls, -c output is simply the file portion of the path being tested if (@_warnings = grep { !/\bsyntax OK$/ } grep { chomp; $_ ne (File::Spec->splitpath($file))[2] } @_warnings) { warn @_warnings; push @warnings, @_warnings; } } } is(scalar(@warnings), 0, 'no warnings found') if $ENV{AUTHOR_TESTING}; hash_backend.t100644001750000144 177612237006576 15175 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use KiokuDB::Backend::Hash; use KiokuDB::Entry; my @entries = ( map { KiokuDB::Entry->new($_) } { id => 1, root => 1, data => { name => "foo", age => 3 } }, { id => 2, root => 1, data => { name => "bar", age => 3 } }, { id => 3, root => 1, data => { name => "gorch", age => 5 } }, { id => 4, data => { name => "zot", age => 3 } }, ); my $backend = KiokuDB::Backend::Hash->new; $backend->insert(@entries); can_ok( $backend, qw(root_entries simple_search) ); my $root_entries = $backend->root_entries; isa_ok( $root_entries, "Data::Stream::Bulk::Array" ); is_deeply( [ sort { $a->id <=> $b->id } $root_entries->all ], [ sort { $a->id <=> $b->id } @entries[0 .. 2] ], "root set", ); my $three = $backend->simple_search({ age => 3 }); isa_ok( $three, "Data::Stream::Bulk::Array" ); is_deeply( [ sort { $a->id <=> $b->id } $three->all ], [ sort { $a->id <=> $b->id } @entries[0 .. 1] ], "search", ); done_testing; link_checker.t100644001750000144 540012237006576 15210 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use KiokuDB::LinkChecker; use KiokuDB::Entry; use KiokuDB::Reference; use KiokuDB::Backend::Hash; use Data::Stream::Bulk::Util qw(bulk); { my $b = KiokuDB::Backend::Hash->new; my @entries = KiokuDB::Entry->new( data => [ "foo" ], id => "bar" ); $b->insert(@entries); my $l = KiokuDB::LinkChecker->new( backend => $b ); is( $l->missing->size, 0, "no missing entries" ); is( $l->seen->size, 1, "one seen ID" ); is_deeply( [ $l->seen->members ], [ "bar" ], "seen ID is 'bar'" ); is( $l->referenced->size, 0, "no referenced IDs" ); } { my $b = KiokuDB::Backend::Hash->new; my @entries = KiokuDB::Entry->new( data => [ KiokuDB::Reference->new( id => "bar" ) ], id => "bar" ); $b->insert(@entries); my $l = KiokuDB::LinkChecker->new( backend => $b ); is( $l->missing->size, 0, "no missing entries" ); is( $l->seen->size, 1, "one seen ID" ); is_deeply( [ $l->seen->members ], [ "bar" ], "seen ID is 'bar'" ); is( $l->referenced->size, 1, "one referenced ID" ); is_deeply( [ $l->referenced->members ], [ "bar" ], "referenced ID is 'bar'" ); } { my $b = KiokuDB::Backend::Hash->new; my @entries = KiokuDB::Entry->new( data => [ KiokuDB::Reference->new( id => "gorch" ) ], id => "bar" ); $b->insert(@entries); my $l = KiokuDB::LinkChecker->new( backend => $b ); is( $l->missing->size, 1, "one missing entry" ); is_deeply( [ $l->missing->members ], [ "gorch" ], "missing ID is 'gorch'" ); is( $l->seen->size, 1, "one seen ID" ); is_deeply( [ $l->seen->members ], [ "bar" ], "seen ID is 'bar'" ); is( $l->referenced->size, 1, "one referenced ID" ); is_deeply( [ $l->referenced->members ], [ "gorch" ], "referenced ID is 'gorch'" ); } { my @entries = ( KiokuDB::Entry->new( data => [ KiokuDB::Reference->new( id => "gorch" ) ], id => "bar" ), KiokuDB::Entry->new( data => [ KiokuDB::Reference->new( id => "bar" ) ], id => "foo" ), ); my $b = KiokuDB::Backend::Hash->new; $b->insert(@entries); foreach my $entries ( \@entries, [ reverse @entries ] ) { my $l = KiokuDB::LinkChecker->new( backend => $b, entries => bulk(@$entries) ); is( $l->missing->size, 1, "one missing entry" ); is_deeply( [ $l->missing->members ], [ "gorch" ], "missing ID is 'gorch'" ); is( $l->seen->size, 2, "two seen IDs" ); is_deeply( [ sort $l->seen->members ], [ sort qw(foo bar) ], "seen IDs are 'foo', 'bar'" ); is( $l->referenced->size, 2, "two referenced ID" ); is_deeply( [ sort $l->referenced->members ], [ sort qw(bar gorch) ], "referenced ID is 'gorch'" ); } } done_testing; release000755001750000144 012237006576 14053 5ustar00doyusers000000000000KiokuDB-0.56/xteol.t100644001750000144 24012237006576 15133 0ustar00doyusers000000000000KiokuDB-0.56/xt/releaseuse strict; use warnings; use Test::More; eval 'use Test::EOL'; plan skip_all => 'Test::EOL required' if $@; all_perl_files_ok({ trailing_whitespace => 1 }); typemap_extra.t100644001750000144 745512237006576 15465 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Exception; use KiokuDB; use KiokuDB::Backend::Hash; { package KiokuDB_Test_Blah; sub new { my $class = shift; bless {@_}, $class; } sub data { $_[0]{data} } package KiokuDB_Test_Foo; use base qw(KiokuDB_Test_Blah); package KiokuDB_Test_Bar; use base qw(KiokuDB_Test_Foo); package KiokuDB_Test_Baz; use base qw(KiokuDB_Test_Blah); package KiokuDB_Test_Qux; use base qw(KiokuDB_Test_Baz); package KiokuDB_Test_Person; use Moose; has name => ( is => "rw" ); } use constant HAVE_CA => eval { require Class::Accessor }; use constant HAVE_OT => eval { require Object::Tiny }; use constant HAVE_OI => eval { require Object::InsideOut }; if ( HAVE_CA ) { eval q{ package KiokuDB_Test_CA::KiokuDB_Test_Foo; use base qw(Class::Accessor); __PACKAGE__->mk_accessors(qw(data)); }; } if ( HAVE_OT ) { eval q{ package KiokuDB_Test_OT::KiokuDB_Test_Foo; use Object::Tiny qw(data); } } if ( HAVE_OI ) { eval q{ package KiokuDB_Test_OI::KiokuDB_Test_Foo; use Object::InsideOut; my @data :Field :Accessor(data) :Arg(Name => 'data'); } } foreach my $format ( qw(storable json yaml) ) { foreach my $data ( "foo", 42, [ 1 .. 3 ], { foo => "bar" }, KiokuDB_Test_Person->new( name => "jello" ) ) { my $dir = KiokuDB->connect( hash => ( serializer => $format, allow_classes => [qw(KiokuDB_Test_Foo)], allow_bases => [qw(KiokuDB_Test_Baz)], allow_class_builders => 1, )); { my $s = $dir->new_scope; lives_ok { $dir->store( foo => KiokuDB_Test_Foo->new( data => $data ) ) } "can store foo"; dies_ok { $dir->store( bar => KiokuDB_Test_Bar->new( data => $data ) ) } "can't store bar"; lives_ok { $dir->store( baz => KiokuDB_Test_Baz->new( data => $data ) ) } "can store baz"; lives_ok { $dir->store( qux => KiokuDB_Test_Qux->new( data => $data ) ) } "can store qux"; } { my $s = $dir->new_scope; is_deeply( $dir->lookup("foo"), KiokuDB_Test_Foo->new( data => $data ), "lookup foo" ); is_deeply( $dir->lookup("baz"), KiokuDB_Test_Baz->new( data => $data ), "lookup baz" ); is_deeply( $dir->lookup("qux"), KiokuDB_Test_Qux->new( data => $data ), "lookup qux" ); ok( !$dir->exists("bar"), "bar doesn't exist" ); } if ( HAVE_CA ) { { my $s = $dir->new_scope; lives_ok { $dir->store( ca => KiokuDB_Test_CA::KiokuDB_Test_Foo->new({ data => $data }) ) } "can store Class::Accessor"; } { my $s = $dir->new_scope; is_deeply( $dir->lookup("ca"), KiokuDB_Test_CA::KiokuDB_Test_Foo->new({ data => $data }), "is_deeply" ); } } if ( HAVE_OT ) { { my $s = $dir->new_scope; lives_ok { $dir->store( ot => KiokuDB_Test_OT::KiokuDB_Test_Foo->new( data => $data ) ) } "can store Object::Tiny"; } { my $s = $dir->new_scope; is_deeply( $dir->lookup("ot"), KiokuDB_Test_OT::KiokuDB_Test_Foo->new( data => $data ), "is_deeply" ); } } if ( HAVE_OI ) { { my $s = $dir->new_scope; lives_ok { $dir->store( oi => KiokuDB_Test_OI::KiokuDB_Test_Foo->new( data => $data ) ) } "can store Object::InsideOut"; } { my $s = $dir->new_scope; is_deeply( $dir->lookup("oi")->dump, KiokuDB_Test_OI::KiokuDB_Test_Foo->new( data => $data )->dump, "is_deeply" ); } } } } done_testing; shootout.pl100644001750000144 1367512237006576 15474 0ustar00doyusers000000000000KiokuDB-0.56/bench#!/usr/bin/perl use strict; use warnings; use Test::TempDir; use Path::Class; use Storable qw(nstore retrieve); use Scalar::Util qw(blessed); use Try::Tiny; use KiokuDB; # no long running tests my $large = 0; use Benchmark qw(cmpthese); my $f = (require KiokuDB::Test::Fixture::ObjectGraph)->new; sub construct { $f->create; } sub bench { my $dir = dir(tempdir); my $storable = $dir->file("foo.storable")->stringify; my $mxsd_hash = KiokuDB->connect("hash", serializer => "storable" ); my $mxsd_files = KiokuDB->connect("files:dir=" . $dir->subdir("mxsd_files"), create => 1, global_lock => 1 ); my $mxsd_bdb_txn = KiokuDB->connect("bdb:dir=" . $dir->subdir("mxsd_bdb_txn"), create => 1 ); my $mxsd_sqlite = KiokuDB->connect("dbi:SQLite:dbname=" . $dir->file("sqlite.db"), serializer => "storable" ); $mxsd_sqlite->backend->dbh->do("PRAGMA default_synchronous = OFF"); $mxsd_sqlite->backend->deploy; my $mxsd_mysql = try { KiokuDB->connect("dbi:mysql:test", serializer => "storable") } catch { warn @_ }; $mxsd_mysql && $mxsd_mysql->backend->deploy({ add_drop_table => 1, producer_args => { mysql_version => 5 } }); my $mxsd_pg = try { KiokuDB->connect("dbi:Pg:dbname=test", serializer => "storable") } catch { warn $@ }; $mxsd_pg && $mxsd_pg->backend->deploy({ add_drop_table => 1 }); $dir->subdir("mxsd_bdb_dumb")->mkpath; my $mxsd_bdb_dumb = KiokuDB->new( backend => KiokuDB::Backend::BDB->new( manager => { home => $dir->subdir("mxsd_bdb_dumb"), transactions => 0, create => 1, }, ), ); my $mxsd_couch; if ( my $uri = $ENV{KIOKU_COUCHDB_URI} ) { require KiokuDB::Backend::CouchDB; require AnyEvent::CouchDB; my $couch = AnyEvent::CouchDB::couch($uri); my $name = $ENV{KIOKU_COUCHDB_NAME} || "kioku-$$"; my $db = $couch->db($name); try { $db->drop }; $db->create; $mxsd_couch = KiokuDB->connect("couchdb:uri=$uri;db=$name"); $mxsd_couch->{__guard} = Scope::Guard->new(sub { $db->drop }); } warn "\nwriting...\n"; $mxsd_bdb_txn->backend->txn_do(sub { $mxsd_files->backend->txn_do(sub { return; cmpthese(-3, { #null => sub { my @objs = construct(); }, mxsd_hash => sub { my @objs = construct(); my $s = $mxsd_hash->new_scope; $mxsd_hash->store(grep { blessed($_) } @objs) }, mxsd_files => sub { my @objs = construct(); my $s = $mxsd_files->new_scope; $mxsd_files->store(grep { blessed($_) } @objs) }, mxsd_bdb => sub { my @objs = construct(); my $s = $mxsd_bdb_dumb->new_scope; $mxsd_bdb_dumb->store(grep { blessed($_) } @objs) }, mxsd_bdb_txn => sub { my @objs = construct(); my $s = $mxsd_bdb_txn->new_scope; $mxsd_bdb_txn->store(grep { blessed($_) } @objs) }, mxsd_sqlite => sub { my @objs = construct(); my $s = $mxsd_sqlite->new_scope; $mxsd_sqlite->store(grep { blessed($_) } @objs) }, ( $mxsd_mysql ? ( mxsd_mysql => sub { my @objs = construct(); my $s = $mxsd_mysql->new_scope; $mxsd_mysql->store(grep { blessed($_) } @objs) } ) : () ), ( $mxsd_pg ? ( mxsd_pg => sub { my @objs = construct(); my $s = $mxsd_pg->new_scope; $mxsd_pg->store(grep { blessed($_) } @objs) } ) : () ), ( $mxsd_couch ? ( mxsd_couch => sub { my @objs = construct(); my $s = $mxsd_couch->new_scope; $mxsd_couch->store(grep { blessed($_) } @objs) } ) : () ), storable => sub { nstore([ construct() ], $storable) }, }); }); }); warn "\nreading...\n"; nstore([ construct() ], $storable); my @hash_ids = do { my @objs = construct(); my $s = $mxsd_hash->new_scope; $mxsd_hash->store(grep { blessed($_) } @objs) }; my @files_ids = $mxsd_files->txn_do(sub { my @objs = construct(); my $s = $mxsd_files->new_scope; $mxsd_files->store(grep { blessed($_) } @objs) }); my @bdb_d_ids = do { my @objs = construct(); my $s = $mxsd_bdb_dumb->new_scope; $mxsd_bdb_dumb->store(grep { blessed($_) } @objs) }; my @bdb_t_ids = do { my @objs = construct(); my $s = $mxsd_bdb_txn->new_scope; $mxsd_bdb_txn->backend->txn_do(sub { $mxsd_bdb_txn->store(grep { blessed($_) } @objs) }); }; my @sqlite_t_ids = do { my @objs = construct(); my $s = $mxsd_sqlite->new_scope; $mxsd_sqlite->backend->txn_do(sub { $mxsd_sqlite->store(grep { blessed($_) } @objs) }); }; my @mysql_t_ids = $mxsd_mysql ? do { my @objs = construct(); my $s = $mxsd_mysql->new_scope; $mxsd_mysql->backend->txn_do(sub { $mxsd_mysql->store(grep { blessed($_) } @objs) }); } : (); my @pg_t_ids = $mxsd_pg ? do { my @objs = construct(); my $s = $mxsd_pg->new_scope; $mxsd_pg->backend->txn_do(sub { $mxsd_pg->store(grep { blessed($_) } @objs) }); } : (); my @couch_ids = $mxsd_couch ? do { my @objs = construct(); my $s = $mxsd_couch->new_scope; $mxsd_couch->store(grep { blessed($_) } @objs) } : (); cmpthese(-3, { storable => sub { my $objs = retrieve($storable) }, mxsd_hash => sub { my $s = $mxsd_hash->new_scope; my @objs = $mxsd_hash->lookup(@hash_ids) }, mxsd_files => sub { my $s = $mxsd_files->new_scope; my @objs = $mxsd_files->lookup(@files_ids) }, mxsd_bdb => sub { my $s = $mxsd_bdb_dumb->new_scope; my @objs = $mxsd_bdb_dumb->lookup(@bdb_d_ids) }, mxsd_bdb_txn => sub { my $s = $mxsd_bdb_txn->new_scope; my @objs = $mxsd_bdb_txn->lookup(@bdb_t_ids) }, mxsd_sqlite => sub { my $s = $mxsd_sqlite->new_scope; my @objs = $mxsd_sqlite->lookup(@sqlite_t_ids) }, ( $mxsd_mysql ? ( mxsd_mysql => sub { my $s = $mxsd_mysql->new_scope; my @objs = $mxsd_mysql->lookup(@mysql_t_ids) } ) : () ), ( $mxsd_pg ? ( mxsd_pg => sub { my $s = $mxsd_pg->new_scope; my @objs = $mxsd_pg->lookup(@pg_t_ids) } ) : () ), ( $mxsd_couch ? ( mxsd_couch => sub { my $s = $mxsd_couch->new_scope; my @objs = $mxsd_couch->lookup(@couch_ids) } ) : () ), }); } bench(); KiokuDB000755001750000144 012237006576 14036 5ustar00doyusers000000000000KiokuDB-0.56/libGIN.pm100644001750000144 263412237006576 15156 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBpackage KiokuDB::GIN; BEGIN { $KiokuDB::GIN::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::GIN::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Gin assisted recollection use namespace::clean -except => 'meta'; with qw( KiokuDB::Backend::Role::Query::GIN Search::GIN::Driver ); has root_only => ( isa => "Bool", is => "ro", default => 1, ); after insert => sub { my ( $self, @entries ) = @_; @entries = grep { $_->root } @entries if $self->root_only; my @idx_entries = grep { $_->has_object } @entries; foreach my $entry ( @idx_entries ) { my @keys = $self->extract_values( $entry->object ); $self->insert_entry( $entry->id, @keys ); } }; after delete => sub { my ( $self, @ids_or_entries ) = @_; my @ids = map { ref($_) ? $_->id : $_ } @ids_or_entries; $self->remove_ids(@ids); }; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::GIN - Gin assisted recollection =head1 VERSION version 0.56 =head1 SYNOPSIS use KiokuDB::GIN; =head1 DESCRIPTION This is a generic backend wrapping role that allows adding L queries to any backend. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Set.pm100644001750000144 1122112237006576 15304 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBpackage KiokuDB::Set; BEGIN { $KiokuDB::Set::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Set::VERSION = '0.56'; } use Moose::Role 'requires', 'has' => { -as => "attr" }; # need a 'has' method # ABSTRACT: Set::Object wrapper for KiokuDB with lazy loading. use Moose::Util::TypeConstraints 'coerce', 'from', 'via'; use Set::Object; use namespace::clean -except => "meta"; coerce( __PACKAGE__, from ArrayRef => via { require KiokuDB::Set::Transient; KiokuDB::Set::Transient->new( set => Set::Object->new( @$_ ) ), }, ); requires qw( includes members insert remove ); attr _objects => ( isa => "Set::Object", is => "ro", init_arg => "set", writer => "_set_objects", handles => [qw(clear size is_weak weaken strengthen is_null)], default => sub { Set::Object->new }, ); sub clone { my ( $self, @args ) = @_; $self->_clone(@args); } sub _clone { my ( $self, %args ) = @_; $args{set} ||= $self->_clone_object_set; $self->meta->clone_object( $self, %args ); } sub _clone_object_set { my $self = shift; my $set = $self->_objects; ( ref $set )->new( $set->members ); } sub delete { shift->remove(@_) } sub elements { shift->members } sub has { (shift)->includes(@_) } sub contains { (shift)->includes(@_) } sub element { (shift)->member(@_) } sub member { my $self = shift; my $item = shift; return ( $self->includes($item) ? $item : undef ); } sub _apply { my ( $self, $method, @sets ) = @_; my @real_sets; foreach my $set ( @sets ) { if ( my $meth = $set->can("_load_all") ) { $set->$meth; } if ( my $inner = $set->can("_objects") ) { push @real_sets, $set->$inner; } elsif ( $set->isa("Set::Object") ) { push @real_sets, $set; } else { die "Bad set interaction: $self with $set"; } } $self->_clone( set => $self->_objects->$method( @real_sets ) ); } # we weed out empty sets so that they don't trigger loading of deferred sets sub union { if ( my @sets = grep { $_->size } @_ ) { my $self = shift @sets; return $self->_apply( union => @sets ); } else { my $self = shift; return $self->_clone } } sub intersection { my ( $self, @sets ) = @_; if ( grep { $_->size == 0 } $self, @sets ) { return $self->_clone; } else { $self->_apply( intersection => @sets ); } } sub subset { my ( $self, $other ) = @_; return if $other->size < $self->size; return 1 if $self->size == 0; $self->_apply( subset => $other ) } sub difference { my ( $self, $other ) = @_; if ( $other->size == 0 ) { return $self->_clone; } else { $self->_apply( difference => $other ); } } sub equal { my ( $self, $other ) = @_; return 1 if $self->size == 0 and $other->size == 0; return if $self->size != 0 and $other->size != 0; $self->_apply( equal => $other ) } sub not_equal { my ( $self, $other ) = @_; not $self->equal($other); } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Set - Set::Object wrapper for KiokuDB with lazy loading. =head1 VERSION version 0.56 =head1 SYNOPSIS use KiokuDB::Util qw(set); my $set = set(); # KiokuDB::Set::Transient $set->insert($object); warn $set->size; my $id = $dir->store( $set ); =head1 DESCRIPTION This role defines the API implemented by L, L, and L. These three classes are modeled after L, but have implementation details specific to L. =head2 Transient Sets Transient sets are in memory, they are sets that have been constructed by the user for subsequent insertion into storage. When you create a new set, this is what you should use. L provides convenience functions (L and L) to construct transient sets concisely. =head2 Deferred Sets When a set is loaded from the backend, it is deferred by default. This means that the objects inside the set are not yet loaded, and will be fetched only as needed. When set members are needed, the set is upgraded in place into a L object. =head2 Loaded Sets This is the result of vivifying the members of a deferred set, and is similar to transient sets in implementation. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut moose_triggers.t100644001750000144 166112237006576 15624 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Exception; use KiokuDB; { package KiokuDB_Test_Bar; use Moose; package KiokuDB_Test_Foo; use KiokuDB::Class; has 'bar' => ( traits => [ 'KiokuDB::Lazy' ], is => 'rw', isa => 'KiokuDB_Test_Bar', trigger => sub { } # doesnt need to do anything, just exist ); } my $dir = KiokuDB->connect("hash"); $dir->txn_do(scope => 1, body => sub { $dir->store( foo => KiokuDB_Test_Foo->new( bar => KiokuDB_Test_Bar->new ) ); }); $dir->txn_do(scope => 1, body => sub { my $foo = $dir->lookup("foo"); isa_ok($foo, 'KiokuDB_Test_Foo'); lives_ok { local $SIG{ALRM} = sub { die "timed out" }; local $SIG{__WARN__} = sub { die @_ if $_[0] =~ /recursion/i; warn @_ }; alarm 1; $foo->bar( KiokuDB_Test_Bar->new ); alarm 0; } "successfully set a new value for the 'bar' attribute"; }); done_testing(); typemap_values.t100644001750000144 1035112237006576 15646 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Set::Object; use constant HAVE_URI => eval { require URI }; use constant HAVE_DATETIME => eval { require DateTime; require DateTime::Duration }; use constant HAVE_PATH_CLASS => eval { require Path::Class }; use KiokuDB::TypeMap::Entry::Callback; use KiokuDB::TypeMap::Entry::Passthrough; use KiokuDB::TypeMap; use KiokuDB::Backend::Hash; use KiokuDB; { package KiokuDB_Test_Foo; use Moose; has foo => ( isa => "Set::Object", is => "ro", ); has scalar_ref => ( is => "ro", default => sub { my $x = "foo"; \$x }, ); has scalar_ref_ref => ( is => "ro", default => sub { my $x = "foo"; my $y = \$x; \$y }, ); if ( ::HAVE_DATETIME ) { has date => ( isa => "DateTime", is => "ro", default => sub { DateTime->now }, ); has duration => ( isa => "DateTime::Duration", is => "ro", default => sub { DateTime::Duration->new( years => 3, months => 5, weeks => 1, days => 1, hours => 6, minutes => 15, seconds => 45, nanoseconds => 12000, ); }, ); } if ( ::HAVE_URI ) { has uri => ( isa => "URI", is => "ro", default => sub { URI->new("http://www.google.com") }, ); } if ( ::HAVE_PATH_CLASS ) { has stuff => ( isa => "Path::Class::File", is => "ro", default => sub { Path::Class::file("foo.jpg") }, ); } } foreach my $format ( qw(memory storable json), eval { require YAML::XS; "yaml" } ) { my $t = KiokuDB::TypeMap->new( isa_entries => { 'Set::Object' => KiokuDB::TypeMap::Entry::Callback->new( intrinsic => 1, collapse => "members", expand => "new", ), 'Path::Class::File' => KiokuDB::TypeMap::Entry::Callback->new( intrinsic => 1, collapse => "stringify", expand => "new", ), 'Path::Class::Dir' => KiokuDB::TypeMap::Entry::Callback->new( intrinsic => 1, collapse => "stringify", expand => "new", ), 'URI' => KiokuDB::TypeMap::Entry::Callback->new( intrinsic => 1, collapse => "as_string", expand => "new", ), 'DateTime' => ( $format eq 'json' ) ? KiokuDB::TypeMap::Entry::Callback->new( intrinsic => 1, collapse => "epoch", expand => sub { shift->from_epoch( epoch => $_[0] ) } ) : KiokuDB::TypeMap::Entry::Passthrough->new( intrinsic => 1 ), }, ); my $k = KiokuDB->new( backend => KiokuDB::Backend::Hash->new( serializer => $format ), typemap => $t, ); my $id; { my $foo = KiokuDB_Test_Foo->new( foo => Set::Object->new( KiokuDB_Test_Foo->new, ), ); my $s = $k->new_scope; $id = $k->store($foo); ok( $id, "got id" ); } { my $s = $k->new_scope; my $foo = $k->lookup($id); isa_ok( $foo, "KiokuDB_Test_Foo" ); is( ref($foo->scalar_ref), "SCALAR", "scalar ref" ); is_deeply( $foo->scalar_ref, \"foo", "value" ); is( ref($foo->scalar_ref_ref), "REF", "scalar ref (REF reftype)" ); is_deeply( $foo->scalar_ref_ref, \\"foo", "value" ); if ( HAVE_DATETIME ) { isa_ok( $foo->date, "DateTime" ); isa_ok( $foo->duration, "DateTime::Duration" ); } if ( HAVE_URI ) { isa_ok( $foo->uri, "URI" ); } if ( HAVE_PATH_CLASS ) { isa_ok( $foo->stuff, "Path::Class::File" ); is( $foo->stuff->basename, 'foo.jpg', "value" ); } isa_ok( $foo->foo, "Set::Object" ); isa_ok( ( $foo->foo->members )[0], "KiokuDB_Test_Foo", 'set enumeration' ); } } done_testing; Test.pm100644001750000144 444512237006576 15462 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBpackage KiokuDB::Test; BEGIN { $KiokuDB::Test::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::VERSION = '0.56'; } use strict; use warnings; # ABSTRACT: Reusable tests for KiokuDB backend authors. use Scalar::Util qw(blessed); use Test::More; use Module::Pluggable::Object; use namespace::clean; use Sub::Exporter -setup => { exports => [qw(run_all_fixtures)], groups => { default => [-all] }, }; my $mp = Module::Pluggable::Object->new( search_path => "KiokuDB::Test::Fixture", require => 1, ); my @fixtures = sort { $a->sort <=> $b->sort } $mp->plugins; sub run_all_fixtures { my ( $with ) = @_; my $get_dir = blessed($with) ? sub { $with } : $with; for ( 1 .. ( $ENV{KIOKUDB_REPEAT_FIXTURES} || 1 ) ) { require List::Util and @fixtures = List::Util::shuffle(@fixtures) if $ENV{KIOKUDB_SHUFFLE_FIXTURES}; foreach my $fixture ( @fixtures ) { next if $ENV{KIOKUDB_FIXTURE} and $fixture->name ne $ENV{KIOKUDB_FIXTURE}; $fixture->new( get_directory => $get_dir )->run; } } } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test - Reusable tests for KiokuDB backend authors. =head1 VERSION version 0.56 =head1 SYNOPSIS use Test::More; use KiokuDB::Test; use KiokuDB::Backend::MySpecialBackend; my $b = KiokuDB::Backend::MySpecialBackend->new( ... ); run_all_fixtures( KiokuDB->new( backend => $b ) ); done_testing(); =head1 DESCRIPTION This module loads and runs Ls against a L directory instance. =head1 EXPORTS =over 4 =item run_all_fixtures $dir =item run_all_fixtures sub { return $dir } Runs all the L objects against your dir. If you need a new instance of L for every fixture, pass in a code reference. This will load all the modules in the L namespace, and run them against your directory. Fixtures generally check for backend roles and skip unless the backend supports that set of features. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Util.pm100644001750000144 1431012237006576 15470 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBpackage KiokuDB::Util; BEGIN { $KiokuDB::Util::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Util::VERSION = '0.56'; } use strict; use warnings; # ABSTRACT: Utility functions for working with KiokuDB use Path::Class; use Carp qw(croak); use MooseX::YAML 0.04; use Scalar::Util qw(blessed); use namespace::clean; use Sub::Exporter -setup => { exports => [qw(set weak_set dsn_to_backend import_yaml deprecate)], }; sub weak_set { require KiokuDB::Set::Transient; KiokuDB::Set::Transient->new( set => Set::Object::Weak->new(@_) ) } sub set { require KiokuDB::Set::Transient; KiokuDB::Set::Transient->new( set => Set::Object->new(@_) ); } my %monikers = ( "hash" => "Hash", "bdb" => "BDB", "bdb-gin" => "BDB::GIN", "dbi" => "DBI", "jspon" => "JSPON", "files" => "Files", "couchdb" => "CouchDB", "mongodb" => "MongoDB", ); sub _try_json { my $json = shift; require JSON; JSON->new->decode($json); } sub dsn_to_backend { my ( $dsn, @args ) = @_; if ( my ( $moniker, $rest ) = ( $dsn =~ /^([\w-]+)(?::(.*))?$/ ) ) { $moniker = $monikers{$moniker} || $moniker; my $class = "KiokuDB::Backend::$moniker"; Class::MOP::load_class($class); return $class->new_from_dsn($rest, @args); } elsif ( my $args = _try_json($dsn) ) { my $dsn; if ( ref $args eq 'ARRAY' ) { ( $dsn, $args ) = @$args; } if ( ref $args eq 'HASH' ) { $dsn ||= delete $args->{dsn}; return dsn_to_backend($dsn, %$args, @args); } } croak "Malformed DSN: $dsn"; } sub load_config { my ( $base ) = @_; my $config_file; if ( $base =~ /\.yml$/ ) { $config_file = $base; } else { $config_file = dir($base)->file("kiokudb.yml"); $config_file->openr; } MooseX::YAML::LoadFile($config_file); } sub config_to_backend { my ( $config, %args ) = @_; my $base = delete($args{base}); my $backend = $config->{backend}; return $backend if blessed($backend); my $backend_class = $backend->{class}; Class::MOP::load_class($backend_class); return $backend_class->new_from_dsn_params( ( defined($base) ? ( dir => $base->subdir("data") ) : () ), %$backend, %args, ); } sub import_yaml { my ( $kiokudb, @src ) = @_; my @objects = load_yaml_files( find_yaml_files(@src) ); $kiokudb->txn_do(sub { my $scope = $kiokudb->new_scope; $kiokudb->insert(@objects); }); } sub find_yaml_files { my ( @src ) = @_; my @files; foreach my $src ( @src ) { if ( -d $src ) { dir($src)->recurse( callback => sub { my $file = shift; if ( -f $file && $file->basename =~ /\.yml$/ ) { push @files, $file; } }); } else { push @files, $src; } } return @files; } sub load_yaml_files { my ( @files ) = @_; my @objects; foreach my $file ( @files ) { my @data = MooseX::YAML::LoadFile($file); if ( @data == 1 ) { unless ( blessed $data[0] ) { if ( ref $data[0] eq 'ARRAY' ) { @data = @{ $data[0] }; } else { @data = %{ $data[0] }; # with IDs } } } push @objects, @data; } return @objects; } my %seen_deprecation; use constant HARNESS_ACTIVE => not not $ENV{HARNESS_ACTIVE}; sub deprecate ($$) { if ( HARNESS_ACTIVE ) { my ( $version, $reason ) = @_; # parts stolen from Devel::Deprecate, but we're doing version based # deprecation, not date based deprecation require KiokuDB; if ( $KiokuDB::VERSION >= $version ) { my ( $package, $filename, $line ) = caller(1); my ( undef, undef, undef, $subroutine ) = caller(2); return if $seen_deprecation{"${filename}:$line"}++; # no need to warn more than once $subroutine ||= 'n/a'; my $padding = ' ' x 18; $reason =~ s/\n/\n#$padding/g; Carp::cluck(<<"END"); # DEPRECATION WARNING # # Package: $package # File: $filename # Line: $line # Subroutine: $subroutine # # Reason: $reason END } } } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Util - Utility functions for working with KiokuDB =head1 VERSION version 0.56 =head1 SYNOPSIS use KiokuDB::Util qw(set weak_set); my $set = set(@objects); # create a transient set my $weak = weak_set(@objects); # to avoid circular refs =head1 DESCRIPTION This module provides various helper functions for working with L. =head1 EXPORTS =over 4 =item dsn_to_backend $dsn, %args Tries to parse C<$dsn>, load the backend and invoke C on it. Used by L and the various command line interfaces. =item set =item weak_set Instantiate a L or L from the arguments, and then creates a L with the result. =item import_yaml $kiokudb, @files_or_dirs Loads YAML files with L (if given a directory it will be searched recursively for files with a C<.yml> extension are) into the specified KiokuDB directory in a single transaction. The YAML files can contain multiple documents, with each document treated as an object. If the YAML file contains a single non blessed array or hash then that structure will be dereferenced as part of the arguments to C. Here is an example of an array of objects, and a custom tag alias to ease authoring of the YAML file: %YAML 1.1 %TAG ! !MyFoo:: --- - !User id: foo real_name: Foo Bar email: foo@myfoo.com password: '{cleartext}test123' You can use a hash to specify custom IDs: %YAML 1.1 --- the_id: !Some::Class attr: moose =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Entry.pm100644001750000144 2134512237006576 15662 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBpackage KiokuDB::Entry; BEGIN { $KiokuDB::Entry::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Entry::VERSION = '0.56'; } use Moose; # ABSTRACT: An entry in the database use Moose::Util::TypeConstraints; use namespace::clean -except => 'meta'; with 'MooseX::Clone' => { -version => 0.04 }; has id => ( isa => "Str", is => "ro", writer => "_id", clearer => "clear_id", predicate => "has_id", ); has root => ( isa => "Bool", is => "rw", lazy_build => 1, ); sub _build_root { my $self = shift; if ( $self->has_id and my $prev = $self->prev ) { return $prev->root; } else { return 0; } } has deleted => ( isa => "Bool", is => "ro", writer => "_deleted", ); has data => ( is => "ro", writer => "_data", predicate => "has_data", ); has class => ( isa => "Str", is => "ro", writer => "_class", predicate => "has_class", ); has class_meta => ( isa => "HashRef", is => "ro", writer => "_class_meta", predicate => "has_class_meta", ); has class_version => ( isa => "Str", is => "ro", writer => "_class_version", predicate => "has_class_version", ); my @tied = ( map { substr($_, 0, 1) } qw(HASH SCALAR ARRAY GLOB) ); has tied => ( is => "ro", writer => "_tied", predicate => "has_tied", ); has backend_data => ( is => "rw", predicate => "has_backend_data", clearer => "clear_backend_data", ); has prev => ( isa => __PACKAGE__, is => "rw", predicate => "has_prev", clearer => "clear_prev", ); sub root_prev { my $self = shift; if ( $self->has_prev ) { return $self->prev->root_prev; } else { return $self; } } has object => ( traits => [qw(NoClone)], is => "rw", weak_ref => 1, predicate => "has_object", clearer => "clear_object", ); sub deletion_entry { my $self = shift; ( ref $self )->new( id => $self->id, prev => $self, deleted => 1, ( $self->has_object ? ( object => $self->object ) : () ), ( $self->has_backend_data ? ( backend_data => $self->backend_data ) : () ), ); } sub derive { my ( $self, @args ) = @_; $self->clone( prev => $self, @args, ); } has _references => ( traits => [qw(NoClone)], isa => "ArrayRef", is => "ro", lazy_build => 1, ); sub _build__references { my $self = shift; no warnings 'uninitialized'; if ( $self->class eq 'KiokuDB::Set::Stored' ) { # FIXME should the typemap somehow handle this? return [ map { KiokuDB::Reference->new( id => $_ ) } @{ $self->data } ]; } else { my @refs; my @queue = $self->data; while ( @queue ) { my $next = pop @queue; my $ref = ref $next; if ( $ref eq 'HASH' ) { push @queue, grep { ref } values %$next; } elsif ( $ref eq 'ARRAY' ) { push @queue, grep { ref } @$next; } elsif ( $ref eq 'KiokuDB::Entry' ) { push @refs, $next->references; } elsif ( $ref eq 'KiokuDB::Reference' ) { push @refs, $next; } } return \@refs; } } sub references { my $self = shift; return @{ $self->_references }; } has _referenced_ids => ( traits => [qw(NoClone)], isa => "ArrayRef", is => "ro", lazy_build => 1, ); sub _build__referenced_ids { my $self = shift; no warnings 'uninitialized'; if ( $self->class eq 'KiokuDB::Set::Stored' ) { # FIXME should the typemap somehow handle this? return $self->data; } else { return [ map { $_->id } $self->references ]; } } sub referenced_ids { my $self = shift; @{ $self->_referenced_ids }; } use constant _version => 1; use constant _root_b => 0x01; use constant _deleted_b => 0x02; use constant _tied_shift => 2; use constant _tied_mask => 0x03 << _tied_shift; my %tied; @tied{@tied} = ( 1 .. scalar(@tied) ); sub _pack { my $self = shift; my $flags = 0; $flags |= _root_b if $self->root; $flags |= _deleted_b if $self->deleted; if ( $self->has_tied ) { $flags |= $tied{$self->tied} << _tied_shift; } no warnings 'uninitialized'; pack( "C C w/a* w/a*", _version, $flags, $self->id, $self->class ); } sub _unpack { my ( $self, $packed ) = @_; my ( $v, $body ) = unpack("C a*", $packed); if ( $v == _version ) { my ( $flags, $id, $class, $extra ) = unpack("C w/a w/a a*", $body); return $self->_unpack_old($packed) if length($extra); $self->_id($id) if length($id); $self->_class($class) if length($class); $self->root($flags & _root_b); $self->_deleted(1) if $flags & _deleted_b; if ( my $tied = ( $flags & _tied_mask ) >> _tied_shift ) { $self->_tied( $tied[$tied - 1] ); } } else { $self->_unpack_old($packed); } } sub _pack_old { my $self = shift; no warnings 'uninitialized'; join(",", $self->id, !!$self->root, $self->class, $self->tied, !!$self->deleted, ); } sub _unpack_old { my ( $self, $packed ) = @_; my ( $id, $root, $class, $tied, $deleted ) = split ',', $packed; die "bad entry format: $packed" if $root and $root ne '1'; die "bad entry format: $packed" if $deleted and $deleted ne '1'; $self->_id($id) if $id; $self->root(1) if $root; $self->_class($class) if $class; $self->_tied(substr($tied, 0, 1)) if $tied; $self->_deleted(1) if $deleted; } sub STORABLE_freeze { my ( $self, $cloning ) = @_; return ( $self->_pack, [ ( $self->has_data ? $self->data : undef ), ( $self->has_backend_data ? $self->backend_data : undef ), ( $self->has_class_meta ? $self->class_meta : undef ), ( $self->has_class_version ? $self->class_version : undef ), ], ); } sub STORABLE_thaw { my ( $self, $cloning, $attrs, $refs ) = @_; $self->_unpack($attrs); if ( $refs ) { my ( $data, $backend_data, $meta, $version ) = @$refs; $self->_data($data) if defined $data; $self->backend_data($backend_data) if ref $backend_data; $self->_class_meta($meta) if ref $meta; $self->_class_version($version) if defined $version; } } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Entry - An entry in the database =head1 VERSION version 0.56 =head1 SYNOPSIS KiokuDB::Entry->new( id => ..., data => ... ); =head1 DESCRIPTION This object provides the meta data for a single storage entry. =head1 ATTRIBUTES =over 4 =item id The UUID for the entry. If there is no ID then the entry is intrinsic. =item root Whether or not this is a member of the root set (not subject to garbage collection, because storage was explicitly requested). =item data A simplified data structure modeling this object/reference. This is a tree, not a graph, and has no shared data (JSON compliant). All references are symbolic, using a L object with UIDs as the address space. =item class If the entry is blessed, this contains the class of that object. In the future this might be a complex structure for anonymous classes, e.g. the class and the runtime roles. =item class_meta Optional information such as runtime roles to be applied to the object is stored in this hashref. =item tied One of C, C, C or C. C is assumed to be a reference or an intrinsic entry for the object driving the tied structure (e.g. the C). =item prev Contains a link to a L objects that precedes this one. The last entry that was loaded from the store, or successfully written to the store for a given UUID is kept in the live object set. The collapser creates transient Entry objects, which if written to the store successfully replace the previous one. =item backend_data Backends can use this to store additional meta data as they see fit. For instance, this is used in the CouchDB backend to track entry revisions for the opportunistic locking, and in L to to store extracted keys. =item deleted Used for marking entries for deletion. Deletion entries can be generated using the C method, which creates a new derived entry with no data but retaining the ID. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Error.pm100644001750000144 117412237006576 15630 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBpackage KiokuDB::Error; BEGIN { $KiokuDB::Error::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Error::VERSION = '0.56'; } use Moose::Role; use namespace::clean -except => 'meta'; with qw(Throwable); requires qw(as_string); # ex: set sw=4 et: __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Error =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Class.pm100644001750000144 321712237006576 15604 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBpackage KiokuDB::Class; BEGIN { $KiokuDB::Class::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Class::VERSION = '0.56'; } use Moose::Exporter; # ABSTRACT: KiokuDB specific metaclass use Moose::Util::MetaRole; use KiokuDB::Meta::Instance; use KiokuDB::Meta::Attribute::Lazy; use namespace::clean -except => 'meta'; Moose::Exporter->setup_import_methods( also => 'Moose' ); sub init_meta { my ( $class, %args ) = @_; my $for_class = $args{for_class}; Moose->init_meta(%args); Moose::Util::MetaRole::apply_metaroles( for => $for_class, class_metaroles => { instance => [qw(KiokuDB::Meta::Instance)], }, ); return Class::MOP::get_metaclass_by_name($for_class); } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Class - KiokuDB specific metaclass =head1 VERSION version 0.56 =head1 SYNOPSIS package Foo; use KiokuDB::Class; # instead of Moose has bar => ( traits => [qw(KiokuDB::Lazy)], ... ); =head1 DESCRIPTION This L wrapper provides some metaclass extensions in order to more tightly integrate your class with L. Currently only L is set up (by extending L with a custom role to support it), but in the future indexing, identity, and various optimizations will be supported by this. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Thunk.pm100644001750000144 361312237006576 15630 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBpackage KiokuDB::Thunk; BEGIN { $KiokuDB::Thunk::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Thunk::VERSION = '0.56'; } use Moose; # ABSTRACT: Internal only placeholder for deferred objects use namespace::clean -except => 'meta'; has collapsed => ( isa => "Ref", is => "ro", required => 1, ); has linker => ( isa => "KiokuDB::Linker", is => "ro", ); has attr => ( isa => "Class::MOP::Attribute", is => "ro", ); has value => ( isa => "Ref", is => "ro", lazy_build => 1, ); sub _build_value { my $self = shift; return $self->linker->expand_object($self->collapsed); } sub vivify { my ( $self, $instance ) = @_; my $value = $self->value; my $attr = $self->attr; $attr->set_raw_value($instance, $value); $attr->_weaken_value($instance) if ref $value and $attr->is_weak_ref; return $value; } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Thunk - Internal only placeholder for deferred objects =head1 VERSION version 0.56 =head1 SYNOPSIS # do not use directly, # KiokuDB::Meta::Attribute::Lazy, KiokuDB::Meta::Instance and # KiokuDB::TypeMap::Entry::MOP will do the actual thunking of data so that # the thunk will never be visible unless you break encapsulation. =head1 DESCRIPTION This is an internal placeholder object. It will be used on attributes that you mark with L automatically, and should never be visible to the user because L will automatically inflate it before it's even seen by the accessor's code. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut typemap_resolver.t100644001750000144 241312237006576 16170 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Exception; use Scalar::Util qw(reftype); use KiokuDB::TypeMap; use KiokuDB::TypeMap::Entry::Naive; use KiokuDB::TypeMap::Resolver; { package KiokuDB_Test_Foo; use Moose; package KiokuDB_Test_Bar; use Moose; extends qw(KiokuDB_Test_Foo); package KiokuDB_Test_CA; package KiokuDB_Test_CA::Sub; use base qw(KiokuDB_Test_CA); } my $t = KiokuDB::TypeMap->new( entries => { KiokuDB_Test_CA => KiokuDB::TypeMap::Entry::Naive->new, }, ); my $tr = KiokuDB::TypeMap::Resolver->new( typemap => $t, ); isa_ok( $tr, "KiokuDB::TypeMap::Resolver" ); ok( !$tr->resolved("KiokuDB_Test_CA"), "not yet resolved" ); my $method = $tr->expand_method("KiokuDB_Test_CA"); is( reftype($method), "CODE", "expand method" ); ok( $tr->resolved("KiokuDB_Test_CA"), "now it's resolved" ); dies_ok { $tr->expand_method("Hippies") } "no method for non existent class"; dies_ok { $tr->expand_method("KiokuDB_Test_CA::Sub") } "no method for unregistered class"; lives_ok { $tr->expand_method("KiokuDB_Test_Foo") } "classes with meta do work"; ok( my $method_meta = $tr->expand_method("KiokuDB_Test_Foo"), "code" ); is( reftype($method_meta), "CODE", "expand method" ); done_testing; notes000755001750000144 012237006576 13130 5ustar00doyusers000000000000KiokuDB-0.56std_layout.txt100644001750000144 140512237006576 16220 0ustar00doyusers000000000000KiokuDB-0.56/noteson disk organization for standard MXSD: root/ config.yml --- backend: class: ... ... indexes: - class: ... roles: ... type: entry or object ... storage/ ... indexes/ foo/ bar/ gorch/ the load routine goes through the config, loads/composes/creates classes from the class and roles params, and then provides these objects as constructor parameters. Basically all you need to give is the 'root' parameter, and everything else is configured from the config file. It is still possible to instantiate everything manually, for different types of backends, etc. no-tabs.t100644001750000144 1410512237006576 15764 0ustar00doyusers000000000000KiokuDB-0.56/xt/releaseuse strict; use warnings; # this test was generated with Dist::Zilla::Plugin::NoTabsTests 0.05 use Test::More 0.88; use Test::NoTabs; my @files = ( 'bin/kioku', 'lib/KiokuDB.pm', 'lib/KiokuDB/Backend.pm', 'lib/KiokuDB/Backend/Hash.pm', 'lib/KiokuDB/Backend/Role/BinarySafe.pm', 'lib/KiokuDB/Backend/Role/Broken.pm', 'lib/KiokuDB/Backend/Role/Clear.pm', 'lib/KiokuDB/Backend/Role/Concurrency/POSIX.pm', 'lib/KiokuDB/Backend/Role/GC.pm', 'lib/KiokuDB/Backend/Role/Prefetch.pm', 'lib/KiokuDB/Backend/Role/Query.pm', 'lib/KiokuDB/Backend/Role/Query/GIN.pm', 'lib/KiokuDB/Backend/Role/Query/Simple.pm', 'lib/KiokuDB/Backend/Role/Query/Simple/Linear.pm', 'lib/KiokuDB/Backend/Role/Scan.pm', 'lib/KiokuDB/Backend/Role/TXN.pm', 'lib/KiokuDB/Backend/Role/TXN/Memory.pm', 'lib/KiokuDB/Backend/Role/TXN/Memory/Scan.pm', 'lib/KiokuDB/Backend/Role/TXN/Nested.pm', 'lib/KiokuDB/Backend/Role/UnicodeSafe.pm', 'lib/KiokuDB/Backend/Serialize.pm', 'lib/KiokuDB/Backend/Serialize/Delegate.pm', 'lib/KiokuDB/Backend/Serialize/JSON.pm', 'lib/KiokuDB/Backend/Serialize/JSPON.pm', 'lib/KiokuDB/Backend/Serialize/JSPON/Collapser.pm', 'lib/KiokuDB/Backend/Serialize/JSPON/Converter.pm', 'lib/KiokuDB/Backend/Serialize/JSPON/Expander.pm', 'lib/KiokuDB/Backend/Serialize/Memory.pm', 'lib/KiokuDB/Backend/Serialize/Null.pm', 'lib/KiokuDB/Backend/Serialize/Storable.pm', 'lib/KiokuDB/Backend/Serialize/YAML.pm', 'lib/KiokuDB/Backend/TypeMap/Default.pm', 'lib/KiokuDB/Backend/TypeMap/Default/JSON.pm', 'lib/KiokuDB/Backend/TypeMap/Default/Storable.pm', 'lib/KiokuDB/Class.pm', 'lib/KiokuDB/Collapser.pm', 'lib/KiokuDB/Collapser/Buffer.pm', 'lib/KiokuDB/Entry.pm', 'lib/KiokuDB/Entry/Skip.pm', 'lib/KiokuDB/Error.pm', 'lib/KiokuDB/Error/MissingObjects.pm', 'lib/KiokuDB/Error/UnknownObjects.pm', 'lib/KiokuDB/GC/Naive.pm', 'lib/KiokuDB/GC/Naive/Mark.pm', 'lib/KiokuDB/GC/Naive/Sweep.pm', 'lib/KiokuDB/GIN.pm', 'lib/KiokuDB/LinkChecker.pm', 'lib/KiokuDB/LinkChecker/Results.pm', 'lib/KiokuDB/Linker.pm', 'lib/KiokuDB/LiveObjects.pm', 'lib/KiokuDB/LiveObjects/Guard.pm', 'lib/KiokuDB/LiveObjects/Scope.pm', 'lib/KiokuDB/LiveObjects/TXNScope.pm', 'lib/KiokuDB/Meta/Attribute/DoNotSerialize.pm', 'lib/KiokuDB/Meta/Attribute/Lazy.pm', 'lib/KiokuDB/Meta/Instance.pm', 'lib/KiokuDB/Reference.pm', 'lib/KiokuDB/Role/API.pm', 'lib/KiokuDB/Role/Cacheable.pm', 'lib/KiokuDB/Role/ID.pm', 'lib/KiokuDB/Role/ID/Content.pm', 'lib/KiokuDB/Role/ID/Digest.pm', 'lib/KiokuDB/Role/Immutable.pm', 'lib/KiokuDB/Role/Immutable/Transitive.pm', 'lib/KiokuDB/Role/Intrinsic.pm', 'lib/KiokuDB/Role/Scan.pm', 'lib/KiokuDB/Role/TypeMap.pm', 'lib/KiokuDB/Role/UUIDs.pm', 'lib/KiokuDB/Role/UUIDs/DataUUID.pm', 'lib/KiokuDB/Role/UUIDs/LibUUID.pm', 'lib/KiokuDB/Role/UUIDs/SerialIDs.pm', 'lib/KiokuDB/Role/Upgrade/Data.pm', 'lib/KiokuDB/Role/Upgrade/Handlers.pm', 'lib/KiokuDB/Role/Upgrade/Handlers/Table.pm', 'lib/KiokuDB/Role/Verbosity.pm', 'lib/KiokuDB/Role/WithDigest.pm', 'lib/KiokuDB/Serializer.pm', 'lib/KiokuDB/Serializer/JSON.pm', 'lib/KiokuDB/Serializer/Memory.pm', 'lib/KiokuDB/Serializer/Storable.pm', 'lib/KiokuDB/Serializer/YAML.pm', 'lib/KiokuDB/Set.pm', 'lib/KiokuDB/Set/Base.pm', 'lib/KiokuDB/Set/Deferred.pm', 'lib/KiokuDB/Set/Loaded.pm', 'lib/KiokuDB/Set/Storage.pm', 'lib/KiokuDB/Set/Stored.pm', 'lib/KiokuDB/Set/Transient.pm', 'lib/KiokuDB/Stream/Objects.pm', 'lib/KiokuDB/Test.pm', 'lib/KiokuDB/Test/Company.pm', 'lib/KiokuDB/Test/Digested.pm', 'lib/KiokuDB/Test/Employee.pm', 'lib/KiokuDB/Test/Fixture.pm', 'lib/KiokuDB/Test/Fixture/Binary.pm', 'lib/KiokuDB/Test/Fixture/CAS.pm', 'lib/KiokuDB/Test/Fixture/Clear.pm', 'lib/KiokuDB/Test/Fixture/Concurrency.pm', 'lib/KiokuDB/Test/Fixture/GIN/Class.pm', 'lib/KiokuDB/Test/Fixture/MassInsert.pm', 'lib/KiokuDB/Test/Fixture/ObjectGraph.pm', 'lib/KiokuDB/Test/Fixture/Overwrite.pm', 'lib/KiokuDB/Test/Fixture/Refresh.pm', 'lib/KiokuDB/Test/Fixture/RootSet.pm', 'lib/KiokuDB/Test/Fixture/Scan.pm', 'lib/KiokuDB/Test/Fixture/Sets.pm', 'lib/KiokuDB/Test/Fixture/SimpleSearch.pm', 'lib/KiokuDB/Test/Fixture/Small.pm', 'lib/KiokuDB/Test/Fixture/TXN.pm', 'lib/KiokuDB/Test/Fixture/TXN/Nested.pm', 'lib/KiokuDB/Test/Fixture/TXN/Scan.pm', 'lib/KiokuDB/Test/Fixture/TypeMap/Default.pm', 'lib/KiokuDB/Test/Fixture/Unicode.pm', 'lib/KiokuDB/Test/Person.pm', 'lib/KiokuDB/Thunk.pm', 'lib/KiokuDB/Tutorial.pod', 'lib/KiokuDB/Tutorial/JA.pod', 'lib/KiokuDB/TypeMap.pm', 'lib/KiokuDB/TypeMap/ClassBuilders.pm', 'lib/KiokuDB/TypeMap/Composite.pm', 'lib/KiokuDB/TypeMap/Default.pm', 'lib/KiokuDB/TypeMap/Default/Canonical.pm', 'lib/KiokuDB/TypeMap/Default/JSON.pm', 'lib/KiokuDB/TypeMap/Default/Passthrough.pm', 'lib/KiokuDB/TypeMap/Default/Storable.pm', 'lib/KiokuDB/TypeMap/Entry.pm', 'lib/KiokuDB/TypeMap/Entry/Alias.pm', 'lib/KiokuDB/TypeMap/Entry/Callback.pm', 'lib/KiokuDB/TypeMap/Entry/Closure.pm', 'lib/KiokuDB/TypeMap/Entry/Compiled.pm', 'lib/KiokuDB/TypeMap/Entry/JSON/Scalar.pm', 'lib/KiokuDB/TypeMap/Entry/MOP.pm', 'lib/KiokuDB/TypeMap/Entry/Naive.pm', 'lib/KiokuDB/TypeMap/Entry/Passthrough.pm', 'lib/KiokuDB/TypeMap/Entry/Ref.pm', 'lib/KiokuDB/TypeMap/Entry/Set.pm', 'lib/KiokuDB/TypeMap/Entry/Std.pm', 'lib/KiokuDB/TypeMap/Entry/Std/Compile.pm', 'lib/KiokuDB/TypeMap/Entry/Std/Expand.pm', 'lib/KiokuDB/TypeMap/Entry/Std/ID.pm', 'lib/KiokuDB/TypeMap/Entry/Std/Intrinsic.pm', 'lib/KiokuDB/TypeMap/Entry/StorableHook.pm', 'lib/KiokuDB/TypeMap/Resolver.pm', 'lib/KiokuDB/TypeMap/Shadow.pm', 'lib/KiokuDB/Util.pm', 'lib/Moose/Meta/Attribute/Custom/Trait/KiokuDB/DoNotSerialize.pm', 'lib/Moose/Meta/Attribute/Custom/Trait/KiokuDB/Lazy.pm', 'lib/POD2/JA/KiokuDB/Tutorial.pod' ); notabs_ok($_) foreach @files; done_testing; Linker.pm100644001750000144 2526312237006576 16010 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBpackage KiokuDB::Linker; BEGIN { $KiokuDB::Linker::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Linker::VERSION = '0.56'; } use Moose; # ABSTRACT: Relinks live objects from storage entries # perf improvements: # use a queue of required objects, queue up references, and bulk fetch # bulk fetch arrays # could support a Backend::Queueing which allows queuing of IDs for fetching, # to help clump or start a request and only read it when it's actually needed use Carp qw(croak); use Scalar::Util qw(reftype weaken); use Symbol qw(gensym); use Tie::ToObject; use KiokuDB::Error::MissingObjects; use namespace::clean -except => 'meta'; has live_objects => ( isa => "KiokuDB::LiveObjects", is => "ro", required => 1, handles => [qw(id_to_object ids_to_objects object_to_id objects_to_ids id_to_entry ids_to_entries)], ); has backend => ( does => "KiokuDB::Backend", is => "ro", required => 1, ); has typemap_resolver => ( isa => "KiokuDB::TypeMap::Resolver", is => "ro", handles => [qw(expand_method refresh_method)], required => 1, ); has queue => ( isa => "Bool", is => "ro", default => 1, ); has _queue => ( isa => "ArrayRef", is => "ro", default => sub { [] }, ); has _deferred => ( isa => "ArrayRef", is => "ro", default => sub { [] }, ); sub register_object { my ( $self, $entry, $object, @args ) = @_; if ( my $id = $entry->id ) { my $l = $self->live_objects; $l->register_entry( $id => $entry ); $l->register_object( $id => $object, @args ); } } sub expand_objects { my ( $self, @entries ) = @_; my $l = $self->live_objects; my @objects; foreach my $entry ( @entries ) { # if the object was referred to in some other entry in @entries, it may # have already been loaded. if ( defined ( my $obj = $l->id_to_object($entry->id) ) ) { push @objects, $obj; } else { $self->inflate_data( $entry, \($objects[@objects]) ); } } $self->load_queue; return @objects; } sub expand_object { my ( $self, $entry ) = @_; $self->inflate_data( $entry, \(my $obj) ); $self->load_queue; return $obj; } sub queue_ref { my ( $self, $ref, $into ) = @_; if ( $self->queue ) { #my $b = $self->backend; #if ( $b->can("prefetch") ) { # $b->prefetch($ref->id); #} push @{ $self->_queue }, [ $ref, $into ]; } else { if ( ref $ref ) { $$into = $self->get_or_load_object($ref->id); weaken($$into) if $ref->is_weak; } else { $$into = $self->get_or_load_object($ref); } } } sub queue_finalizer { my ( $self, @hooks ) = @_; if ( $self->queue ) { push @{ $self->_deferred }, @hooks; } else { foreach my $hook ( @hooks ) { $self->$hook(); } } } sub load_queue { my $self = shift; return unless $self->queue; my $queue = $self->_queue; my $deferred = $self->_deferred; my @queue = @$queue; my @deferred = @$deferred; @$queue = (); @$deferred = (); if ( @queue ) { my @ids; foreach my $entry ( @queue ) { my $ref = $entry->[0]; push @ids, ref($ref) ? $ref->id : $ref; } my @objects = $self->get_or_load_objects(@ids); foreach my $item ( @queue ) { my ( $data, $into ) = @$item; my $obj = shift @objects; $$into = $obj; weaken $$into if ref $data and $data->is_weak; } } if ( @deferred ) { foreach my $item ( @deferred ) { $self->$item; } } } sub inflate_data { my ( $self, $data, $into, $entry ) = @_; # Kinda ugly... inflates $data into the scalar ref in $into # but this allows us to handle weakening properly. # god I hate perl's reftypes, why couldn't they be a little more consistent unless ( ref $data ) { $$into = $data; } elsif ( ref $data eq 'KiokuDB::Reference' ) { $self->queue_ref( $data, $into ); } elsif ( ref $data eq 'KiokuDB::Entry' ) { if ( my $class = $data->class ) { my $expand_method = $self->expand_method($class); $$into = $self->$expand_method($data); } else { my $obj; $self->inflate_data($data->data, \$obj, $data); $self->load_queue; # force vivification of $obj if ( my $tie = $data->tied ) { if ( $tie eq 'H' ) { tie my %h, "Tie::ToObject" => $obj; $obj = \%h; } elsif ( $tie eq 'A' ) { tie my @a, "Tie::ToObject" => $obj; $obj = \@a; } elsif ( $tie eq 'G' ) { my $glob = gensym(); tie *$glob, "Tie::ToObject" => $obj, $obj = $glob; } elsif ( $tie eq 'S' ) { my $scalar; tie $scalar, "Tie::ToObject" => $obj; $obj = \$scalar; } else { die "Don't know how to tie $tie"; } } $$into = $obj; } $data->object($$into); } elsif ( ref($data) eq 'HASH' ) { my %targ; $self->register_object( $entry => \%targ ) if $entry; foreach my $key ( keys %$data ) { $self->inflate_data( $data->{$key}, \$targ{$key} ); } $$into = \%targ; } elsif ( ref($data) eq 'ARRAY' ) { my @targ; $self->register_object( $entry => \@targ ) if $entry; for (@$data ) { push @targ, undef; $self->inflate_data( $_, \$targ[-1] ); } $$into = \@targ; } elsif ( ref($data) eq 'SCALAR' ) { my $targ = $$data; $self->register_object( $entry => \$targ ) if $entry; $$into = \$targ; } elsif ( ref($data) eq 'REF' ) { my $targ; $self->register_object( $entry => \$targ ) if $entry; $self->inflate_data( $$data, \$targ ); $$into = \$targ; } else { if ( blessed($data) ) { # this branch is for passthrough intrinsic values $self->register_object( $entry => $data ) if $entry; $$into = $data; } else { die "unsupported reftype: " . ref $data; } } } sub get_or_load_objects { my ( $self, @ids ) = @_; return $self->get_or_load_object($ids[0]) if @ids == 1; my %objects; @objects{@ids} = $self->live_objects->ids_to_objects(@ids); my @missing = grep { not defined $objects{$_} } keys %objects; # @ids may contain duplicates @objects{@missing} = $self->load_objects(@missing); return @objects{@ids}; } sub load_objects { my ( $self, @ids ) = @_; return $self->expand_objects( $self->get_or_load_entries(@ids) ); } sub get_or_load_entries { my ( $self, @ids ) = @_; my %entries; @entries{@ids} = $self->ids_to_entries(@ids); if ( my @load = grep { !$entries{$_} } @ids ) { @entries{@load} = $self->load_entries(@load); } return @entries{@ids}; } sub load_entries { my ( $self, @ids ) = @_; my @entries = $self->backend->get(@ids); if ( @entries != @ids or grep { !$_ } @entries ) { my %entries; @entries{@ids} = @entries; my @missing = grep { !$entries{$_} } @ids; KiokuDB::Error::MissingObjects->throw( ids => \@missing ); } my $l = $self->live_objects; foreach my $entry ( @entries ) { $l->register_entry( $entry->id, $entry, in_storage => 1 ); } return @entries; } sub register_and_expand_entries { my ( $self, @entries ) = @_; my $l = $self->live_objects; foreach my $entry ( @entries ) { $l->register_entry( $entry->id, $entry, in_storage => 1 ); } $self->expand_objects(@entries); } sub get_or_load_object { my ( $self, $id ) = @_; if ( defined( my $obj = $self->live_objects->id_to_object($id) ) ) { return $obj; } else { return $self->load_object($id); } } sub refresh_objects { my ( $self, @objects ) = @_; $self->refresh_object($_) for @objects; } sub refresh_object { my ( $self, $object ) = @_; my $id = $self->object_to_id($object); my $entry = $self->load_entry($id); my $refresh = $self->refresh_method( $entry->class ); $self->$refresh($object, $entry); $self->load_queue; return $object; } sub get_or_load_entry { my ( $self, $id ) = @_; return $self->id_to_entry($id) || $self->load_entry($id); } sub load_entry { my ( $self, $id ) = @_; my $entry = ( $self->backend->get($id) )[0] or KiokuDB::Error::MissingObjects->throw( ids => [ $id ] ); $self->live_objects->register_entry( $id => $entry, in_storage => 1 ); return $entry; } sub load_object { my ( $self, $id ) = @_; my $entry = $self->get_or_load_entry($id); return $self->expand_object($entry); } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Linker - Relinks live objects from storage entries =head1 VERSION version 0.56 =head1 SYNOPSIS # mostly internal =head1 DESCRIPTION The linker reconnects entry data, recreating the connected object graph in memory. The linkage process starts with an ID (or several IDs) to be loaded passed to the C method. This ID will first be searched for in the live object set (L). If the object is already live, then it will be returned as is. If the object is not live, then the corresponding entry is fetched from the backend, and expanded into an actual instance. Expansion consults the L using L, to find the correct typemap entry (see L and L), and that is used for the actual expansion. Most of the grunt work is delegated by the entries back to the linker using the C method, which handles circular structures, retrying of tied structures, etc. Inflated objects are registered with L, and get inserted into the current live object scope (L). The scope's job is to maintain a reference count of at least 1 for any loaded object, until it is destroyed itself. This ensures that weak references are not destroyed prematurely, but allows their use in order to avoid memory leaks. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut link_checker_real.t100644001750000144 241112237006576 16212 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use KiokuDB::LinkChecker; use KiokuDB::Backend::Hash; use KiokuDB::Test::Fixture::ObjectGraph; use KiokuDB; my $dir = KiokuDB->new( backend => my $backend = KiokuDB::Backend::Hash->new(), ); my $f = KiokuDB::Test::Fixture::ObjectGraph->new( directory => $dir ); $f->populate; { my $l = KiokuDB::LinkChecker->new( backend => $backend ); cmp_ok( $l->seen->size, '>', 0, "seen some entries" ); cmp_ok( $l->missing->size, '==', 0, "no missing entries" ); } $f->verify; # deletes putin, and removes the ref from Dubya { my $l = KiokuDB::LinkChecker->new( backend => $backend ); cmp_ok( $l->seen->size, '>', 0, "seen some entries" ); cmp_ok( $l->missing->size, '==', 0, "no missing entries" ); } my $deleted_id = do { my $s = $dir->new_scope; my $dubya = $dir->lookup($f->dubya); my $delete = $dubya->friends->[-1]; my $id = $dir->object_to_id($delete); $dir->delete($delete); $id; }; { my $l = KiokuDB::LinkChecker->new( backend => $backend ); cmp_ok( $l->seen->size, '>', 0, "seen some entries" ); cmp_ok( $l->missing->size, '==', 1, "one missing entry" ); is_deeply( [ $l->missing->members ], [ $deleted_id ], "ID is correct" ); } done_testing; typemap_entry_mop.t100644001750000144 3400312237006576 16363 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Scalar::Util qw(refaddr reftype blessed); use Try::Tiny; use KiokuDB::TypeMap::Entry::MOP; use KiokuDB::TypeMap::Resolver; use KiokuDB::Collapser; use KiokuDB::Linker; use KiokuDB::LiveObjects; use KiokuDB::Backend::Hash; use KiokuDB::Role::ID; use constant HAVE_MX_STORAGE => try { require MooseX::Storage::Meta::Attribute::Trait::DoNotSerialize }; # FIXME lazy trait { package KiokuDB_Test_Foo; use Moose; our $VERSION = "0.03"; has foo => ( is => "rw" ); has bar => ( is => "rw", isa => "KiokuDB_Test_Bar" ); if ( ::HAVE_MX_STORAGE ) { has trash => ( is => "ro", traits => [qw(DoNotSerialize)], lazy => 1, default => "lala" ); } has junk => ( is => "ro", traits => [qw(KiokuDB::DoNotSerialize)], lazy => 1, default => "barf" ); package KiokuDB_Test_Bar; use Moose; our $VERSION = "0.03"; with qw(KiokuDB::Role::ID KiokuDB::Role::Upgrade::Data); sub kiokudb_object_id { shift->id } sub kiokudb_upgrade_data { my ( $class, %args ) = @_; return $args{entry}->derive( class_version => $VERSION ); } has id => ( is => "ro" ); has blah => ( is => "rw" ); package KiokuDB_Test_Gorch; use Moose::Role; has optional => ( is => "rw" ); package KiokuDB_Test_Value; use Moose; with qw(KiokuDB::Role::Intrinsic); has name => ( is => "rw" ); package KiokuDB_Test_Once; use Moose; our $VERSION = "0.03"; with qw(KiokuDB::Role::Upgrade::Handlers::Table); use constant kiokudb_upgrade_handlers_table => { "0.01" => "0.02", "0.02" => { class_version => "0.03", }, }; with qw(KiokuDB::Role::Immutable); has name => ( is => "rw" ); } my $obj = KiokuDB_Test_Foo->new( foo => "HALLO" ); $obj->trash if HAVE_MX_STORAGE; $obj->junk; my $deep = KiokuDB_Test_Foo->new( foo => "la", bar => KiokuDB_Test_Bar->new( blah => "hai", id => "the_bar" ) ); my $with_anon = KiokuDB_Test_Bar->new( blah => "HALLO", id => "runtime_role" ); KiokuDB_Test_Gorch->meta->apply($with_anon); $with_anon->optional("very much"); my $anon_parent = KiokuDB_Test_Foo->new( bar => $with_anon ); my $obj_with_value = KiokuDB_Test_Foo->new( foo => KiokuDB_Test_Value->new( name => "fairly" ) ); my $once = KiokuDB_Test_Once->new( name => "blah" ); foreach my $intrinsic ( 1, 0 ) { my $foo_entry = KiokuDB::TypeMap::Entry::MOP->new( write_upgrades => 1, version_table => { "" => "0.01", # equivalent "0.01" => sub { my ( $self, %args ) = @_; return $args{entry}->derive( class_version => "0.02" ); }, "0.02" => "0.03", }, ); my $bar_entry = KiokuDB::TypeMap::Entry::MOP->new( $intrinsic ? ( intrinsic => 1 ) : (), write_upgrades => 1 ); my $tr = KiokuDB::TypeMap::Resolver->new( fallback_entry => KiokuDB::TypeMap::Entry::MOP->new( write_upgrades => 1, ), typemap => KiokuDB::TypeMap->new( entries => { KiokuDB_Test_Foo => $foo_entry, KiokuDB_Test_Bar => $bar_entry, }, ), ); my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => KiokuDB::LiveObjects->new, typemap_resolver => $tr, ); my $l = KiokuDB::Linker->new( backend => KiokuDB::Backend::Hash->new, live_objects => KiokuDB::LiveObjects->new, typemap_resolver => $tr, ); { my $s = $v->live_objects->new_scope; my ( $buffer, $id ) = $v->collapse( objects => [ $obj ], ); my $entries = $buffer->_entries; my $entry = $entries->{$id}; is( scalar(keys %$entries), 1, "one entry" ); isnt( refaddr($entry->data), refaddr($obj), "refaddr doesn't equal" ); ok( !blessed($entry->data), "entry data is not blessed" ); is( reftype($entry->data), reftype($obj), "reftype" ); my $sl = $l->live_objects->new_scope; my $expanded = $l->expand_object($entry); isa_ok( $expanded, "KiokuDB_Test_Foo", "expanded object" ); isnt( refaddr($expanded), refaddr($obj), "refaddr doesn't equal" ); isnt( refaddr($expanded), refaddr($entry->data), "refaddr doesn't entry data refaddr" ); ok( !exists($entry->data->{junk}), "DoNotSerialize trait honored" ); is( $expanded->junk, "barf", "junk attr" ); SKIP: { skip "MooseX::Storage required for DoNotSerialize test", 2 unless HAVE_MX_STORAGE; ok( !exists($entry->data->{trash}), "DoNotSerialize trait honored" ); is( $expanded->trash, "lala", "trash attr" ); } is_deeply( $expanded, $obj, "is_deeply" ); } { my $s = $v->live_objects->new_scope; my $bar = $deep->bar; my ( $buffer, $id ) = $v->collapse( objects => [ $deep ], ); my $entries = $buffer->_entries; my $entry = $entries->{$id}; if ( $intrinsic ) { is( scalar(keys %$entries), 1, "one entry" ); } else { is( scalar(keys %$entries), 2, "two entries" ); ok( exists($entries->{the_bar}), "custom ID exists" ); is( $entries->{the_bar}->class, "KiokuDB_Test_Bar", "right object" ); } isnt( refaddr($entry->data), refaddr($deep), "refaddr doesn't equal" ); ok( !blessed($entry->data), "entry data is not blessed" ); is( reftype($entry->data), reftype($deep), "reftype" ); if ( $intrinsic ) { is_deeply( $entry->data, {%$deep, bar => KiokuDB::Entry->new( class => "KiokuDB_Test_Bar", data => {%$bar}, object => $bar, class_version => $KiokuDB_Test_Bar::VERSION ) }, "is_deeply" ); } else { is_deeply( $entry->data, {%$deep, bar => KiokuDB::Reference->new( id => "the_bar" ) }, "is_deeply" ); } my $sl = $l->live_objects->new_scope; $l->live_objects->register_entry( $_->id => $_ ) for values %$entries; my $expanded = try { $l->expand_object($entry) }; isa_ok( $expanded, "KiokuDB_Test_Foo", "expanded object" ); isnt( refaddr($expanded), refaddr($deep), "refaddr doesn't equal" ); isnt( refaddr($expanded), refaddr($entry->data), "refaddr doesn't entry data refaddr" ); is_deeply( $expanded, $deep, "is_deeply" ); is( $expanded->bar->id, "the_bar", "ID attr preserved even if not used" ); } { my $s = $v->live_objects->new_scope; my ( $buffer, $id ) = $v->collapse( objects => [ $anon_parent ] ); my $entries = $buffer->_entries; my $entry = $entries->{$id}; if ( $intrinsic ) { is( scalar(keys %$entries), 1, "one entry" ); } else { is( scalar(keys %$entries), 2, "two entries" ); ok( exists($entries->{runtime_role}), "custom ID exists" ); is( $entries->{runtime_role}->class, "KiokuDB_Test_Bar", "right object" ); } isnt( refaddr($entry->data), refaddr($anon_parent), "refaddr doesn't equal" ); ok( !blessed($entry->data), "entry data is not blessed" ); is( reftype($entry->data), reftype($anon_parent), "reftype" ); if ( $intrinsic ) { is_deeply( $entry->data, { bar => KiokuDB::Entry->new( class => "KiokuDB_Test_Bar", data => {%$with_anon}, class_meta => { roles => [qw(KiokuDB_Test_Gorch)] }, object => $with_anon ), }, "is_deeply" ); } else { is_deeply( $entry->data, {bar => KiokuDB::Reference->new( id => "runtime_role" ) }, "is_deeply" ); } my $sl = $l->live_objects->new_scope; $l->live_objects->register_entry( $_->id => $_ ) for values %$entries; my $expanded = try { $l->expand_object($entry) }; isa_ok( $expanded, "KiokuDB_Test_Foo", "expanded object" ); isa_ok( $expanded->bar, "KiokuDB_Test_Bar", "inner obeject" ); is( $expanded->bar->id, "runtime_role", "ID attr preserved even if not used" ); does_ok( $expanded->bar, "KiokuDB_Test_Gorch" ); ok( $expanded->bar->meta->is_anon_class, "anon class" ); } { my $s = $v->live_objects->new_scope; my ( $buffer, $id ) = $v->collapse( objects => [ $obj_with_value ] ); my $entries = $buffer->_entries; my $entry = $entries->{$id}; is( scalar(keys %$entries), 1, "one entry" ); isnt( refaddr($entry->data), refaddr($obj_with_value), "refaddr doesn't equal" ); ok( !blessed($entry->data), "entry data is not blessed" ); is( reftype($entry->data), reftype($obj_with_value), "reftype" ); is_deeply( $entry->data, { foo => KiokuDB::Entry->new( class => "KiokuDB_Test_Value", data => { %{ $obj_with_value->foo } }, object => $obj_with_value->foo, ), }, "is_deeply" ); my $sl = $l->live_objects->new_scope; $l->live_objects->register_entry( $_->id => $_ ) for values %$entries; my $expanded = try { $l->expand_object($entry) }; isa_ok( $expanded, "KiokuDB_Test_Foo", "expanded object" ); isa_ok( $expanded->foo, "KiokuDB_Test_Value", "inner obeject" ); } { my $s = $v->live_objects->new_scope; my ( $buffer, $id ) = $v->collapse( objects => [ $once ] ); my $entries = $buffer->_entries; is( scalar(keys %$entries), 1, "one entry" ); my $entry = $entries->{$id}; is( ref($entry), "KiokuDB::Entry", "normal entry" ); isnt( refaddr($entry->data), refaddr($once), "refaddr doesn't equal" ); ok( !blessed($entry->data), "entry data is not blessed" ); is( reftype($entry->data), reftype($once), "reftype" ); is_deeply( $entry->data, { %$once }, "is_deeply" ); $v->live_objects->update_entries( map { $_->object => $_ } values %$entries ); my ( $new_entries, $new_id ) = $v->collapse( objects => [ $once ] ); is( $new_id, $id, "ID is the same" ); ok( !exists($new_entries->{$id}), "skipped entry on second insert" ); } { my $s = $v->live_objects->new_scope; my ( $buffer, $id ) = $v->collapse( objects => [ $deep ], ); my $entries = $buffer->_entries; my $entry = $entries->{$id}; my $sl = $l->live_objects->new_scope; $l->backend->insert( values %$entries ); my $expanded = try { $l->expand_object($entry) }; isa_ok( $expanded, "KiokuDB_Test_Foo", "expanded object" ); my $bar_addr = refaddr($expanded->bar); my $clone = $entry->derive( data => { %{ $entry->data }, foo => "henry", }, ); $l->backend->insert($clone); is( $expanded->foo, "la", "attr value" ); $l->refresh_object($expanded); is( $expanded->foo, "henry", "attr refreshed" ); if ( $intrinsic ) { isnt( refaddr($expanded->bar), $bar_addr, "bar recreated" ); } else { is( refaddr($expanded->bar), $bar_addr, "bar left in place" ); } } { my $id = $v->generate_uuid; { # no class_version my $entry = KiokuDB::Entry->new( class => 'KiokuDB_Test_Foo', data => { foo => 'test', }, id => $id, ); $l->backend->insert($entry); } my $s = $l->live_objects->new_scope; my $expanded = try { $l->get_or_load_object($id) } catch { fail "error: $_"; }; isa_ok( $expanded, "KiokuDB_Test_Foo", "expanded object upgraded" ); my $upgraded = $l->backend->get($id); isa_ok( $upgraded, "KiokuDB::Entry", "upgraded entry written back" ); is( $upgraded->class_version, '0.02', "correct class version" ); } unless ( $intrinsic ) { my $id = $v->generate_uuid; { # no class_version my $entry = KiokuDB::Entry->new( class => 'KiokuDB_Test_Bar', data => { id => $id, blah => "test" }, id => $id, ); $l->backend->insert($entry); } my $s = $l->live_objects->new_scope; my $expanded = try { $l->get_or_load_object($id) } catch { fail "error: $_"; }; isa_ok( $expanded, "KiokuDB_Test_Bar", "expanded object upgraded" ); my $upgraded = $l->backend->get($id); isa_ok( $upgraded, "KiokuDB::Entry", "upgraded entry written back" ); is( $upgraded->class_version, '0.03', "correct class version" ); } { my $id = $v->generate_uuid; { # no class_version my $entry = KiokuDB::Entry->new( class_version => "0.01", class => 'KiokuDB_Test_Once', data => { name => 'test', }, id => $id, ); $l->backend->insert($entry); } my $s = $l->live_objects->new_scope; my $expanded = try { $l->get_or_load_object($id) } catch { fail "error: $_"; }; isa_ok( $expanded, "KiokuDB_Test_Once", "expanded object upgraded" ); my $upgraded = $l->backend->get($id); isa_ok( $upgraded, "KiokuDB::Entry", "upgraded entry written back" ); is( $upgraded->class_version, '0.03', "correct class version" ); } } done_testing; Backend.pm100644001750000144 1622112237006576 16105 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBpackage KiokuDB::Backend; BEGIN { $KiokuDB::Backend::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Backend interface role use Moose::Util::TypeConstraints; use Try::Tiny; use namespace::clean -except => 'meta'; coerce ( __PACKAGE__, from HashRef => via { my %p = %$_; my $class = delete $p{class} || die "Can't coerce backend from hash without a 'class' parameter"; try { Class::MOP::load_class("KiokuDB::Backend::$class"); "KiokuDB::Backend::$class"->new(%p); } catch { Class::MOP::load_class($class); $class->new(%p); }; }, ); requires qw( exists insert get delete ); sub new_from_dsn { my ( $class, $params, @extra ) = @_; if ( defined $params ) { $class->new_from_dsn_params($class->parse_dsn_params($params), @extra); } else { return $class->new(@extra); } } sub new_from_dsn_params { my ( $class, @params ) = @_; $class->new(@params); } sub parse_dsn_params { my ( $self, $params ) = @_; my @pairs = split ';', $params; return map { my ( $key, $value ) = /(\w+)(?:=(.*))/; length($value) ? ( $key, $value ) : ( $key => 1 ); } @pairs; } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend - Backend interface role =head1 VERSION version 0.56 =head1 SYNOPSIS package KiokuDB::Backend::Foo; use Moose; # load the core api and additional interfaces based on backend capabilities with qw( KiokuDB::Backend KiokuDB::Backend::Role::TXN KiokuDB::Backend::Role::Clear KiokuDB::Backend::Role::Scan KiokuDB::Backend::Role::UnicodeSafe KiokuDB::Backend::Role::BinarySafe ); sub insert { ... } sub get { ... } sub delete { ... } sub exists { ... } # use the backend like this: my $dir = KiokuDB->new( backend => KiokuDB::Backend::Foo->new( ); ); =head1 DESCRIPTION L is designed to be fairly backend agnostic. This role defines the minimal API for writing new backends. =head1 TRANSACTIONS This role is supplemented by L, a role for first class transaction support that issues rollbacks using the L objects. =head1 QUERYING This role is supplemented by L, a role for backend specific queries. L provides a universal query api for backends that can perform property based lookup. L is a role for using L based indexing/querying with backends that do not natively support querying. =head1 REQUIRED METHODS =over 4 =item get @ids Retrieve the L objects associated with the @ids. If any other error is encountered, this method should die. The backend may store private data in C, to be used in a subsequent update. Returns a list of L, with the order corresponding to C<@ids>. If an entry does not exist then C should be returned in place of it. The backend may abort retrieval on the first non existent entry. =item insert @entries Insert entries to the store. If the backend is transactional this operation should be atomic with respect to the inserted/updated data. The backend is required to store the data in the fields C, C using the key in C. Entries which have an entry in C denote updates (either objects that have been previously stored, or objects that were looked up). The previous entry may be used to compare state for issuing a partial update, and will contain the value of C for any other state tracking. C is a weak reference to the object this entry is representing, and may be used for high level indexing. Do not use this field for storage. If this backend implements some form of garbage collection, C denotes that the objects is part of the root set. After all entries have been successfully written, C should be set if necessary just as in C. Has no return value. If C does not die the write is assumed to be successful. =item delete @ids_or_entries Delete the specified IDs or entries. If the user provided objects then entries will be passed in. Any associated state the entries may have (e.g. a revision) should be used in order to enforce atomicity with respect to the time when the objects were loaded. After all entries have been successfully deleted, C should be set. The entry passed in is the same one as was loaded by C or last written by C, so it is already up to date in the live objects. Has no return value. If C does not die the write is assumed to be successful. =item exists @ids Check for existence of the specified IDs, without retrieving their data. Returns a list of true or false values. =back =head1 METHODS These methods are provided by the L role, and may be overridden. =over 4 =item new_from_dsn Parses the second half of the DSN using C and instantiates a new object using C. See L. =item new_from_dsn_params @args Takes DSN parameters and converts them to arguments suitable for C =item parse_dsn_params $str The string is split on C<;> to produce arguments. Arguments in the form C are split on C<=> into a key/value pair, and other arguments are treated as a boolean key and returned as C<< $arg => 1 >>. =back =head1 ADDITIONAL INTERFACES Your backend may include more roles, based on its capabilities. =over 4 =item L =item L For the actual serialization of entries, there are a number of serialization roles. =item L API for clearing all entries. =item L API for enumerating entries. =item L =item L If your serialization is able to store arbitrary binary data and/or unicode strings, these informational roles should be included. =item L If your storage supports nested transactions (C, C etc) this role provides the api to expose that functionality to the high level L api. =item L =item L If your backend supports querying of some sort, these are the roles to include. The querying API uses backend specific lookups to fetch entries, which L will then relink into result objects. =back =head1 SHARED BACKENDS A backend may be shared by several L instances, each with its own distinct live object set. The backend may choose to share cached entry B, as that is not mutated by L, but not the L instances themselves. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut TypeMap.pm100644001750000144 1377612237006576 16151 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBpackage KiokuDB::TypeMap; BEGIN { $KiokuDB::TypeMap::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::VERSION = '0.56'; } use Moose; # ABSTRACT: Class to collapsing/expanding logic. use Carp qw(croak); use Try::Tiny; use KiokuDB::TypeMap::Entry; use KiokuDB::TypeMap::Entry::Alias; use namespace::clean -except => 'meta'; with qw(KiokuDB::Role::TypeMap); has [qw(entries isa_entries)] => ( #isa => "HashRef[KiokuDB::TypeMap::Entry|KiokuDB::TypeMap::Entry::Alias]", # dog slow regex is => "ro", lazy_build => 1, ); sub _build_entries { +{} } sub _build_isa_entries { +{} } has [qw(all_entries all_isa_entries)] => ( #isa => "HashRef[KiokuDB::TypeMap::Entry|KiokuDB::TypeMap::Entry::Alias]", # dog slow regex is => "ro", lazy_build => 1, ); has all_isa_entry_classes => ( isa => "ArrayRef[Str]", is => "ro", lazy_build => 1, ); has includes => ( isa => "ArrayRef[KiokuDB::TypeMap]", is => "ro", lazy_build => 1, ); sub _build_includes { [] } my %loaded; sub resolve { my ( $self, $class ) = @_; # if we're linking the class might not be loaded yet unless ( $loaded{$class}++ ) { ( my $pmfile = $class . ".pm" ) =~ s{::}{/}g; try { require $pmfile; } catch { croak $_ unless /Can't locate \Q$pmfile\E in \@INC/; }; } # if this is an anonymous class, redo the lookup using a single named # ancestor if ( my $meta = Class::MOP::get_metaclass_by_name($class) ) { if ( $meta->is_anon_class ) { my $ancestor = $meta; search: { my @super = $ancestor->superclasses; if ( @super == 1 ) { $ancestor = Class::MOP::get_metaclass_by_name($super[0]); if ( $ancestor->is_anon_class ) { redo search; } } else { croak "Cannot resolve anonymous class with multiple inheritence: $class"; } } return $self->resolve( $ancestor->name ); } } if ( my $entry = $self->all_entries->{$class} || $self->all_isa_entries->{$class} ) { return $self->resolve_entry( $entry ); } else { foreach my $superclass ( @{ $self->all_isa_entry_classes } ) { if ( $class->isa($superclass) ) { return $self->resolve_entry( $self->all_isa_entries->{$superclass} ); } } } return; } sub resolve_entry { my ( $self, $entry ) = @_; if ( $entry->isa("KiokuDB::TypeMap::Entry::Alias") ) { return $self->resolve( $entry->to ); } else { return $entry; } } sub BUILD { my $self = shift; # verify that there are no conflicting internal definitions my $reg = $self->entries; foreach my $key ( keys %{ $self->isa_entries } ) { if ( exists $reg->{$key} ) { croak "isa entry $key already present in plain entries"; } } # Verify that there are no conflicts between the includesd type maps my %seen; foreach my $map ( @{ $self->includes } ) { foreach my $key ( keys %{ $map->all_entries } ) { if ( $seen{$key} ) { croak "entry $key found in $map conflicts with $seen{$key}"; } $seen{$key} = $map; } foreach my $key ( keys %{ $map->all_isa_entries } ) { if ( $seen{$key} ) { croak "isa entry $key found in $map conflicts with $seen{$key}"; } $seen{$key} = $map; } } } sub _build_all_entries { my $self = shift; return { map { %$_ } ( ( map { $_->all_entries } @{ $self->includes } ), $self->entries, ), }; } sub _build_all_isa_entries { my $self = shift; return { map { %$_ } ( ( map { $_->all_isa_entries } @{ $self->includes } ), $self->isa_entries, ), }; } sub _build_all_isa_entry_classes { my $self = shift; return [ sort { !$a->isa($b) <=> !$b->isa($a) } # least derived first keys %{ $self->all_isa_entries } ]; } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap - Class to collapsing/expanding logic. =head1 VERSION version 0.56 =head1 SYNOPSIS use KiokuDB::TypeMap; KiokuDB::TypeMap->new( entries => { 'Foo' => KiokuDB::TypeMap::Entry::Naive->new, }, isa_entries => { 'My::Class' => KiokuDB::TypeMap::Entry::Naive->new, }, includes => [ $typemap_foo, $typemap_bar, ], ); =head1 DESCRIPTION The L typemap maps classes to L objects. The mapping is by class, and entries can be keyed normally (using C equality) or by filtering on C<< $object->isa($class) >> (C). =head1 ATTRIBUTES =over 4 =item entries A hash of normal entries. =item isa_entries A hash of C<< $object->isa >> based entries. =item includes A list of parent typemaps to inherit entries from. =back =head1 METHODS =over 4 =item resolve $class Given a class returns the C object corresponding to that class. Called by L =item resolve_entry $entry If the entry is an alias, it will be resolved recursively, and simply returned otherwise. =item all_entries Returns the merged C from this typemap and all the included typemaps. =item all_isa_entries Returns the merged C from this typemap and all the included typemaps. =item all_isa_entry_classes An array reference of all the classes in C, sorted from least derived to most derived. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Role000755001750000144 012237006576 14737 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBID.pm100644001750000144 253612237006576 15737 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Rolepackage KiokuDB::Role::ID; BEGIN { $KiokuDB::Role::ID::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Role::ID::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: A role for objects who choose their own ID. use namespace::clean -except => 'meta'; requires "kiokudb_object_id"; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Role::ID - A role for objects who choose their own ID. =head1 VERSION version 0.56 =head1 SYNOPSIS # typically you set up your own ID role, and map the C # method to your schema's ID package MySchema::ID; use Moose::Role; with qw(KiokuDB::Role::ID); sub kiokudb_object_id { shift->id }; requires "id"; package MySchema::Foo; use Moose; with qw(MySchema::ID); sub id { ... } =head1 DESCRIPTION This role provides a way for objects to determine their own IDs. You must implement or alias the C method to return a string. =head1 REQUIRED METHODS =over 4 =item kiokudb_object_id Should return a string to be used as the ID of the object. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Set000755001750000144 012237006576 14571 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBBase.pm100644001750000144 115012237006576 16136 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Setpackage KiokuDB::Set::Base; BEGIN { $KiokuDB::Set::Base::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Set::Base::VERSION = '0.56'; } use Moose; use namespace::clean -except => 'meta'; __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Set::Base =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut API.pm100644001750000144 372412237006576 16054 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Rolepackage KiokuDB::Role::API; BEGIN { $KiokuDB::Role::API::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Role::API::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Role for KiokuDB api (used to setup delegations). use namespace::clean -except => 'meta'; requires qw( new_scope txn_do scoped_txn lookup exists store store_nonroot insert insert_nonroot update deep_update delete is_root set_root unset_root search all_objects root_set grep scan clear_live_objects new_scope object_to_id objects_to_ids id_to_object ids_to_objects live_objects directory ); __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Role::API - Role for KiokuDB api (used to setup delegations). =head1 VERSION version 0.56 =head1 SYNOPSIS has directory => ( isa => "KiokuDB", handles => "KiokuDB::Role::API", ); =head1 DESCRIPTION This role provides C declarations for the runtime methods of L. This is useful for setting up delegations. This is used in e.g. L. =head1 METHODS =over 4 =item new_scope =item txn_do =item lookup =item exists =item store =item insert =item update =item deep_update =item delete =item is_root =item set_root =item unset_root =item search =item all_objects =item root_set =item grep =item scan =item clear_live_objects =item new_scope =item object_to_id =item objects_to_ids =item id_to_object =item ids_to_objects =item live_objects =item directory The C method should be used to fetch the actual L delegate. This will work no matter how deeply it is nested. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut GC000755001750000144 012237006576 14327 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBNaive.pm100644001750000144 430012237006576 16064 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/GCpackage KiokuDB::GC::Naive; BEGIN { $KiokuDB::GC::Naive::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::GC::Naive::VERSION = '0.56'; } use Moose; # ABSTRACT: Naive mark and sweep garbage collection use KiokuDB::GC::Naive::Mark; use KiokuDB::GC::Naive::Sweep; use namespace::clean -except => 'meta'; with qw(KiokuDB::Role::Verbosity); has backend => ( does => "KiokuDB::Backend::Role::Scan", is => "ro", required => 1, ); has [qw(mark_scan sweep_scan)] => ( is => "ro", lazy_build => 1, ); sub _build_mark_scan { my $self = shift; KiokuDB::GC::Naive::Mark->new( backend => $self->backend, verbose => $self->verbose, ); } sub _build_sweep_scan { my $self = shift; my $mark_results = $self->mark_results; $self->v("sweeping...\n"); KiokuDB::GC::Naive::Sweep->new( backend => $self->backend, verbose => $self->verbose, mark_results => $mark_results, ); } has mark_results => ( isa => "KiokuDB::GC::Naive::Mark::Results", is => "ro", handles => qr/.*/, lazy_build => 1, ); sub _build_mark_results { my $self = shift; $self->v("marking reachable objects...\n"); return $self->mark_scan->results; } has sweep_results => ( isa => "KiokuDB::GC::Naive::Sweep::Results", is => "ro", handles => qr/.*/, lazy_build => 1, ); sub _build_sweep_results { my $self = shift; return $self->sweep_scan->results; } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::GC::Naive - Naive mark and sweep garbage collection =head1 VERSION version 0.56 =head1 SYNOPSIS use KiokuDB::GC::Naive; my $gc = KiokuDB::GC::Naive->new( backend => $backend, ); $backend->delete( $gc->garbage->members ); =head1 DESCRIPTION This class implements full mark and sweep garbage collection for a backend supporting L. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut jspon_serialization.t100644001750000144 770012237006576 16662 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use KiokuDB::Backend::Serialize::JSPON; use KiokuDB::Backend::Serialize::JSON; use KiokuDB::Entry; use KiokuDB::Reference; { package KiokuDB_Test_Foo; use Moose; with qw(KiokuDB::Backend::Serialize::JSON); } my $entry = KiokuDB::Entry->new( id => "foo", class => "Hello", class_meta => { roles => [qw(Greeting)], }, root => 1, data => { id => "id_attribute", bar => KiokuDB::Reference->new( id => "bar", is_weak => 1 ), foo => { '$ref' => "lala" }, 'public::moose' => 'elk', }, ); my $tied = KiokuDB::Entry->new( tied => "H", data => KiokuDB::Entry->new( id => "bar", data => { foo => "bar", }, ), ); { my $x = KiokuDB_Test_Foo->new; does_ok( $x, "KiokuDB::Backend::TypeMap::Default" ); does_ok( $x, "KiokuDB::Backend::Serialize" ); isa_ok( $x->default_typemap, "KiokuDB::TypeMap::Default::JSON" ); isa_ok( $x->collapser, "KiokuDB::Backend::Serialize::JSPON::Collapser" ); isa_ok( $x->expander, "KiokuDB::Backend::Serialize::JSPON::Expander" ); my $jspon = $x->collapse_jspon($entry); is_deeply( $jspon, { __CLASS__ => "Hello", __META__ => { roles => [qw(Greeting)] }, id => "foo", data => { "public::id" => "id_attribute", bar => { '$ref' => "bar.data", weak => 1 }, foo => { 'public::$ref' => "lala" }, 'public::public::moose' => "elk", }, root => JSON::true, }, "collapsed jspon", ); my $obj = $x->expand_jspon($jspon); is_deeply( $obj->data, $entry->data, "expanded jspon" ); is( $obj->id, "foo", "ID" ); is( $obj->class, "Hello", "class" ); ok( !$obj->deleted, "not deleted" ); ok( $obj->root, "root" ); my $json = $x->serialize($entry); ok( !ref($json), "json is not a ref" ); ok( !utf8::is_utf8($json), "already encoded (not unicode)" ); is_deeply( $x->deserialize($json), $entry, "round tripping" ); } { my $x = KiokuDB_Test_Foo->new( id_field => "_id", class_field => "class", inline_data => 1, ); my $jspon = $x->collapse_jspon($entry); is_deeply( $jspon, { class => "Hello", __META__ => { roles => [qw(Greeting)] }, _id => "foo", root => JSON::true, id => "id_attribute", bar => { '$ref' => "bar", weak => 1 }, foo => { 'public::$ref' => "lala" }, 'public::public::moose' => "elk", }, "collapsed jspon", ); my $obj = $x->expand_jspon($jspon); is_deeply( $obj->data, $entry->data, "expanded jspon" ); is( $obj->id, "foo", "ID" ); is( $obj->class, "Hello", "class" ); ok( !$obj->deleted, "not deleted" ); ok( $obj->root, "root" ); } { my $x = KiokuDB_Test_Foo->new; my $jspon = $x->collapse_jspon($tied); is_deeply( $jspon, { tied => "H", data => { id => "bar", data => { foo => "bar" }, }, }, "collapsed jspon", ); my $obj = $x->expand_jspon($jspon); isa_ok( $obj->data, "KiokuDB::Entry" ); is_deeply( $obj->data->data, $tied->data->data, "expanded jspon" ); ok( !$obj->has_id, "no id" ); ok( !$obj->has_class, "no class" ); ok( !$obj->deleted, "not deleted" ); ok( !$obj->root, "not root" ); is( $obj->tied, "H", "'tied' field" ); $jspon->{tied} = "HASH"; my $legacy = $x->expand_jspon($jspon); is( $legacy->tied, "H", "legacy 'tied' field upgraded" ); } done_testing; typemap_entry_naive.t100644001750000144 610712237006576 16656 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Scalar::Util qw(refaddr reftype blessed); use KiokuDB::TypeMap::Entry::Naive; use KiokuDB::TypeMap::Resolver; use KiokuDB::Collapser; use KiokuDB::Linker; use KiokuDB::LiveObjects; use KiokuDB::Backend::Hash; { package KiokuDB_Test_Foo; use Moose; has foo => ( is => "rw" ); has bar => ( is => "rw", isa => "KiokuDB_Test_Bar" ); package KiokuDB_Test_Bar; use Moose; has blah => ( is => "rw" ); } my $obj = KiokuDB_Test_Foo->new( foo => "HALLO" ); my $deep = KiokuDB_Test_Foo->new( foo => "la", bar => KiokuDB_Test_Bar->new( blah => "hai" ) ); my $n = KiokuDB::TypeMap::Entry::Naive->new(); my $i = KiokuDB::TypeMap::Entry::Naive->new( intrinsic => 1 ); my $tr = KiokuDB::TypeMap::Resolver->new( typemap => KiokuDB::TypeMap->new( entries => { KiokuDB_Test_Foo => $n, KiokuDB_Test_Bar => $i, }, ), ); my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => KiokuDB::LiveObjects->new, typemap_resolver => $tr, ); my $l = KiokuDB::Linker->new( backend => KiokuDB::Backend::Hash->new, live_objects => KiokuDB::LiveObjects->new, typemap_resolver => $tr, ); { my $s = $v->live_objects->new_scope; my ( $buffer ) = $v->collapse( objects => [ $obj ], ); my $entries = $buffer->_entries; is( scalar(keys %$entries), 1, "one entry" ); my $entry = ( values %$entries )[0]; isnt( refaddr($entry->data), refaddr($obj), "refaddr doesn't equal" ); ok( !blessed($entry->data), "entry data is not blessed" ); is( reftype($entry->data), reftype($obj), "reftype" ); is_deeply( $entry->data, {%$obj}, "is_deeply" ); my $sl = $l->live_objects->new_scope; my $expanded = $l->expand_object($entry); isa_ok( $expanded, "KiokuDB_Test_Foo", "expanded object" ); isnt( refaddr($expanded), refaddr($obj), "refaddr doesn't equal" ); isnt( refaddr($expanded), refaddr($entry->data), "refaddr doesn't entry data refaddr" ); is_deeply( $expanded, $obj, "is_deeply" ); } { my $s = $v->live_objects->new_scope; my $bar = $deep->bar; my ( $buffer ) = $v->collapse( objects => [ $deep ], ); my $entries = $buffer->_entries; is( scalar(keys %$entries), 1, "one entry" ); my $entry = ( values %$entries )[0]; isnt( refaddr($entry->data), refaddr($deep), "refaddr doesn't equal" ); ok( !blessed($entry->data), "entry data is not blessed" ); is( reftype($entry->data), reftype($deep), "reftype" ); is_deeply( $entry->data, {%$deep, bar => KiokuDB::Entry->new( class => "KiokuDB_Test_Bar", data => {%$bar}, object => $bar ) }, "is_deeply" ); my $sl = $l->live_objects->new_scope; my $expanded = $l->expand_object($entry); isa_ok( $expanded, "KiokuDB_Test_Foo", "expanded object" ); isnt( refaddr($expanded), refaddr($deep), "refaddr doesn't equal" ); isnt( refaddr($expanded), refaddr($entry->data), "refaddr doesn't entry data refaddr" ); is_deeply( $expanded, $deep, "is_deeply" ); } done_testing; pod-syntax.t100644001750000144 21212237006576 16461 0ustar00doyusers000000000000KiokuDB-0.56/xt/release#!perl use Test::More; eval "use Test::Pod 1.41"; plan skip_all => "Test::Pod 1.41 required for testing POD" if $@; all_pod_files_ok(); Reference.pm100644001750000144 311412237006576 16431 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBpackage KiokuDB::Reference; BEGIN { $KiokuDB::Reference::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Reference::VERSION = '0.56'; } use Moose; # ABSTRACT: A symbolic reference to another KiokuDB::Entry. use namespace::clean -except => 'meta'; with qw(MooseX::Clone); has id => ( isa => "Str", is => "rw", required => 1, ); has is_weak => ( isa => "Bool", is => "rw", ); sub STORABLE_freeze { my ( $self, $cloning ) = @_; join(",", $self->id, !!$self->is_weak); # FIXME broken } sub STORABLE_thaw { my ( $self, $cloning, $serialized ) = @_; my ( $id, $weak ) = ( $serialized =~ /^(.*?),(1?)$/ ); $self->id($id); $self->is_weak(1) if $weak; return $self; } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Reference - A symbolic reference to another KiokuDB::Entry. =head1 VERSION version 0.56 =head1 SYNOPSIS my $ref = KiokuDB::Reference->new( id => $some_id, ); =head1 DESCRIPTION This object serves as an internal marker to point to entries by UID. The linker resolves these references by searching the live object set and loading entries from the backend as necessary. =head1 ATTRIBUTES =over 4 =item id The ID this entry refers to =item is_weak This reference is weak. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Collapser.pm100644001750000144 3316512237006576 16510 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBpackage KiokuDB::Collapser; BEGIN { $KiokuDB::Collapser::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Collapser::VERSION = '0.56'; } use Moose; # ABSTRACT: Collapse object hierarchies to entry data no warnings 'recursion'; use Scope::Guard; use Carp qw(croak); BEGIN { local $@; eval 'use Devel::PartialDump qw(croak)' }; use Scalar::Util qw(isweak refaddr reftype); use Moose::Util qw(does_role); use KiokuDB::Entry; use KiokuDB::Entry::Skip; use KiokuDB::Reference; use KiokuDB::Collapser::Buffer; use KiokuDB::Error::UnknownObjects; use Data::Visitor 0.24; use Set::Object qw(set); use namespace::clean -except => 'meta'; extends qw(Data::Visitor); with qw(KiokuDB::Role::UUIDs); has '+tied_as_objects' => ( default => 1 ); has live_objects => ( isa => "KiokuDB::LiveObjects", is => "ro", required => 1, ); has backend => ( does => "KiokuDB::Backend", is => "ro", required => 1, ); has typemap_resolver => ( isa => "KiokuDB::TypeMap::Resolver", is => "ro", handles => [qw(collapse_method id_method)], required => 1, ); has compact => ( isa => "Bool", is => "rw", default => 1, ); has '+weaken' => ( default => 0, ); has '_buffer' => ( isa => "KiokuDB::Collapser::Buffer", is => "ro", clearer => "_clear_buffer", writer => "_set_buffer", ); sub collapse { my ( $self, %args ) = @_; my $objects = delete $args{objects}; my $r; if ( $args{shallow} ) { $args{only} = set(@$objects); } my $buf = KiokuDB::Collapser::Buffer->new( live_objects => $self->live_objects, options => \%args, ); my $g = Scope::Guard->new(sub { $self->_clear_buffer }); $self->_set_buffer($buf); # recurse through the object, accumilating entries $self->visit(@$objects); my @ids = $buf->merged_objects_to_ids(@$objects); $buf->first_class->insert(@ids); # compact UUID space by merging simple non shared structures into a single # deep entry $buf->compact_entries if $self->compact; return ( $buf, @ids ); } sub may_compact { my ( $self, $ref_or_id ) = @_; my $id = ref($ref_or_id) ? $ref_or_id->id : $ref_or_id; not $self->_buffer->first_class->includes($id); } sub make_entry { my ( $self, %args ) = @_; my $meta = delete $args{meta} || {}; my $object = $args{object}; if ( my $id = $args{id} ) { my $l = $self->live_objects; my $prev = $l->object_to_entry($object); if ( !$prev and $l->id_in_storage($id) ) { # FIXME Backend->store( insert => [ ... ], update => [ ... ] ) # this happens when keep_entries is false $prev = KiokuDB::Entry->new( root => $l->id_in_root_set($id) ); # force the operation to be an update } my $entry = KiokuDB::Entry->new( ( $prev ? ( prev => $prev ) : () ), %args, ); $self->_buffer->insert_entry( $id => $entry, $object, %$meta ); return $entry; } else { # intrinsic my $entry = KiokuDB::Entry->new(%args); $self->_buffer->insert_intrinsic( $object => $entry, %$meta ); return $entry; } } sub make_skip_entry { my ( $self, %args ) = @_; my $object = $args{object}; my $prev = $args{prev} || $self->live_objects->object_to_entry($object); my $id = $args{id}; unless ( $id ) { croak "skip entries must have an ID" unless $prev; $id = $prev->id; } return undef; } sub make_ref { my ( $self, $id, $value ) = @_; my $weak = isweak($_[2]); $self->_buffer->first_class->insert($id) if $weak; return KiokuDB::Reference->new( id => $id, $weak ? ( is_weak => 1 ) : () ); } sub visit_seen { my ( $self, $seen, $prev ) = @_; my $b = $self->_buffer; if ( my $entry = $b->intrinsic_entry($seen) ) { return $entry->clone; } elsif ( my $id = $self->_buffer->object_to_id($seen) || $self->live_objects->object_to_id($seen) ) { $self->_buffer->first_class->insert($id) unless blessed($seen); # return a uuid ref return $self->make_ref( $id => $_[1] ); } else { KiokuDB::Error::UnknownObjects->throw( objects => [ $seen ] ); } } sub visit_ref_fallback { my ( $self, $ref ) = @_; my $o = $self->_buffer->options; if ( my $entry = $o->{only_in_storage} && $self->live_objects->object_to_entry($ref) ) { return $self->make_ref( $entry->id => $_[1] ); } if ( my $id = $self->_ref_id($ref) ) { if ( !$self->compact and my $only = $o->{only} ) { unless ( $only->contains($ref) ) { return $self->make_ref( $id => $_[1] ); } } my $collapsed = $self->visit_ref_data($_[1]); if ( ref($collapsed) eq 'KiokuDB::Reference' and $collapsed->id eq $id ) { return $collapsed; # tied } else { push @{ $self->_buffer->simple_entries }, $id; $self->make_entry( id => $id, object => $ref, data => $collapsed, ); return $self->make_ref( $id => $_[1] ); } } elsif ( $self->compact and not isweak($_[1]) ) { # for now we assume this data just won't be shared, instead of # compacting it later. return $self->SUPER::visit_ref($_[1]); } else { KiokuDB::Error::UnknownObjects->throw( objects => [ $ref ] ); } } sub visit_ref_data { my ( $self, $ref ) = @_; $self->SUPER::visit_ref($_[1]); } sub _ref_id { my ( $self, $ref ) = @_; my $l = $self->live_objects; if ( my $id = $l->object_to_id($ref) ) { return $id; } else { my $b = $self->_buffer; if ( $b->options->{only_known} ) { if ( $self->compact ) { # if we're compacting this is not an error, we just compact in place # and we generate an error if we encounter this data again in visit_seen return; } else { KiokuDB::Error::UnknownObjects->throw( objects => [ $ref ] ); } } else { my $id = $self->generate_uuid; $b->insert( $id => $ref ); return $id; } } } # avoid retying, we want to get back Reference or Entry objects sub visit_tied_hash { shift->visit_tied(@_) } sub visit_tied_array { shift->visit_tied(@_) } sub visit_tied_scalar { shift->visit_tied(@_) } sub visit_tied_glob { shift->visit_tied(@_) } sub visit_tied { my ( $self, $tied, $ref ) = @_; my $tie = $self->visit($tied); if ( my $id = $self->_ref_id($ref) ) { if ( !$self->compact and my $only = $self->_buffer->options->{only} ) { unless ( $only->contains($ref) ) { return $self->make_ref( $id => $_[1] ); } } push @{ $self->_buffer->simple_entries }, $id; $self->make_entry( id => $id, object => $ref, data => $tie, tied => substr(reftype($ref), 0, 1), ); return $self->make_ref( $id => $_[2] ); } else { return $self->make_entry( object => $ref, data => $tie, tied => substr(reftype($ref), 0, 1), ); } } sub visit_object { shift->visit_with_typemap(@_) } sub visit_ref { shift->visit_with_typemap(@_) } sub visit_with_typemap { my ( $self, $ref ) = @_; my $collapse = $self->collapse_method(ref $ref); shift->$collapse(@_); } sub collapse_first_class { my ( $self, $collapse, $object, @entry_args ) = @_; # Data::Visitor stuff for circular refs $self->_register_mapping( $object, $object ); my ( $l, $b ) = ( $self->live_objects, $self->_buffer ); my $id = $l->object_to_id($object); my $in_storage = $l->id_in_storage($id); my $o = $b->options; if ( $o->{only_in_storage} && $in_storage ) { die "bug" unless defined $id; return $self->make_ref( $id => $_[2] ); } if ( my $only = $o->{only} ) { unless ( $only->contains($object) ) { if ( $in_storage ) { die "bug" unless defined $id; return $self->make_ref( $id => $_[2] ); } else { KiokuDB::Error::UnknownObjects->throw( objects => [ $object ] ); } } } unless ( $id ) { if ( $o->{only_known} ) { KiokuDB::Error::UnknownObjects->throw( objects => [ $object ] ); } else { my $id_method = $self->id_method(ref $object); $id = $self->$id_method($object); if ( defined( my $conflict = $l->id_to_object($id) ) ) { return $self->id_conflict( $id, $_[2], $conflict ); } else { $b->insert( $id => $object ); } } } my @args = ( object => $object, id => $id, class => ref($object), @entry_args, ); $self->$collapse(@args); # we pass $_[1], an alias, so that isweak works return $self->make_ref( $id => $_[2] ); } sub id_conflict { my ( $self, $id, $object, $other ) = @_; if ( does_role($object, "KiokuDB::Role::ID::Content") and does_role($other, "KiokuDB::Role::ID::Content") ) { # FIXME delegate this knowlege to the typemap? what if $object and # $other have conflicting typemaps? $self->make_skip_entry( id => $id, object => $object ); $self->_buffer->insert( $id => $object ); return $self->make_ref( $id => $_[2] ); } else { croak "ID conflict when registering ", $object, ", '$id' is already in use by ", $other; } } sub collapse_intrinsic { my ( $self, $collapse, $object, @entry_args ) = @_; my $class = ref $object; my @args = ( object => $object, class => $class, @entry_args, ); return $self->$collapse(@args); } # we don't reblass in collapse_naive sub retain_magic { my ( $self, $proto, $clone ) = @_; return $clone; } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Collapser - Collapse object hierarchies to entry data =head1 VERSION version 0.56 =head1 SYNOPSIS # mostly internal =head1 DESCRIPTION The collapser simplifies real objects into L objects to pass to the backend. Non object data is collapsed by walking it with L (which L inherits from). Object collapsing is detailed in L. The object's data will be copied into the L with references to other data structures translated into L objects. Reference addresses are mapped to unique identifiers, which are generated as necessary. =head2 Compacting If C is disabled then every reference is symbolic, and every data structure has an entry. If compacting is enabled (the default) the minimum number of entry objects required for consistency is created. Every blessed, shared or tied data structure requires an entry object, as does every target of a weak reference. "Simple" structures, such as plain hashes/arrays will be left inline as data intrinsic to the object it was found in. Compacting is usually desirable, but sometimes isn't (for instance with an RDF like store). =head1 COLLAPSING STRATEGIES Collapsing strategies are chosen based on the type of the object being collapsed, using L. The resolver consults the typemap (L), and caches the results as keyed by C. The typemap contains normal entries (keyed by C) or isa entries (filtered by C<< $object->isa($class) >>). The rationale is that a typemap entry for a superclass might not support all subclasses as well. Any strategy may be collapsed as a first class object, or intrinsically, inside its parent (in which case it isn't assigned a UUID). This is determined based on the C attribute to the entry. For instance, if L related objects should be collapsed as if they are values, the following typemap entry can be used: isa_entries => { 'Path::Class::Entity' => KiokuDB::TypeMap::Entry::Callback->new( intrinsic => 1, collapse => "stringify", expand => "new", ), }, If no typemap entry exists, L is used by default. See L for more details. These are the strategies in brief: =head2 MOP When the object has a L registered metaclass (any L object, but not only), the MOP is used to walk the object's attributes and construct the simplified version without breaking encapsulation. See L. =head2 Naive This collapsing strategy simply walks the object's data using L. This allows collapsing of L based objects, for instance, but should be used with care. See L =head2 Callback This collapsing strategy allows callbacks to be used to map the types. It is more limited than the other strategies, but very convenient for simple values. See L for more details. =head2 Passthrough This delegates collapsing to the backend serialization. This is convenient for when a backend uses e.g. L to serialize entries, and the object in question already has a C and C method. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Tutorial.pod100644001750000144 5655712237006576 16547 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB=pod =head1 NAME KiokuDB::Tutorial - Getting started with KiokuDB =head1 INSTALLATION The easiest way to install L along with a number of backends is L. L depends on L and a few other modules out of the box, but no specific storage module. L is a frontend to several backends, much like L uses DBDs to connect to actual databases. For development and testing you can use the L backend, which is an in memory store, but for production use L or L are the recommended backends. See below for instructions on getting L installed. =head1 CREATING A DIRECTORY HANDLE A KiokuDB directory is the main object through which all work is done. The simplest directory that is ready for use can be created like this: my $dir = KiokuDB->new( backend => KiokuDB::Backend::Hash->new ); We will revisit other more interesting backend configuration later in this document, but for now this will do. You can also use DSN strings to connect to the various backends: KiokuDB->connect("hash"); KiokuDB->connect("dbi:SQLite:dbname=foo", create => 1); KiokuDB->connect("bdb:dir=foo", create => 1); You can also use a configuration file: KiokuDB->connect("/path/to/my_db.yml"); Which is just a YAML file: --- # these are basically the arguments for 'new' backend: class: KiokuDB::Backend::DBI dsn: dbi:SQLite:dbname=/tmp/test.db create: 1 =head1 USING THE DBI BACKEND During this tutorial we will be using the DBI backend for two reasons. The first is L's ubiquity. The second is the possibility of easily looking behind the scenes, to more clearly demonstrate what L is doing. That said, the examples will work with all backends exactly the same. First we create C<$dir>: my $dir = KiokuDB->connect( "dbi:SQLite:dbname=kiokudb_tutorial.db", create => 1, # this causes the tables to be created ); Note that if you are connecting with a username and password you need to specify these as named arguments: my $dir = KiokuDB->connect( $dsn, user => $user, password => $password, ); =head1 INSERTING OBJECTS Let's start by defining a simple class using L: package Person; use Moose; has name => ( isa => "Str", is => "rw", ); We can instantiate it: my $obj = Person->new( name => "Homer Simpson" ); and insert the object to the database as follows: my $scope = $dir->new_scope; my $homer_id = $dir->store($obj); This is very trivial use of L, but it illustrates a few important things. First, no schema is necessary. L uses L to introspect your object without needing to predefine anything like tables. Second, every object in the database has an ID. If you don't choose an ID for an object, L will assign a UUID instead. This ID is like a primary key in a relational database. You can also specify an ID instead of letting one be generated: $dir->store( homer => $obj ); Third, all L operations need to be performed within a B. The scope is not really doing anything important in this simple example, but becomes necessary when cycles and weak references are in use. We will look into that in more detail later. =head1 LOADING OBJECTS So now that Homer has been inserted into the database, we can fetch him out of there using the ID we got from C. my $homer = $dir->lookup($homer_id); Assuming that C<$scope> and C<$obj> are still in scope, C<$homer> and C<$obj> will actually be the same object: # this is true: refaddr($homer) == refaddr($obj) This is because L tracks which objects are "live" in the B (L). If the object wasn't already in memory then L would have fetched it from the backend instead. =head1 WHAT WAS STORED Let's peek into the database: % sqlite3 kiokudb_tutorial.db SQLite version 3.4.0 Enter ".help" for instructions sqlite> The database schema has two tables, C and C: sqlite> .tables entries gin_index C is used for more complex queries, and we'll get back to it at the end of the tutorial. For now let's just have a closer look at C: sqlite> .schema entries CREATE TABLE entries ( id varchar NOT NULL, data blob NOT NULL, class varchar, root boolean NOT NULL, tied char(1), PRIMARY KEY (id) ); The main columns are C and C. In L every object has an ID which serves as a primary key and a BLOB of data associated with it. Since the default serializer for the DBI backend is L, we examine the data. First let's set C's output mode to C. This is easier to read with large columns: sqlite> .mode line And select the data from the table: sqlite> select id, data from entries; id = 201C5B55-E759-492F-8F20-A529C7C02C8B data = {"__CLASS__":"Person","data":{"name":"Homer Simpson"},"id":"201C5B55-E759-492F-8F20-A529C7C02C8B","root":true} As you can see the C attribute is stored under the C key inside the blob, as is the object's class. The C column contains all of the data necessary to recreate the object. All the other columns are only for searches. Later on you'll also see how to create user defined columns. When using L the on-disk format is just a hash of C to C with no additional columns. =head1 OBJECT RELATIONSHIPS Let's extend the C class to hold some more interesting data than just a C: package Person; has spouse => ( isa => "Person", is => "rw", weak_ref => 1, ); This new C attribute will hold a reference to another person object. Let's first create and insert another object: my $marge_id = $dir->store( Person->new( name => "Marge Simpson" ), ); Now that we have both objects in the database, let's link them together: { my $scope = $dir->new_scope; my ( $marge, $homer ) = $dir->lookup( $marge_id, $homer_id ); $marge->spouse($homer); $homer->spouse($marge); $dir->store( $marge, $homer ); } Now we have created a persistent B, that is several objects which point to each other. The reason C had the C option was so that this circular structure will not leak. When then objects are updated in the database, L sees that their C attribute contains references, and this relationship will be encoded using their unique ID in storage. To load the graph, we can do something like this: { my $scope = $dir->new_scope; my $homer = $dir->lookup($homer_id); print $homer->spouse->name; # Marge Simpson } { my $scope = $dir->new_scope; my $marge = $dir->lookup($marge_id); print $marge->spouse->name; # Homer Simpson refaddr($marge) == refaddr($marge->spouse->spouse); # true } When L is loading the initial object, all the objects the object depends on will also be loaded. The C attribute contains a reference to another object (by ID), and this link is resolved at inflation time. =head2 The purpose of C This is where C becomes important. As objects are inflated from the database, they are pushed onto the live object scope, in order to increase their reference count. If this was not done, by the time C<$homer> was returned from C his C attribute would have been cleared because there is no other reference to Marge. This demonstrates why: sub get_homer { my $homer = Person->new( name => "Homer Simpson" ); my $marge = Person->new( name => "Marge Simpson" ); $homer->spouse($marge); $marge->spouse($homer); return $homer; # at this point $homer and $marge go out of scope # $homer has a refcount of 1 because it's the return value # $marge has a refcount of 0, and gets destroyed # the weak reference in $homer->spouse is cleared } my $homer = get_homer(); $homer->spouse; # this returns undef By using this idiom: { my $scope = $dir->new_scope; # do all KiokuDB work in here } You are ensuring that the objects live at least as long as is necessary. In a web application context you usually create one new scope per request. In fact, L does this automatically. =head1 REFERENCES IN THE DATABASE Now that we have an object graph in the database let's have another look at what's inside. sqlite> select id, data from entries; id = 201C5B55-E759-492F-8F20-A529C7C02C8B data = {"__CLASS__":"Person","data":{"name":"Homer Simpson","spouse":{"$ref":"05A8D61C-6139-4F51-A748-101010CC8B02.data"}},"id":"201C5B55-E759-492F-8F20-A529C7C02C8B","root":true} id = 05A8D61C-6139-4F51-A748-101010CC8B02 data = {"__CLASS__":"Person","data":{"name":"Marge Simpson","spouse":{"$ref":"201C5B55-E759-492F-8F20-A529C7C02C8B.data"}},"id":"05A8D61C-6139-4F51-A748-101010CC8B02","root":true} You'll notice the C field has a JSON object with a C<$ref> field inside it holding the UUID of the target object. When data is loaded L queues up references to unloaded objects and then loads them in order to materialize the memory resident object graph. If you're curious about why the data is represented this way, this format is called C, or JavaScript Persistent Object Notation (L). When using L the L and L objects are serialized with their storable hooks instead. =head1 OBJECT SETS More complex relationships (not necessarily 1 to 1) are usually easy to model with L. Let's extend the C class to add such a relationship: package Person; has children => ( does => "KiokuDB::Set", is => "rw", ); L objects are L specific wrappers for L. my @kids = map { Person->new( name => $_ ) } qw(maggie lisa bart); use KiokuDB::Util qw(set); my $set = set(@kids); $homer->children($set); $dir->store($homer); The C convenience function creates a new L object. A transient set is one which started its life in memory space (as opposed to a set that was loaded from the database). The C convenience function also exists, creating a transient set with L used internally to help avoid circular structures (for instance if setting a C attribute in our example). The set object behaves pretty much like a normal L: my @kids = $dir->lookup($homer_id)->children->members; The main difference is that sets coming from the database are deferred by default, that is the objects in C<@kids> are not loaded until they are actually needed. This allows large object graphs to exist in the database, while only being partially loaded, without breaking the encapsulation of user objects. This behavior is implemented in L and L. This set object is optimized to make most operations defer loading. For instance, if you intersect two deferred sets, only the members of the intersection set will need to be loaded. =head1 THE TYPEMAP Storing an object with L involves passing it to L, the object that "flattens" objects into L before the entries are inserted into the backend. The collapser uses a L object that tells it how objects of each type should be collapsed. During retrieval of objects the same typemap is used to reinflate objects back into working objects. Trying to store an object that is not in the typemap is an error. The reason behind this is that it doesn't make sense to store every type of object (for instance C handles need a socket, objects based on XS modules have an internal pointer as an integer, whose address won't be valid the next time it's loaded), and even though the majority of objects are safe to serialize, even a small bit of unreported fragility is usually enough to create large, hard to debug problems. An exception to this rule is L based objects, because they have sufficient meta information available through L's powerful reflection support in order to be safely serialized. Additionally, the standard backends provide a default typemap for common objects (L, L, etc), which by default is merged with any custom typemap you pass to L. So, in order to actually get L to store things like L based objects, you can do something like this: KiokuDB->new( backend => $backend, allow_classes => [qw(My::Object)], ); Which is shorthand for: my $dir = KiokuDB->new( backend => $backend, typemap => KiokuDB::TypeMap->new( entries => { "My::Object" => KiokuDB::TypeMap::Entry::Naive->new, }, ), ); L is a type map entry that performs naive collapsing of the object, by simply walking it recursively. When the collapser encounters an object it will ask L for a collapsing routine based on the class of the object. This lookup is typically performed by C, not using inheritance, because a typemap entry that is safe to use with a superclass isn't necessarily safe to use with a subclass. If you B want inherited entries, specify C: KiokuDB::TypeMap->new( isa_entries => { "My::Object" => KiokuDB::TypeMap::Entry::Naive->new, }, ); If no normal (C keyed) entry is found for an object, the isa entries are searched for a superclass of that object. Subclass entries are tried before superclass entries. The result of this lookup is cached, so it only happens once per class. =head2 Typemap Entries If you want to do custom serialization hooks, you can specify hooks to collapse your object: KiokuDB::TypeMap::Entry::Callback->new( collapse => sub { my $object = shift; ... return @some_args; }, expand => sub { my ( $class, @some_args ) = @_; ... return $object; }, ); These hooks are called as methods on the object to be collapsed. For instance the L related typemap ISA entry is: 'Path::Class::Entity' => KiokuDB::TypeMap::Entry::Callback->new( intrinsic => 1, collapse => "stringify", expand => "new", ); The C flag is discussed in the next section. Another option for typemap entries is L, which is appropriate when you know the backend's serialization can handle that data type natively. For example, if your object has a L hook which you know is appropriate (e.g. contains no sub objects that need to be collapsible) and your backend uses L. L is an example of a class with such storable hopes: 'DateTime' => KiokuDB::Backend::Entry::Passthrough->new( intrinsic => 1 ) =head2 Intrinsic vs. First Class In L every object is normally assigned an ID, and if the object is shared by several objects this relationship will be preserved. However, for some objects this is not the desired behavior. These are objects that represent values, like L, L entries, L objects, etc. L can be asked to collapse such objects B, that is instead of creating a new L with its own ID for the object, the object gets collapsed directly into its parent's structures. This means that shared references that are collapsed intrinsically will be loaded back from the database as two distinct copies, so updates to one will not affect the other. For instance, when we run the following code: use Path::Class; my $path = file(qw(path to foo)); $obj_1->file($path); $obj_2->file($path); $dir->store( $obj_1, $obj_2 ); While the following is true when the data is being inserted, it will no longer be true when C<$obj_1> and C<$obj_2> are loaded from the database: refaddr($obj_1->file) == refaddr($obj_2->file) This is because both C<$obj_1> and C<$obj_2> each got its own copy of C<$path>. This behavior is usually more appropriate for objects that aren't mutated, but are instead cloned and replaced, and for which creating a first class entry in the backend with its own ID is undesired. =head2 The Default Typemap Each backend comes with a default typemap, with some built in entries for common CPAN modules' objects. L contains more details. =head1 SIMPLE SEARCHES Most backends support an inefficient but convenient simple search, which scans the entries and matches fields. If you want to make use of this API we suggest using L since simple searching is implemented using an SQL where clause, which is much more efficient (you do have to set up the column manually though). Calling the C method with a hash reference as the only argument invokes the simple search functionality, returning a L with the results: my $stream = $dir->search({ name => "Homer Simpson" }); while ( my $block = $stream->next ) { foreach my $object ( @$block ) { # $object->name eq "Homer Simpson" } } This exact API is intentionally still underdefined. In the future it will be compatible with L 0.09's syntax. =head2 DBI SEARCH COLUMNS In order to make use of the simple search API we need to configure columns for our DBI backend. Let's create a 'name' column to search by: my $dir = KiokuDB->connect( "dbi:SQLite:dbname=foo", columns => [ # specify extra columns for the 'entries' table # in the same format you pass to DBIC's add_columns name => { data_type => "varchar", is_nullable => 1, # probably important }, ], ); You can either alter the schema manually, or use C to back up your data, delete the database, connect with C<< create => 1 >> and then use C. To populate this column we'll need to load Homer and update him: { my $s = $dir->new_scope; $dir->update( $dir->lookup( $homer_id ) ); } And this is what it looks in the database: id = 201C5B55-E759-492F-8F20-A529C7C02C8B name = Homer Simpson =head1 GETTING STARTED WITH BDB The most mature backend for L is L. It performs very well, and supports many features, like L integration to provide customized indexing of your objects and transactions. L is newer and not as tested, but also supports transactions and L based queries. It performs quite well too, but isn't as fast as L. =head2 Installing L L needs the L module, and a recent version of Berkeley DB itself, which can be found here: L. BerkeleyDB (the library) normally installs into C, while L (the module) looks for it in C, so adding a symbolic link should make installation easy. Once you have L installed, L should install without problem and you can use it with L. =head2 Using L To use the BDB backend we must first create the storage. To do this the C flag must be passed: my $backend = KiokuDB::Backend::BDB->new( manager => { home => Path::Class::Dir->new(qw(path to storage)), create => 1, }, ); The BDB backend uses L to do a lot of the L gruntwork. The L object will be instantiated using the arguments provided in the C attribute. Now that the storage is created we can make use of this backend, much like before: my $dir = KiokuDB->new( backend => $backend ); Subsequent opens will not require the C argument to be true, but it doesn't hurt. This C call is equivalent to the above: my $dir = KiokuDB->connect( "bdb:dir=path/to/storage", create => 1 ); =head1 TRANSACTIONS Some backends (ones which do the L role) can be used with transactions. If you are familiar with L this should be very familiar: $dir->txn_do(sub { $dir->store($obj); }); This will create a L level transaction, and all changes to the database are committed if the block was executed cleanly. If any error occurred the transaction will be rolled back, and the changes will not be visible to subsequent reads. Note that L does B touch live instances, so if you do something like $dir->txn_do(sub { my $scope = $dir->new_scope; $obj->name("Dancing Hippy"); $dir->store($obj); die "an error"; }); the C attribute is B rolled back, it is simply the C operation that gets reverted. Transactions will nest properly, and with most backends they generally increase write performance as well. =head1 QUERIES L is a subclass of L that provides L integration. L is a framework to index and query objects, inspired by Postgres' internal GIN api. GIN stands for Generalized Inverted Indexes. Using L arbitrary search keys can be indexed for your objects, and these objects can then be looked up using queries. For instance, one of the pre canned searches L supports out of the box is class indexing. Let's use L to do custom indexing of our objects: my $dir = KiokuDB->new( backend => KiokuDB::Backend::BDB::GIN->new( extract => Search::GIN::Extract::Callback->new( extract => sub { my ( $obj, $extractor, @args ) = @_; if ( $obj->isa("Person") ) { return { type => "user", name => $obj->name, }; } return; }, ), ), ); $dir->store( @random_objects ); To look up the objects, we use the a manual key lookup query: my $query = Search::GIN::Query::Manual->new( values => { type => "person", }, ); my $stream = $dir->search($query); The result is L object that represents the search results. It can be iterated as follows: while ( my $block = $stream->next ) { foreach my $person ( @$block ) { print "found a person: ", $person->name; } } Or even more simply, if you don't mind loading the whole resultset into memory: my @people = $stream->all; L is very much in its infancy, and is very under documented. However it does work for simple searches such as this and contains pre canned solutions like L. In short, it works today, but watch this space for new developments. Scan.pm100644001750000144 621012237006576 16320 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Rolepackage KiokuDB::Role::Scan; BEGIN { $KiokuDB::Role::Scan::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Role::Scan::VERSION = '0.56'; } use MooseX::Role::Parameterized 0.10; # ABSTRACT: A role for entry scanning. use namespace::clean -except => 'meta'; parameter result_class => ( isa => "Str", is => "ro", required => 1, ); role { my $meta = shift; my $result_class = $meta->result_class; with qw(KiokuDB::Role::Verbosity); has backend => ( does => "KiokuDB::Backend::Role::Scan", is => "ro", required => 1, ); has scan_all => ( isa => "Bool", is => "ro", default => 1, ); has scan_ids => ( isa => "Bool", is => "ro", ); has entries => ( does => "Data::Stream::Bulk", is => "ro", lazy_build => 1, ); sub _build_entries { my $self = shift; my $backend = $self->backend; my $set = $self->scan_all ? "all" : "root"; my $type = $self->scan_ids ? "entry_ids" : "entries"; my $method = join("_", $set, $type); $backend->$method; } has [qw(block_callback entry_callback)] => ( isa => "CodeRef|Str", is => "ro", ); has results => ( isa => $result_class, is => "ro", handles => qr/.*/, lazy_build => 1, ); requires "process_block"; method _build_results => sub { my $self = shift; my $res = $result_class->new; my $i = my $j = 0; while ( my $next = $self->entries->next ) { $i += @$next; $j += @$next; if ( $j > 13 ) { # luv primes $j = 0; $self->v("\rscanning... $i"); } $self->process_block( block => $next, results => $res ); } $self->v("\rscanned $i entries \n"); return $res; } }; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Role::Scan - A role for entry scanning. =head1 VERSION version 0.56 =head1 SYNOPSIS package My::Entry::Processor; use Moose; with 'KiokuDB::Role::Scan' => { result_class => "My::Entry::Processor::Results" }; sub process_block { my ( $self, %args ) = @_; $args{results}; # intermediate results foreach my $entry ( @{ $args{block} } ) { } } my $scan = My::Entry::Processor->new( backend => $some_backend, ); my $res = $scan->results; $res->foo; $scan->foo; # delegates to result =head1 DESCRIPTION This role is used by classes like L to scan the whole database and computing summary results. =head1 ROLE PARAMETERS =over 4 =item result_class The class of the results. Will be used when creating the results initially by calling C and also sets up an attribute with delegations. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut typemap_default_json.t100644001750000144 346512237006576 17014 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Exception; use Test::Moose; use Scalar::Util qw(reftype); use KiokuDB::TypeMap; use KiokuDB::TypeMap::Default::JSON; use KiokuDB::TypeMap::Resolver; my $t = KiokuDB::TypeMap::Default::JSON->new; my $tr = KiokuDB::TypeMap::Resolver->new( typemap => $t, ); isa_ok( $tr, "KiokuDB::TypeMap::Resolver" ); foreach my $class ( qw(DateTime DateTime::Duration Path::Class::Entity URI Tie::RefHash Authen::Passphrase JSON::Boolean JSON::PP::Boolean SCALAR) ) { my $e = $t->resolve($class); does_ok( $e, "KiokuDB::TypeMap::Entry", "entry for $class" ); my $method = $tr->expand_method($class); ok( $method, "compiled" ); is( reftype($method), "CODE", "expand method" ); } SKIP: { skip "JSON required ($@)", 3 unless eval { require JSON }; my $json = JSON->new->decode('{ "id": "lala", "data": { "yes": true, "no": false } }'); { package KiokuDB_Test_My::Object; use Moose; has yes => ( is => "ro", default => sub { JSON::true() } ); has no => ( is => "ro", default => sub { JSON::false() } ); } my $obj = KiokuDB_Test_My::Object->new; require KiokuDB::Collapser; require KiokuDB::LiveObjects; require KiokuDB::Backend::Hash; my $l = KiokuDB::LiveObjects->new; my $c = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => $l, typemap_resolver => $tr, ); my $s = $l->new_scope; my ( $buffer, $id ) = $c->collapse(objects => [ $obj ]); my $entry = $buffer->id_to_entry($id); # see JSON.pm changelog my $boolean_class = $JSON::VERSION < 2.90 ? "JSON::Boolean" : "JSON::PP::Boolean"; isa_ok( $entry->data->{yes}, $boolean_class, "boolean passed through" ); } done_testing; kiokudb_class_native.t100644001750000144 1607412237006576 17003 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/env perl use strict; use warnings; use Test::More; use Test::Exception; { package Foo; use KiokuDB::Class; ::lives_ok { has array => ( traits => ['Array'], isa => 'ArrayRef', default => sub { [] }, handles => { array_count => 'count', array_elements => 'elements', array_is_empty => 'is_empty', array_push => 'push', array_push_curried => [ push => 42, 84 ], array_unshift => 'unshift', array_unshift_curried => [ unshift => 42, 84 ], array_pop => 'pop', array_shift => 'shift', array_get => 'get', array_get_curried => [ get => 1 ], array_set => 'set', array_set_curried_1 => [ set => 1 ], array_set_curried_2 => [ set => ( 1, 98 ) ], array_accessor => 'accessor', array_accessor_curried_1 => [ accessor => 1 ], array_accessor_curried_2 => [ accessor => ( 1, 90 ) ], array_clear => 'clear', array_delete => 'delete', array_delete_curried => [ delete => 1 ], array_insert => 'insert', array_insert_curried => [ insert => ( 1, 101 ) ], array_splice => 'splice', array_splice_curried_1 => [ splice => 1 ], array_splice_curried_2 => [ splice => 1, 2 ], array_splice_curried_all => [ splice => 1, 2, ( 3, 4, 5 ) ], array_sort => 'sort', array_sort_curried => [ sort => ( sub { $_[1] <=> $_[0] } ) ], array_sort_in_place => 'sort_in_place', array_sort_in_place_curried => [ sort_in_place => ( sub { $_[1] <=> $_[0] } ) ], array_map => 'map', array_map_curried => [ map => ( sub { $_ + 1 } ) ], array_grep => 'grep', array_grep_curried => [ grep => ( sub { $_ < 5 } ) ], array_first => 'first', array_first_curried => [ first => ( sub { $_ % 2 } ) ], array_join => 'join', array_join_curried => [ join => '-' ], array_shuffle => 'shuffle', array_uniq => 'uniq', array_reduce => 'reduce', array_reduce_curried => [ reduce => ( sub { $_[0] * $_[1] } ) ], array_natatime => 'natatime', array_natatime_curried => [ natatime => 2 ], }, ); } "native array trait inlines properly"; ::lives_ok { has bool => ( traits => ['Bool'], isa => 'Bool', default => 0, handles => { bool_illuminate => 'set', bool_darken => 'unset', bool_flip_switch => 'toggle', bool_is_dark => 'not', }, ); } "native bool trait inlines properly"; ::lives_ok { has code => ( traits => ['Code'], isa => 'CodeRef', default => sub { sub { } }, handles => { code_execute => 'execute', code_execute_method => 'execute_method', }, ); } "native code trait inlines properly"; ::lives_ok { has counter => ( traits => ['Counter'], isa => 'Int', default => 0, handles => { inc_counter => 'inc', inc_counter_2 => [ inc => 2 ], dec_counter => 'dec', dec_counter_2 => [ dec => 2 ], reset_counter => 'reset', set_counter => 'set', set_counter_42 => [ set => 42 ], }, ); } "native counter trait inlines properly"; ::lives_ok { has hash => ( traits => ['Hash'], isa => 'HashRef', default => sub { {} }, handles => { hash_option_accessor => 'accessor', hash_quantity => [ accessor => 'quantity' ], hash_clear_options => 'clear', hash_num_options => 'count', hash_delete_option => 'delete', hash_is_defined => 'defined', hash_options_elements => 'elements', hash_has_option => 'exists', hash_get_option => 'get', hash_has_no_options => 'is_empty', hash_key_value => 'kv', hash_set_option => 'set', }, ); } "native hash trait inlines properly"; ::lives_ok { has number => ( traits => ['Number'], isa => 'Num', default => 0, handles => { num_abs => 'abs', num_add => 'add', num_inc => [ add => 1 ], num_div => 'div', num_cut_in_half => [ div => 2 ], num_mod => 'mod', num_odd => [ mod => 2 ], num_mul => 'mul', num_set => 'set', num_sub => 'sub', num_dec => [ sub => 1 ], }, ); } "native number trait inlines properly"; ::lives_ok { has string => ( traits => ['String'], isa => 'Str', default => '', handles => { string_inc => 'inc', string_append => 'append', string_append_curried => [ append => '!' ], string_prepend => 'prepend', string_prepend_curried => [ prepend => '-' ], string_replace => 'replace', string_replace_curried => [ replace => qr/(.)$/, sub { uc $1 } ], string_chop => 'chop', string_chomp => 'chomp', string_clear => 'clear', string_match => 'match', string_match_curried => [ match => qr/\D/ ], string_length => 'length', string_substr => 'substr', string_substr_curried_1 => [ substr => (1) ], string_substr_curried_2 => [ substr => ( 1, 3 ) ], string_substr_curried_3 => [ substr => ( 1, 3, 'ong' ) ], }, ); } "native string trait inlines properly"; } done_testing; Serializer.pm100644001750000144 332612237006576 16651 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBpackage KiokuDB::Serializer; BEGIN { $KiokuDB::Serializer::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Serializer::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Standalone serializer object use Carp qw(croak); use Moose::Util::TypeConstraints; use namespace::clean -except => 'meta'; with qw(KiokuDB::Backend::Serialize); requires "serialize_to_stream"; requires "deserialize_from_stream"; my %types = ( storable => "KiokuDB::Serializer::Storable", json => "KiokuDB::Serializer::JSON", yaml => "KiokuDB::Serializer::YAML", ); coerce( __PACKAGE__, from Str => via { my $class = $types{lc($_)} or croak "unknown format: $_";; Class::MOP::load_class($class); $class->new; }, from HashRef => via { my %args = %$_; my $class = $types{lc(delete $args{format})} or croak "unknown format: $args{format}"; Class::MOP::load_class($class); $class->new(%args); }, ); __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Serializer - Standalone serializer object =head1 VERSION version 0.56 =head1 SYNOPSIS Backend->new( serializer => KiokuDB::Serializer::Storable->new( ... ), ); =head1 DESCRIPTION This role is for objects which perform the serialization roles (e.g. L) but can be used independently. This is used by L and L. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Loaded.pm100644001750000144 305012237006576 16455 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Setpackage KiokuDB::Set::Loaded; BEGIN { $KiokuDB::Set::Loaded::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Set::Loaded::VERSION = '0.56'; } use Moose; # ABSTRACT: Implementation of loaded sets use Carp qw(croak); use namespace::clean -except => 'meta'; with qw(KiokuDB::Set::Storage); extends qw(KiokuDB::Set::Base); sub loaded { 1 } sub includes { shift->_objects->includes(@_) } sub remove { shift->_objects->remove(@_) } sub members { shift->_objects->members } sub insert { my ( $self, @objects ) = @_; croak "Can't insert non reference into a KiokuDB::Set" if grep { not ref } @objects; $self->_objects->insert(@objects) } sub _set_ids { my ( $self, $id_set ) = @_; # replace the object set with the ID set $self->_set_objects( $id_set ); # and go back to being deferred bless $self, "KiokuDB::Set::Deferred"; } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Set::Loaded - Implementation of loaded sets =head1 VERSION version 0.56 =head1 SYNOPSIS # created automatically when deferred sets are vivified =head1 DESCRIPTION This is the implementation of a loaded set. A L automatically upgrades into a loaded set when its set members are retrieved. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Stored.pm100644001750000144 203012237006576 16522 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Setpackage KiokuDB::Set::Stored; BEGIN { $KiokuDB::Set::Stored::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Set::Stored::VERSION = '0.56'; } use Moose; # ABSTRACT: Stored representation of KiokuDB::Set objects. use namespace::clean -except => 'meta'; extends qw(KiokuDB::Set::Base); has _objects => ( is => "ro" ); __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Set::Stored - Stored representation of KiokuDB::Set objects. =head1 VERSION version 0.56 =head1 SYNOPSIS # used internally by L =head1 DESCRIPTION This object is the persisted representation of all L objects. It is used internally after collapsing and before expanding, for simplicity. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut UUIDs.pm100644001750000144 247612237006576 16377 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Rolepackage KiokuDB::Role::UUIDs; BEGIN { $KiokuDB::Role::UUIDs::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Role::UUIDs::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: UUID generation role. use Try::Tiny; use namespace::clean -except => 'meta'; if ( defined &KiokuDB::SERIAL_IDS and KiokuDB::SERIAL_IDS() ) { with qw(KiokuDB::Role::UUIDs::SerialIDs); } else { my $have_libuuid = try { require Data::UUID::LibUUID; 1 }; my $backend = $have_libuuid ? "LibUUID" : "DataUUID"; with "KiokuDB::Role::UUIDs::$backend"; } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Role::UUIDs - UUID generation role. =head1 VERSION version 0.56 =head1 SYNOPSIS with qw(KiokuDB::Role::UUIDs); =head1 DESCRIPTION This role provides UUID assignment. Depending on the C<$SERIAL_IDS> variable being true at compile time, and availability of UUID generation module (L falling back to L) an implementation role is selected. =head1 METHODS =over 4 =item generate_uuid Create a new UUID =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Entry000755001750000144 012237006576 15137 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBSkip.pm100644001750000144 160512237006576 16545 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Entrypackage KiokuDB::Entry::Skip; BEGIN { $KiokuDB::Entry::Skip::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Entry::Skip::VERSION = '0.56'; } use Moose; use namespace::clean -except => 'meta'; has prev => ( isa => "KiokuDB::Entry", is => "ro", handles => [qw(id)], ); has root => ( isa => "Bool", is => "rw", predicate => "has_root", ); has object => ( isa => "Any", is => "rw", weak_ref => 1, predicate => "has_object", ); __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Entry::Skip =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut LinkChecker.pm100644001750000144 416712237006576 16726 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBpackage KiokuDB::LinkChecker; BEGIN { $KiokuDB::LinkChecker::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::LinkChecker::VERSION = '0.56'; } use Moose; # ABSTRACT: Reference consistency checker use KiokuDB::LinkChecker::Results; use namespace::clean -except => 'meta'; with 'KiokuDB::Role::Scan' => { result_class => "KiokuDB::LinkChecker::Results" }; sub process_block { my ( $self, %args ) = @_; my ( $block, $res ) = @args{qw(block results)}; my ( $seen, $root, $referenced, $unreferenced, $missing, $broken ) = map { $res->$_ } qw(seen root referenced unreferenced missing broken); my $backend = $self->backend; foreach my $entry ( @$block ) { my $id = $entry->id; $seen->insert($id); $root->insert($id) if $entry->root; unless ( $referenced->includes($id) ) { $unreferenced->insert($id); } my @ids = $entry->referenced_ids; my @new = grep { !$referenced->includes($_) && !$seen->includes($_) } @ids; my %exists; @exists{@new} = $backend->exists(@new) if @new; if ( my @missing = grep { not $exists{$_} } @new ) { $self->v("\rfound broken entry: " . $entry->id . " (references nonexisting IDs @missing)\n"); $missing->insert(@missing); $broken->insert($entry->id); } $referenced->insert(@ids); $unreferenced->remove(@ids); } } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::LinkChecker - Reference consistency checker =head1 VERSION version 0.56 =head1 SYNOPSIS use KiokuDB::LinkChecker; my $l = KiokuDB::LinkChecker->new( backend => $b, ); my @idw = $l->missing->members; # referenced but not in the DB =head1 DESCRIPTION This is the low level link checker used by L. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut LiveObjects.pm100644001750000144 4000112237006576 16760 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBpackage KiokuDB::LiveObjects; BEGIN { $KiokuDB::LiveObjects::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::LiveObjects::VERSION = '0.56'; } use Moose; # ABSTRACT: Live object set tracking use Scalar::Util qw(weaken refaddr); use KiokuDB::LiveObjects::Guard; use Hash::Util::FieldHash::Compat qw(fieldhash); use Carp qw(croak); BEGIN { local $@; eval 'use Devel::PartialDump qw(croak)' }; use Set::Object 1.26; use Cache::Ref 0.02; use KiokuDB::LiveObjects::Scope; use KiokuDB::LiveObjects::TXNScope; use Moose::Util::TypeConstraints; use namespace::clean -except => 'meta'; coerce __PACKAGE__, from "HashRef", via { __PACKAGE__->new($_) }; has clear_leaks => ( isa => "Bool", is => "rw", ); has cache => ( isa => "Cache::Ref", is => "ro", ); has leak_tracker => ( isa => "CodeRef|Object", is => "rw", clearer => "clear_leak_tracker", ); has keep_entries => ( isa => "Bool", is => "ro", default => 1, ); has [qw(_objects _entries _object_entries)] => ( isa => "HashRef", is => "ro", init_arg => undef, default => sub { fieldhash my %hash }, ); has _ids => ( #metaclass => 'Collection::Hash', isa => "HashRef", is => "ro", init_arg => undef, default => sub { return {} }, ); sub size { my $self = shift; scalar keys %{ $self->_objects }; } sub _id_info { my ( $self, @ids ) = @_; no warnings 'uninitialized'; # @ids can contain undefs if ( @ids == 1 ) { return $self->_ids->{$ids[0]}; } else { return @{ $self->_ids }{@ids}; } } sub _vivify_id_info { my ( $self, $id ) = @_; my $info; my $i = $self->_ids; unless ( $info = $i->{$id} ) { $info = { guard => KiokuDB::LiveObjects::Guard->new( $i, $id ) }; weaken( $i->{$id} = $info ); } return $info; } sub id_to_object { my ( $self, $id ) = @_; if ( my $c = $self->cache ) { $c->hit($id); } if ( my $data = $self->_id_info($id) ) { return $data->{object}; } } sub ids_to_objects { my ( $self, @ids ) = @_; if ( my $c = $self->cache ) { $c->hit(@ids); } map { $_ && $_->{object} } $self->_id_info(@ids); } sub known_ids { keys %{ shift->_ids }; } sub live_ids { my $self = shift; grep { ref $self->_id_info($_)->{object} } $self->known_ids; } sub live_objects { grep { ref } map { $_->{object} } values %{ shift->_ids }; } sub id_to_entry { my ( $self, $id ) = @_; if ( my $data = $self->_id_info($id) ) { return $data->{entry}; } return undef; } sub ids_to_entries { my ( $self, @ids ) = @_; return $self->id_to_entry($ids[0]) if @ids == 1; map { $_ && $_->{entry} } $self->_id_info(@ids); } sub loaded_ids { my $self = shift; grep { $self->_id_info($_)->{entry} } $self->known_ids; } sub live_entries { grep { ref } map { $_->{entry} } values %{ shift->_ids }; } has current_scope => ( isa => "KiokuDB::LiveObjects::Scope", is => "ro", writer => "_set_current_scope", clearer => "_clear_current_scope", weak_ref => 1, ); has _known_scopes => ( isa => "Set::Object", is => "ro", default => sub { Set::Object::Weak->new }, ); sub detach_scope { my ( $self, $scope ) = @_; my $current_scope = $self->current_scope; if ( defined($current_scope) and refaddr($current_scope) == refaddr($scope) ) { if ( my $parent = $scope->parent ) { $self->_set_current_scope($parent); } else { $self->_clear_current_scope; } } } sub remove_scope { my ( $self, $scope ) = @_; $self->detach_scope($scope); $scope->clear; my $known = $self->_known_scopes; $known->remove($scope); if ( $known->size == 0 ) { $self->check_leaks; } } sub check_leaks { my $self = shift; return if $self->_known_scopes->size; my @still_live = grep { defined } $self->live_objects; if (@still_live) { # immortal objects are still live but not considered leaks my $o = $self->_objects; my @leaked = grep { my $i = $o->{$_}; not($i->{immortal} or $i->{cache}) } @still_live; weaken($_) for @leaked; @still_live = (); if ( $self->clear_leaks ) { $self->clear; } if ( my $tracker = $self->leak_tracker and grep { defined } @leaked ) { if ( ref($tracker) eq 'CODE' ) { $tracker->(grep { defined } @leaked); } else { $tracker->leaked_objects(grep { defined } @leaked); } } if ( my $cache = $self->cache and $self->size > $self->cache->size * 1.1 ) { # all live objects are marked 'cached', but the live object set is bigger than # the cache size. This means objects have been expired out of the # cache but are still referenced by other cache entries do { $cache->expire( 1 + int ( ( $self->size - $cache->size ) / 2 ) ); } while $self->size > $cache->size; } } } has txn_scope => ( isa => "KiokuDB::LiveObjects::TXNScope", is => "ro", writer => "_set_txn_scope", clearer => "_clear_txn_scope", weak_ref => 1, ); sub new_scope { my $self = shift; my $parent = $self->current_scope; my $child = KiokuDB::LiveObjects::Scope->new( ( $parent ? ( parent => $parent ) : () ), live_objects => $self, ); $self->_set_current_scope($child); $self->_known_scopes->insert($child); return $child; } sub new_txn { my $self = shift; return unless $self->keep_entries; my $parent = $self->txn_scope; my $child = KiokuDB::LiveObjects::TXNScope->new( ( $parent ? ( parent => $parent ) : () ), live_objects => $self, ); $self->_set_txn_scope($child); return $child; } sub objects_to_ids { my ( $self, @objects ) = @_; return $self->object_to_id($objects[0]) if @objects == 1; map { $_ && $_->{guard}->key } @{ $self->_objects }{@objects}; } sub object_to_id { my ( $self, $obj ) = @_; if ( my $info = $self->_objects->{$obj} ){ return $info->{guard}->key; } return undef; } sub objects_to_entries { my ( $self, @objects ) = @_; return $self->ids_to_entries( $self->objects_to_ids(@objects) ); } sub object_to_entry { my ( $self, $obj ) = @_; return $self->id_to_entry( $self->object_to_id($obj) || return ); } sub id_in_root_set { my ( $self, $id ) = @_; if ( my $data = $self->_id_info($id) ) { return $data->{root}; } return undef; } sub id_in_storage { my ( $self, $id ) = @_; if ( my $data = $self->_id_info($id) ) { return $data->{in_storage}; } return undef; } sub object_in_storage { my ( $self, $object ) = @_; $self->id_in_storage( $self->object_to_id($object) || return ); } sub update_object_entry { my ( $self, $object, $entry, %args ) = @_; my $s = $self->current_scope or croak "no open live object scope"; my $info = $self->_objects->{$object} or croak "Object not yet registered"; $self->_entries->{$entry} = $info; @{$info}{keys %args} = values %args; weaken($info->{entry} = $entry); if ( $self->keep_entries ) { $self->_object_entries->{$object} = $entry; if ( $args{in_storage} and my $txs = $self->txn_scope ) { $txs->push($entry); } } # break cycle for passthrough objects if ( ref($entry->data) and refaddr($object) == refaddr($entry->data) ) { weaken($entry->{data}); # FIXME there should be a MOP way to do this } } sub register_object { my ( $self, $id, $object, %args ) = @_; my $s = $self->current_scope or croak "no open live object scope"; croak($object, " is not a reference") unless ref($object); croak($object, " is an entry") if blessed($object) && $object->isa("KiokuDB::Entry"); if ( my $old_id = $self->object_to_id($object) ) { croak($object, " is already registered as '$old_id'") } if ( my $object = $self->id_to_object($id) ) { croak("ID '$id' is already in use by ", $object); } my $info = $self->_vivify_id_info($id); if ( ref $info->{object} ) { croak "An object with the id '$id' is already registered ($info->{object} != $object)" } $self->_objects->{$object} = $info; weaken($info->{object} = $object); if ( my $entry = $info->{entry} ) { # break cycle for passthrough objects if ( ref($entry->data) and refaddr($object) == refaddr($entry->data) ) { weaken($entry->{data}); # FIXME there should be a MOP way to do this } if ( $self->keep_entries ) { $self->_object_entries->{$object} = $entry; } } @{$info}{keys %args} = values %args; if ( $args{cache} and my $c = $self->cache ) { $c->set( $id => $object ); } $s->push($object); } sub register_entry { my ( $self, $id, $entry, %args ) = @_; my $info = $self->_vivify_id_info($id); $self->_entries->{$entry} = $info; confess "$entry" unless $entry->isa("KiokuDB::Entry"); @{$info}{keys %args, 'root'} = ( values %args, $entry->root ); weaken($info->{entry} = $entry); if ( $args{in_storage} and $self->keep_entries and my $txs = $self->txn_scope ) { $txs->push($entry); } } sub insert { my ( $self, @pairs ) = @_; croak "The arguments must be an list of pairs of IDs/Entries to objects" unless @pairs % 2 == 0; croak "no open live object scope" unless $self->current_scope; my @register; while ( @pairs ) { my ( $id, $object ) = splice @pairs, 0, 2; my $entry; if ( ref $id ) { $entry = $id; $id = $entry->id; } confess("blah") unless $id; croak($object, " is not a reference") unless ref($object); croak($object, " is an entry") if blessed($object) && $object->isa("KiokuDB::Entry"); if ( $entry ) { $self->register_entry( $id => $entry, in_storage => 1 ); $self->register_object( $id => $object ); } else { $self->register_object( $id => $object ); } } } sub update_entries { my ( $self, @pairs ) = @_; my @entries; while ( @pairs ) { my ( $object, $entry ) = splice @pairs, 0, 2; $self->register_entry( $entry->id => $entry, in_storage => 1 ); unless ( $self->object_to_id($object) ) { $self->register_object( $entry->id => $object ); } else { $self->update_object_entry( $object, $entry ); } } return; } sub rollback_entries { my ( $self, @entries ) = @_; foreach my $entry ( reverse @entries ) { my $info = $self->_id_info($entry->id); if ( my $prev = $entry->prev ) { weaken($info->{entry} = $prev); } else { delete $info->{entry}; } } } sub remove { my ( $self, @stuff ) = @_; my ( $i, $o, $e, $oe ) = ( $self->_ids, $self->_objects, $self->_entries, $self->_object_entries ); while ( @stuff ) { my $thing = shift @stuff; if ( ref $thing ) { # FIXME make this a bit less zealous? my $info; if ( $info = delete $o->{$thing} ) { delete $info->{object}; delete $oe->{$thing}; push @stuff, $info->{entry} if $info->{entry}; } elsif ( $info = delete $e->{$thing} ) { delete $info->{entry}; push @stuff, $info->{object} if ref $info->{object}; } } else { my $info = delete $i->{$thing}; push @stuff, grep { ref } delete @{$info}{qw(entry object)}; } } } sub clear { my $self = shift; # don't waste too much time in DESTROY $_->{guard}->dismiss for values %{ $self->_ids }; %{ $self->_ids } = (); %{ $self->_objects } = (); %{ $self->_object_entries } = (); %{ $self->_entries } = (); $self->_clear_current_scope; $self->_known_scopes->clear; } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::LiveObjects - Live object set tracking =head1 VERSION version 0.56 =head1 SYNOPSIS $live_objects->insert( $entry => $object ); $live_objects->insert( $id => $object ); my $id = $live_objects->object_to_id( $object ); my $obj = $live_objects->id_to_object( $id ); my $scope = $live_objects->new_scope; =head1 DESCRIPTION This object keeps track of the set of live objects, their associated IDs, and the storage entries. =head1 ATTRIBUTES =over 4 =item clear_leaks Boolean. Defaults to false. If true, when the last known scope is removed but some objects are still live they will be removed from the live object set. Note that this does B prevent leaks (memory cannot be reclaimed), it merely prevents stale objects from staying loaded. =item leak_tracker This is a coderef or object. If any objects are leaked (see C) then the this can be used to report them, or to break the circular structure. When an object is provided the C method is called. The coderef is simply invoked with the objects as arguments. Triggered after C causes C to be called. For example, to break cycles you can use L's C function: use Data::Structure::Util qw(circular_off); $dir->live_objects->leak_tracker(sub { my @leaked_objects = @_; circular_off($_) for @leaked_objects; }); =item keep_entries B When true (the default), L loaded from the backend or created by the collapser are kept around. This results in a considerable memory overhead, so it's no longer required. =back =head1 METHODS =over 4 =item insert Takes pairs, id or entry as the key, and object as the value, registering the objects. =item objects_to_ids =item object_to_id Given objects, returns their IDs, or undef for objects which not registered. =item objects_to_entries =item object_to_entry Given objects, find the corresponding entries. =item ids_to_objects =item id_to_object Given IDs, find the corresponding objects. =item ids_to_entries Given IDs, find the corresponding entries. =item update_entries Given entries, replaces the live entries of the corresponding objects with the newly updated ones. The objects must already be in the live object set. This method is called on a successful transaction commit. =item new_scope Creates a new L, with the current scope as its parent. =item current_scope The current L instance. This is the scope into which newly registered objects are pushed. =item new_txn Creates a new L, with the current txn scope as its parent. =item txn_scope The current L. =item clear Forces a clear of the live object set. This removes all objects and entries, and can be useful in the case of leaks (to prevent false positives on lookups). Note that this does not actually break the circular structures, so the leak is unresolved, but the objects are no longer considered live by the L instance. =item live_entries =item live_objects =item live_ids Enumerates the live entries, objects or ids. =item rollback_entries Called by L. =item remove Removes entries from the live object set. =item remove_scope $scope Removes a scope from the set of known scopes. Also calls C, and calls C on the scope itself. =item detach_scope $scope Detaches C<$scope> if it's the current scope. This prevents C from being called on this scope object implicitly anymore. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Test000755001750000144 012237006576 14755 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBPerson.pm100644001750000144 163012237006576 16721 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Testpackage KiokuDB::Test::Person; BEGIN { $KiokuDB::Test::Person::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Person::VERSION = '0.56'; } use Moose; use namespace::clean -except => 'meta'; has [qw(name age job binary)] => ( isa => "Str", is => "rw", ); has so => ( isa => "KiokuDB::Test::Person", is => "rw", weak_ref => 1, ); has [qw(parents kids friends)] => ( isa => "ArrayRef[KiokuDB::Test::Person]", is => "rw", default => sub { [] }, ); __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Person =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Storage.pm100644001750000144 164612237006576 16702 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Setpackage KiokuDB::Set::Storage; BEGIN { $KiokuDB::Set::Storage::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Set::Storage::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Role for KiokuDB::Sets that are tied to storage. use Set::Object; use namespace::clean -except => 'meta'; with qw(KiokuDB::Set); __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Set::Storage - Role for KiokuDB::Sets that are tied to storage. =head1 VERSION version 0.56 =head1 SYNOPSIS # informational role, used internally =head1 DESCRIPTION This role is informational, and implemented by L and L =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut typemap_entry_storable.t100644001750000144 1251212237006576 17404 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Scalar::Util qw(refaddr reftype blessed); use KiokuDB::TypeMap::Entry::StorableHook; use KiokuDB::TypeMap::Resolver; use KiokuDB::Collapser; use KiokuDB::Linker; use KiokuDB::LiveObjects; use KiokuDB::Backend::Hash; BEGIN { eval 'use Test::Memory::Cycle; 1' or eval 'sub memory_cycle_ok {}' } { package KiokuDB_Test_Foo; use Moose; has foo => ( is => "rw" ); has bar => ( is => "rw", isa => "KiokuDB_Test_Bar", predicate => "has_bar" ); sub STORABLE_freeze { my ( $self, $cloning ) = @_; return ( $self->foo, $self->has_bar ? $self->bar : () ); } sub STORABLE_thaw { my ( $self, $cloning, $foo, $bar ) = @_; $self->foo($foo); $self->bar($bar) if ref $bar; } package KiokuDB_Test_Bar; use Moose; has blah => ( is => "rw" ); has foo => ( is => "rw", weak_ref => 1 ); package KiokuDB_Test_Gorch; use Moose; has name => ( is => "rw" ); sub STORABLE_freeze { my ( $self, $cloning ); return $self->name; } sub STORABLE_attach { my ( $class, $cloning, $name ) = @_; $class->new( name => $name ); } } my $obj = KiokuDB_Test_Foo->new( foo => "HALLO" ); my $deep = KiokuDB_Test_Foo->new( foo => "la", bar => KiokuDB_Test_Bar->new( blah => "hai" ) ); my $circular = KiokuDB_Test_Foo->new( foo => "oink", bar => KiokuDB_Test_Bar->new( blah => "three" ) ); $circular->bar->foo($circular); my $attach = KiokuDB_Test_Gorch->new( name => "blah" ); my $s = KiokuDB::TypeMap::Entry::StorableHook->new; my $tr = KiokuDB::TypeMap::Resolver->new( typemap => KiokuDB::TypeMap->new( entries => { KiokuDB_Test_Foo => $s, }, ), ); my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => KiokuDB::LiveObjects->new, typemap_resolver => $tr, ); my $l = KiokuDB::Linker->new( backend => KiokuDB::Backend::Hash->new, live_objects => KiokuDB::LiveObjects->new, typemap_resolver => $tr, ); { my $s = $v->live_objects->new_scope; my ( $buffer ) = $v->collapse( objects => [ $obj ], ); my $entries = $buffer->_entries; is( scalar(keys %$entries), 1, "one entry" ); my $entry = ( values %$entries )[0]; isnt( refaddr($entry->data), refaddr($obj), "refaddr doesn't equal" ); ok( !blessed($entry->data), "entry data is not blessed" ); my $sl = $l->live_objects->new_scope; my $expanded = $l->expand_object($entry); isa_ok( $expanded, "KiokuDB_Test_Foo", "expanded object" ); isnt( refaddr($expanded), refaddr($obj), "refaddr doesn't equal" ); isnt( refaddr($expanded), refaddr($entry->data), "refaddr doesn't entry data refaddr" ); is_deeply( $expanded, $obj, "is_deeply" ); } { my $s = $v->live_objects->new_scope; my $bar = $deep->bar; my ( $buffer, $id ) = $v->collapse( objects => [ $deep ], ); my $entries = $buffer->_entries; is( scalar(keys %$entries), 2, "two entries" ); $l->backend->insert(values %$entries); my $entry = $entries->{$id}; isnt( refaddr($entry->data), refaddr($deep), "refaddr doesn't equal" ); ok( !blessed($entry->data), "entry data is not blessed" ); my $sl = $l->live_objects->new_scope; my $expanded = $l->expand_object($entry); isa_ok( $expanded, "KiokuDB_Test_Foo", "expanded object" ); isnt( refaddr($expanded), refaddr($deep), "refaddr doesn't equal" ); isnt( refaddr($expanded), refaddr($entry->data), "refaddr doesn't entry data refaddr" ); is_deeply( $expanded, $deep, "is_deeply" ); } { my $s = $v->live_objects->new_scope; my $bar = $deep->bar; my ( $buffer, $id ) = $v->collapse( objects => [ $circular ], ); my $entries = $buffer->_entries; is( scalar(keys %$entries), 2, "two entries" ); $l->backend->insert(values %$entries); my $entry = $entries->{$id}; isnt( refaddr($entry->data), refaddr($circular), "refaddr doesn't equal" ); ok( !blessed($entry->data), "entry data is not blessed" ); my $sl = $l->live_objects->new_scope; my $expanded = $l->expand_object($entry); isa_ok( $expanded, "KiokuDB_Test_Foo", "expanded object" ); isnt( refaddr($expanded), refaddr($circular), "refaddr doesn't equal" ); isnt( refaddr($expanded), refaddr($entry->data), "refaddr doesn't entry data refaddr" ); is_deeply( $expanded, $circular, "is_deeply" ); is( refaddr($expanded->bar->foo), refaddr($expanded), "circular ref" ); memory_cycle_ok($expanded, "weakened"); } is_deeply( [ $l->live_objects->live_objects ], [], "no live objects" ); { my $s = $v->live_objects->new_scope; my ( $buffer ) = $v->collapse( objects => [ $attach ], ); my $entries = $buffer->_entries; is( scalar(keys %$entries), 1, "one entry" ); my $entry = ( values %$entries )[0]; isnt( refaddr($entry->data), refaddr($attach), "refaddr doesn't equal" ); ok( !blessed($entry->data), "entry data is not blessed" ); my $sl = $l->live_objects->new_scope; my $expanded = $l->expand_object($entry); isa_ok( $expanded, "KiokuDB_Test_Gorch", "expanded object" ); isnt( refaddr($expanded), refaddr($obj), "refaddr doesn't equal" ); isnt( refaddr($expanded), refaddr($entry->data), "refaddr doesn't entry data refaddr" ); is_deeply( $expanded, $attach, "is_deeply" ); } done_testing; typemap_entry_callback.t100644001750000144 465512237006576 17316 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Scalar::Util qw(refaddr reftype blessed); use KiokuDB::TypeMap::Entry::Callback; use KiokuDB::TypeMap::Resolver; use KiokuDB::Collapser; use KiokuDB::Linker; use KiokuDB::LiveObjects; use KiokuDB::Backend::Hash; { package KiokuDB_Test_Foo; use Moose; has foo => ( is => "rw" ); has bar => ( is => "rw", isa => "KiokuDB_Test_Bar" ); package KiokuDB_Test_Bar; use Moose; has blah => ( is => "rw" ); sub pack { my $self = shift; return ( blah => $self->blah ); } } my $obj = KiokuDB_Test_Foo->new( foo => "HALLO" ); my $deep = KiokuDB_Test_Foo->new( foo => "la", bar => KiokuDB_Test_Bar->new( blah => "hai" ) ); my $bar = KiokuDB::TypeMap::Entry::Callback->new( collapse => "pack", expand => "new", ); my $foo = KiokuDB::TypeMap::Entry::Callback->new( collapse => sub { my $self = shift; my $meta = $self->meta; return map { $_->name => $_->get_value($self) } grep { $_->has_value($self) } map { $meta->find_attribute_by_name($_) } qw(foo bar); }, expand => sub { my ( $class, @args ) = @_; $class->new(@args); } ); my $tr = KiokuDB::TypeMap::Resolver->new( typemap => KiokuDB::TypeMap->new( entries => { KiokuDB_Test_Bar => $bar, KiokuDB_Test_Foo => $foo, }, ), ); my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => KiokuDB::LiveObjects->new, typemap_resolver => $tr, ); my $l = KiokuDB::Linker->new( backend => KiokuDB::Backend::Hash->new, live_objects => KiokuDB::LiveObjects->new, typemap_resolver => $tr, ); { my $s = $v->live_objects->new_scope; my ( $buffer ) = $v->collapse( objects => [ $obj ], ); my $entries = $buffer->_entries; is( scalar(keys %$entries), 1, "one entry" ); my $entry = ( values %$entries )[0]; isnt( refaddr($entry->data), refaddr($obj), "refaddr doesn't equal" ); ok( !blessed($entry->data), "entry data is not blessed" ); my $sl = $l->live_objects->new_scope; my $expanded = $l->expand_object($entry); isa_ok( $expanded, "KiokuDB_Test_Foo", "expanded object" ); isnt( refaddr($expanded), refaddr($obj), "refaddr doesn't equal" ); isnt( refaddr($expanded), refaddr($entry->data), "refaddr doesn't entry data refaddr" ); is_deeply( $expanded, $obj, "is_deeply" ); } done_testing; Company.pm100644001750000144 125512237006576 17064 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Testpackage KiokuDB::Test::Company; BEGIN { $KiokuDB::Test::Company::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Company::VERSION = '0.56'; } use Moose; use namespace::clean -except => 'meta'; has name => ( isa => "Str", is => "rw", ); __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Company =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Fixture.pm100644001750000144 2045312237006576 17125 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Testpackage KiokuDB::Test::Fixture; BEGIN { $KiokuDB::Test::Fixture::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Fixture::VERSION = '0.56'; } use Moose::Role; use Test::More; use Test::Exception; sub _lives_and_ret (&;$) { my ( $sub, @args ) = @_; my @ret; my $wrapped = sub { @ret = $sub->() }; local $Test::Builder::Level = $Test::Builder::Level + 2; &lives_ok($wrapped, @args); return ( ( @ret == 1 ) ? $ret[0] : @ret ); } use namespace::clean -except => 'meta'; requires qw(create verify); sub sort { 0 } sub required_backend_roles { return () } has populate_ids => ( isa => "ArrayRef[Str]", is => "rw", predicate => "has_populate_ids", clearer => "clear_populate_ids", ); sub populate { my $self = shift; { my $s = $self->new_scope; my @objects = $self->create; my @ids = $self->store_ok(@objects); $self->populate_ids(\@ids); } $self->no_live_objects; } sub name { my $self = shift; my $class = ref($self) || $self; $class =~ s{KiokuDB::Test::Fixture::}{}; return $class; } sub skip_fixture { my ( $self, $reason, $count ) = @_; skip $self->name . " fixture ($reason)", $count || 1 } sub precheck { my $self = shift; my $backend = $self->backend; if ( $backend->does("KiokuDB::Backend::Role::Broken") ) { foreach my $fixture ( $backend->skip_fixtures ) { $self->skip_fixture("broken backend") if $fixture eq ref($self) or $fixture eq $self->name; } } my @missing; role: foreach my $role ( $self->required_backend_roles ) { foreach my $role_fmt ( $role, "KiokuDB::Backend::Role::$role", "KiokuDB::Backend::$role" ) { next role if $backend->does($role_fmt) or $backend->can("serializer") and $backend->serializer->does($role_fmt); } push @missing, $role; } if ( @missing ) { $_ =~ s/^KiokuDB::Backend::Role::// for @missing; $self->skip_fixture("Backend does not implement required roles (@missing)") } } sub run { my $self = shift; SKIP: { local $Test::Builder::Level = $Test::Builder::Level + 1; $self->precheck; $self->clear_live_objects; is_deeply( [ $self->live_objects ], [ ], "no live objects at start of " . $self->name . " fixture" ); is_deeply( [ $self->live_entries ], [ ], "no live entries at start of " . $self->name . " fixture" ); lives_ok { local $Test::Builder::Level = $Test::Builder::Level - 1; $self->txn_do(sub { my $s = $self->new_scope; $self->populate; }); $self->verify; } "no error in fixture"; is_deeply( [ $self->live_objects ], [ ], "no live objects at end of " . $self->name . " fixture" ); is_deeply( [ $self->live_entries ], [ ], "no live entries at end of " . $self->name . " fixture" ); $self->clear_live_objects; } } has get_directory => ( isa => "CodeRef|Str", is => "ro", ); has directory => ( is => "ro", isa => "KiokuDB", lazy_build => 1, handles => [qw( lookup exists store insert update delete clear_live_objects backend linker collapser search simple_search backend_search is_root set_root unset_root all_objects root_set scan grep new_scope txn_do object_to_id objects_to_ids )], ); sub _build_directory { my $self = shift; my $method = $self->get_directory or die "either 'directory' or 'get_directory' is required"; return $self->$method; } sub live_objects { shift->directory->live_objects->live_objects } sub live_entries { shift->directory->live_objects->live_entries } sub update_live_objects { my $self = shift; _lives_and_ret { $self->update( $self->live_objects ) } "updated live objects"; } sub store_ok { my ( $self, @objects ) = @_; local $Test::Builder::Level = 1; _lives_and_ret { $self->store( @objects ) } "stored " . scalar(grep { ref } @objects) . " objects"; } sub update_ok { my ( $self, @objects ) = @_; _lives_and_ret { $self->update( @objects ) } "updated " . scalar(@objects) . " objects"; } sub insert_ok { my ( $self, @objects ) = @_; _lives_and_ret { $self->insert( @objects ) } "inserted " . scalar(@objects) . " objects"; } sub delete_ok { my ( $self, @objects ) = @_; _lives_and_ret { $self->delete( @objects ) } "deleted " . scalar(@objects) . " objects"; } sub lookup_ok { my ( $self, @ids ) = @_; my @ret; _lives_and_ret { @ret = $self->lookup( @ids ) } "lookup " . scalar(@ids) . " objects"; local $Test::Builder::Level = $Test::Builder::Level + 1; is( scalar(grep { ref } @ret), scalar(@ids), "all lookups succeeded" ); return ( ( @ret == 1 ) ? $ret[0] : @ret ); } sub exists_ok { my ( $self, @ids ) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; is( scalar(grep { $_ } $self->exists(@ids)), scalar(@ids), "[@ids] exist in DB" ); } sub root_ok { my ( $self, @objects ) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; is( scalar(grep { $_ } $self->is_root(@objects)), scalar(@objects), "[@{[ $self->objects_to_ids(@objects) ]}] are in the root set" ); } sub not_root_ok { my ( $self, @objects ) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; is( scalar(grep { not $_ } $self->is_root(@objects)), scalar(@objects), "[@{[ $self->objects_to_ids(@objects) ]}] aren't in the root set" ); } sub deleted_ok { my ( $self, @ids ) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; is( scalar(grep { !$_ } $self->exists(@ids)), scalar(@ids), "@ids do not exist in DB" ); } sub lookup_obj_ok { my ( $self, $id, $class ) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; ok( my $obj = $self->lookup($id), "lookup $id" ); isa_ok( $obj, $class ) if $class; return $obj; } sub no_live_objects { my $self = shift; local $Test::Builder::Level = $Test::Builder::Level + 1; my $fail; my @l = $self->live_objects; my @e; my $failed; $failed++ unless is( scalar(@l), 0, "no live objects" ); unless ( $self->directory->live_objects->txn_scope ) { # no live objects should imply no live entries # however, under keep_entries a txn stack is maintained $failed++ unless is( scalar(@e), 0, "no live entries" ); @e = $self->directory->live_objects->live_entries; } if ( $failed ) { diag "live objects: " . join ", ", map { $self->object_to_id($_) . " ($_)" } @l if @l; diag "live entries: " . join ", ", map { $_->id . " (" . $_->class . ")" } @e; #use Scalar::Util qw(weaken); #weaken($_) for @l; $self->directory->live_objects->clear; #use Devel::FindRef; #my $track = Devel::FindRef::track(@l); #warn $track; #my ( @ids ) = map { hex } ( $track =~ /by \w+\(0x([a-z0-9]+)\)/ ); #warn Data::Dumper::Dumper(map { Devel::FindRef::ptr2ref($_) } @ids); } } sub no_live_entries { my $self = shift; local $Test::Builder::Level = $Test::Builder::Level + 1; my @e = $self->directory->live_objects->live_entries; unless ( is( scalar(@e), 0, "no live entries" ) ) { diag "live entries: " . join ", ", map { $_->id . " (" . $_->class . ")" } @e; $self->directory->live_objects->clear; } } sub live_objects_are { my ( $self, @objects ) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; is_deeply( [ sort $self->live_objects ], [ sort @objects ], "correct live objects" ); } sub txn_lives { my ( $self, $code, @args ) = @_; lives_ok { $self->txn_do(sub { my $s = $self->new_scope; $code->(@_); }, @args); } "transaction finished without errors"; } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Fixture =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Deferred.pm100644001750000144 1136312237006576 17033 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Setpackage KiokuDB::Set::Deferred; BEGIN { $KiokuDB::Set::Deferred::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Set::Deferred::VERSION = '0.56'; } use Moose; # ABSTRACT: Implementation of deferred set. use Carp qw(croak); use KiokuDB::Set::Loaded; use Scalar::Util qw(refaddr); use namespace::clean -except => 'meta'; with qw(KiokuDB::Set::Storage) => { -excludes => '_apply' }; extends qw(KiokuDB::Set::Base); has _linker => ( isa => "KiokuDB::Linker", is => "ro", required => 1, clearer => "_clear_linker", ); has _live_objects => ( isa => "KiokuDB::LiveObjects", is => "ro", lazy_build => 1, clearer => "_clear_live_objects", ); sub _build__live_objects { my $self = shift; $self->_linker->live_objects; } has _live_object_scope => ( isa => "KiokuDB::LiveObjects::Scope", is => "rw", weak_ref => 1, clearer => "_clear_live_object_scope", ); sub BUILD { my $self = shift; # can't use lazy build because it doesn't work with weak_ref # at any rate we need to capture the current scope at begin time $self->_live_object_scope( $self->_live_objects->current_scope ); } sub loaded { shift->size == 0 } sub includes { my ( $self, @members ) = @_; return 1 unless @members; return unless $self->size; my @ids = grep { defined } $self->_live_objects->objects_to_ids(@members); if ( @ids == @members ) { # all objects have IDs, so we check return $self->_objects->includes(@ids); } # if they didn't have IDs thenn they are not in storage, and hence not part of the set return; } sub remove { my ( $self, @members ) = @_; return 0 unless $self->size or @members; my @ids = grep { defined } $self->_live_objects->objects_to_ids(@members); return $self->_objects->remove(@ids); } sub insert { my ( $self, @members ) = @_; return unless @members; croak "Can't insert non reference into a KiokuDB::Set" if grep { not ref } @members; my @ids = grep { defined } $self->_live_objects->objects_to_ids(@members); if ( @ids == @members ) { if ( my $scope = $self->_live_object_scope ) { $scope->push(@members); # keep them around at least as long as us } # all objects have IDs, no need to load anything return $self->_objects->insert(@ids); } else { $self->_load_all; return $self->insert(@members); } } sub members { my $self = shift; return unless $self->size; $self->_load_all(); $self->members; } sub _load_all { my $self = shift; # load all the IDs my @objects = $self->_linker->get_or_load_objects($self->_objects->members); # push all the objects to the set's scope so that they live at least as long as it my $scope = $self->_live_object_scope; unless ( $scope ) { if ( my $current_scope = $self->_live_objects->current_scope ) { $scope = $current_scope; $self->_live_object_scope($scope); } else { croak "Can't vivify set, originating object scope is already dead"; } } $scope->push( @objects ); # replace the ID set with the object set $self->_set_objects( Set::Object::Weak->new(@objects) ); # and swap in loaded behavior bless $self, "KiokuDB::Set::Loaded"; } sub _all_deferred { my ( $self, @sets ) = @_; my $my_linker = refaddr($self->_linker); foreach my $set ( @sets ) { return unless $set->isa(__PACKAGE__); return unless refaddr($set->_linker) == $my_linker; } return 1; } sub _apply { my ( $self, $method, @sets ) = @_; if ( $self->_all_deferred(@sets) ) { # working in terms of IDs is OK my $res = $self->_objects->$method(map { $_->_objects } @sets); return $self->meta->clone_object( $self, set => $res ); } else { $self->_load_all; return $self->$method(@sets); } } sub _set_ids { my ( $self, $id_set ) = @_; # replace the object set with the ID set $self->_set_objects( $id_set ); } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Set::Deferred - Implementation of deferred set. =head1 VERSION version 0.56 =head1 SYNOPSIS # created automatically when sets are loaded from the database =head1 DESCRIPTION This class implements deferred sets conforming to the L API. Do not use this class directly, instead use L or L to create sets. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Tutorial000755001750000144 012237006576 15641 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBJA.pod100644001750000144 17612237006576 16763 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Tutorial# PODNAME: KiokuDB::Tutorial::JA =encoding utf8 =pod L にリネームされました。 =cut TypeMap.pm100644001750000144 116112237006576 17013 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Rolepackage KiokuDB::Role::TypeMap; BEGIN { $KiokuDB::Role::TypeMap::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Role::TypeMap::VERSION = '0.56'; } use Moose::Role; use namespace::clean -except => 'meta'; requires qw(resolve); __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Role::TypeMap =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Backend000755001750000144 012237006576 15365 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBHash.pm100644001750000144 451412237006576 16752 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backendpackage KiokuDB::Backend::Hash; BEGIN { $KiokuDB::Backend::Hash::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Hash::VERSION = '0.56'; } use Moose; # ABSTRACT: In memory backend for testing purposes. use Data::Stream::Bulk::Util qw(bulk); use Carp qw(croak); use namespace::clean -except => 'meta'; with ( 'KiokuDB::Backend::Serialize::Delegate', 'KiokuDB::Backend', 'KiokuDB::Backend::Role::Query::Simple::Linear', 'KiokuDB::Backend::Role::TXN::Memory::Scan', ); has storage => ( isa => "HashRef", is => "rw", default => sub { {} }, ); sub clear_storage { my $self = shift; %{ $self->storage } = (); } sub get_from_storage { my ( $self, @uids ) = @_; my $s = $self->storage; return if grep { not exists $s->{$_} } @uids; my @objs = map { $self->deserialize($_) } @{ $s }{@uids}; if ( @objs == 1 ) { return $objs[0]; } else { return @objs; } } sub commit_entries { my ( $self, @entries ) = @_; my $s = $self->storage; foreach my $entry ( @entries ) { my $id = $entry->id; if ( $entry->deleted ) { delete $s->{$id}; } else { if ( exists $s->{$id} and not $entry->has_prev ) { croak "Entry $id already exists in the database"; } $s->{$id} = $self->serialize($entry); } } } sub exists_in_storage { my ( $self, @uids ) = @_; map { exists $self->storage->{$_} } @uids; } sub all_storage_entries { my $self = shift; return bulk(map { $self->deserialize($_) } values %{ $self->storage }); } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Hash - In memory backend for testing purposes. =head1 VERSION version 0.56 =head1 SYNOPSIS my $dir = KiokuDB->new( backend => KiokuDB::Backend::Hash->new(), ); =head1 DESCRIPTION This L backend provides in memory storage and retrieval of L objects using L's C to make dumps of the backend clear. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut TypeMap000755001750000144 012237006576 15415 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBEntry.pm100644001750000144 243112237006576 17214 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMappackage KiokuDB::TypeMap::Entry; BEGIN { $KiokuDB::TypeMap::Entry::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Entry::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Role for KiokuDB::TypeMap entries use namespace::clean -except => 'meta'; requires "compile"; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Entry - Role for KiokuDB::TypeMap entries =head1 VERSION version 0.56 =head1 SYNOPSIS package KiokuDB::TypeMap::Foo; use Moose; with qw(KiokuDB::TypeMap::Entry); # or just use KiokuDB::TypeMap::Entry::Std sub compile { ... } =head1 DESCRIPTION This is the role consumed by all typemap entries. =head1 REQUIRED METHODS =over 4 =item compile $class This method is called by L for a given class, and should return a L object for collapsing and expanding the object. L provides a more concise way of defining typemap entries. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Employee.pm100644001750000144 137712237006576 17242 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Testpackage KiokuDB::Test::Employee; BEGIN { $KiokuDB::Test::Employee::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Employee::VERSION = '0.56'; } use Moose; use namespace::clean -except => 'meta'; extends qw(KiokuDB::Test::Person); has company => ( isa => "KiokuDB::Test::Company", is => "rw", ); sub lalala { 333 } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Employee =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Digested.pm100644001750000144 153012237006576 17202 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Testpackage KiokuDB::Test::Digested; BEGIN { $KiokuDB::Test::Digested::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Digested::VERSION = '0.56'; } use Moose; use namespace::clean -except => 'meta'; with qw( KiokuDB::Role::ID::Digest KiokuDB::Role::Immutable::Transitive MooseX::Clone ); has [qw(foo bar)] => ( is => "ro" ); sub digest_parts { my $self = shift; return $self->foo, $self->bar; } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Digested =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Transient.pm100644001750000144 274612237006576 17247 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Setpackage KiokuDB::Set::Transient; BEGIN { $KiokuDB::Set::Transient::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Set::Transient::VERSION = '0.56'; } use Moose; # ABSTRACT: Implementation of in memory sets. use Carp qw(croak); use namespace::clean -except => 'meta'; with qw(KiokuDB::Set); extends qw(KiokuDB::Set::Base); sub loaded { 1 } sub includes { shift->_objects->includes(@_) } sub remove { shift->_objects->remove(@_) } sub members { shift->_objects->members } sub insert { my ( $self, @objects ) = @_; croak "Can't insert non reference into a KiokuDB::Set" if grep { not ref } @objects; $self->_objects->insert(@objects) } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Set::Transient - Implementation of in memory sets. =head1 VERSION version 0.56 =head1 SYNOPSIS my $set = KiokuDB::Set::Transient->new( set => Set::Object->new( @objects ), ); # or use KiokuDB::Util qw(set); my $set = set(@objects); =head1 DESCRIPTION This class implements sets conforming to the L API. These sets can be constructed by the user for insertion into storage. See L for more details. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Naive000755001750000144 012237006576 15371 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/GCMark.pm100644001750000144 462212237006576 16765 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/GC/Naivepackage KiokuDB::GC::Naive::Mark; BEGIN { $KiokuDB::GC::Naive::Mark::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::GC::Naive::Mark::VERSION = '0.56'; } use Moose; use namespace::clean -except => 'meta'; with 'KiokuDB::Role::Scan' => { result_class => "KiokuDB::GC::Naive::Mark::Results" }; { package KiokuDB::GC::Naive::Mark::Results; BEGIN { $KiokuDB::GC::Naive::Mark::Results::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::GC::Naive::Mark::Results::VERSION = '0.56'; } use Moose; use Set::Object; has [qw(seen root)] => ( isa => "Set::Object", is => "ro", default => sub { Set::Object->new }, ); __PACKAGE__->meta->make_immutable; } has '+scan_all' => ( default => 0 ); has chunk_size => ( isa => "Int", is => "ro", default => 100, ); sub process_block { my ( $self, %args ) = @_; my ( $block, $res ) = @args{qw(block results)}; my ( $seen, $root ) = map { $res->$_ } qw(seen root); my ( $backend, $chunk_size ) = ( $self->backend, $self->chunk_size ); $root->insert(map { $_->id } @$block); @$block = grep { not $seen->includes($_->id) } @$block; $seen->insert(map { $_->id } @$block); my @queue; # recursively walk the entries making note of all seen entries loop: { foreach my $entry ( @$block ) { croak("ERROR: Missing entry. Run FSCK") unless $entry; my $id = $entry->id; my @candidates = grep { not $seen->includes($_) } $entry->referenced_ids; # even though we technically haven't seen them yet, insert into the # set so that we scan less data $seen->insert(@candidates); push @queue, @candidates; } if ( @queue ) { my @ids = ( @queue > $chunk_size ) ? ( splice @queue, -$chunk_size ) : splice @queue; # reuse the block array so that we throw away unnecessary data @$block = $backend->get(@ids); redo loop; } } } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::GC::Naive::Mark =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Meta000755001750000144 012237006576 14724 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBInstance.pm100644001750000144 355412237006576 17175 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Metapackage KiokuDB::Meta::Instance; BEGIN { $KiokuDB::Meta::Instance::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Meta::Instance::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Moose::Meta::Instance level support for lazy loading. use namespace::clean -except => 'meta'; around 'get_slot_value' => sub { my ( $next, $self, $instance, $slot, @args ) = @_; my $value = $self->$next($instance, $slot, @args); if ( ref($value) eq 'KiokuDB::Thunk' ) { $value = $value->vivify($instance); } return $value; }; around 'inline_get_slot_value' => sub { my ( $next, $self, $instance_expr, $slot_expr, @args ) = @_; my $get_expr = $self->$next($instance_expr, $slot_expr, @args); return 'do { my $value = ' . $get_expr . '; if ( ref($value) eq "KiokuDB::Thunk" ) { $value = $value->vivify(' . $instance_expr . '); } $value; }' }; sub inline_get_is_lvalue { 0 } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Meta::Instance - Moose::Meta::Instance level support for lazy loading. =head1 VERSION version 0.56 =head1 SYNOPSIS # use KiokuDB::Meta::Attribute::Lazy =head1 DESCRIPTION This role is applied to the meta instance class automatically by L. When it finds L objects in the low level attribute storage it will cause them to be loaded. This allows your L to remain oblivious to the fact that the value is deferred, making sure that all the type constraints, lazy defaults, and various other L features continue to work normally. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut typemap_default_storable.t100644001750000144 145012237006576 17646 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Exception; use Test::Moose; use Scalar::Util qw(reftype); use KiokuDB::TypeMap; use KiokuDB::TypeMap::Default::Storable; use KiokuDB::TypeMap::Resolver; my $t = KiokuDB::TypeMap::Default::Storable->new; my $tr = KiokuDB::TypeMap::Resolver->new( typemap => $t, ); isa_ok( $tr, "KiokuDB::TypeMap::Resolver" ); foreach my $class ( qw(DateTime DateTime::Duration Path::Class::Entity URI Tie::RefHash Authen::Passphrase) ) { my $e = $t->resolve($class); does_ok( $e, "KiokuDB::TypeMap::Entry", "entry for $class" ); my $method = $tr->expand_method($class); ok( $method, "compiled" ); is( reftype($method), "CODE", "expand method" ); } ok( !$t->resolve("JSON::Boolean"), "no JSON::Boolean" ); done_testing; Shadow.pm100644001750000144 322712237006576 17344 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMappackage KiokuDB::TypeMap::Shadow; BEGIN { $KiokuDB::TypeMap::Shadow::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Shadow::VERSION = '0.56'; } use Moose; # ABSTRACT: Try a list of KiokuDB::TypeMaps in order use namespace::clean -except => 'meta'; with qw(KiokuDB::Role::TypeMap); has typemaps => ( does => "ArrayRef[KiokuDB::Role::TypeMap]", is => "ro", required => 1, ); sub resolve { my ( $self, @args ) = @_; foreach my $typemap ( @{ $self->typemaps } ) { if ( my $entry = $typemap->resolve(@args) ) { return $entry; } } return; } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Shadow - Try a list of KiokuDB::TypeMaps in order =head1 VERSION version 0.56 =head1 SYNOPSIS KiokuDB->new( backend => ..., typemap => KiokuDB::TypeMap::Shadow->new( typemaps => [ $first, $second, ], ), ); =head1 DESCRIPTION This class is useful for performing mixin inheritance like merging of typemaps, by shadowing an ordered list. This is used internally to overlay the user typemap on top of the L instance provided by the backend. This differs from using C in L because that inclusion is computed symmetrically, like roles. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Stream000755001750000144 012237006576 15271 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBObjects.pm100644001750000144 442412237006576 17364 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Streampackage KiokuDB::Stream::Objects; BEGIN { $KiokuDB::Stream::Objects::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Stream::Objects::VERSION = '0.56'; } use Moose; # ABSTRACT: Data::Stream::Bulk with live object management. use namespace::clean -except => 'meta'; has directory => ( isa => "KiokuDB", is => "ro", required => 1, ); has entry_stream => ( does => "Data::Stream::Bulk", is => "ro", required => 1, handles => [qw(is_done loaded)], ); has linker => ( isa => "KiokuDB::Linker", is => "ro", lazy_build => 1, ); sub _build_linker { my $self = shift; $self->directory->linker; } has live_objects => ( isa => "KiokuDB::LiveObjects", is => "ro", lazy_build => 1, ); sub _build_live_objects { my $self = shift; $self->directory->live_objects; } has _scope => ( isa => "KiokuDB::LiveObjects::Scope", writer => "_scope", clearer => "_clear_scope", ); has _no_scope => ( isa => "Bool", is => "rw", ); with qw(Data::Stream::Bulk) => { -version => 0.08, -excludes => 'loaded' }; sub next { my $self = shift; $self->_clear_scope; my $entries = $self->entry_stream->next || return;; if ( @$entries ) { $self->_scope( $self->directory->new_scope ) unless $self->_no_scope; for my $entry (@$entries) { $self->live_objects->register_entry( $entry->id => $entry, in_storage => 1 ) unless $self->live_objects->id_to_entry($entry->id); } return [ $self->linker->expand_objects(@$entries) ]; } else { return []; } } before all => sub { shift->_no_scope(1) }; __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Stream::Objects - Data::Stream::Bulk with live object management. =head1 VERSION version 0.56 =head1 DESCRIPTION This class is for object streams coming out of L. C is called once for each block, and then cleared. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Intrinsic.pm100644001750000144 157312237006576 17405 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Rolepackage KiokuDB::Role::Intrinsic; BEGIN { $KiokuDB::Role::Intrinsic::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Role::Intrinsic::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: A role for value objects use namespace::clean -except => 'meta'; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Role::Intrinsic - A role for value objects =head1 VERSION version 0.56 =head1 SYNOPSIS with qw(KiokuDB::Role::Intrinsic); =head1 DESCRIPTION When L detects this role on objects they are collapsed into their parent by default, without needing an explicit typemap entry. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Immutable.pm100644001750000144 246112237006576 17357 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Rolepackage KiokuDB::Role::Immutable; BEGIN { $KiokuDB::Role::Immutable::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Role::Immutable::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: A role for objects that are never updated. use namespace::clean -except => 'meta'; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Role::Immutable - A role for objects that are never updated. =head1 VERSION version 0.56 =head1 SYNOPSIS with qw(KiokuDB::Role::Immutable); =head1 DESCRIPTION This is a role for objects that are never updated after they are inserted to the database. The object will be skipped entirely on all update/store operations unless it is being collapsed for the first time, and its child objects will B be updated unless they are found while collapsing another object. This means that: my $immutable = $kiokudb->lookup($id); $immutable->child->name("foo"); $kiokudb->update($immutable); will not work, you need to update the child directly: $kiokudb->update($immutable->child); =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Verbosity.pm100644001750000144 220712237006576 17424 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Rolepackage KiokuDB::Role::Verbosity; BEGIN { $KiokuDB::Role::Verbosity::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Role::Verbosity::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: A role for printing diagnosis to STDERR use namespace::clean -except => 'meta'; has verbose => ( isa => "Bool", is => "ro", ); sub BUILD { my $self = shift; STDERR->autoflush(1) if $self->verbose; } sub v { my $self = shift; return unless $self->verbose; STDERR->print(@_); } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Role::Verbosity - A role for printing diagnosis to STDERR =head1 VERSION version 0.56 =head1 SYNOPSIS $self->v("blah blah\n"); # only printed if $self->verbose is true =head1 DESCRIPTION This role provides the C attribute and a C method that you can use to emit verbose output to C. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Cacheable.pm100644001750000144 117112237006576 17264 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Rolepackage KiokuDB::Role::Cacheable; BEGIN { $KiokuDB::Role::Cacheable::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Role::Cacheable::VERSION = '0.56'; } use Moose::Role; use namespace::clean -except => 'meta'; # ex: set sw=4 et: __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Role::Cacheable =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut ID000755001750000144 012237006576 15233 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/RoleDigest.pm100644001750000144 145112237006576 17151 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Role/IDpackage KiokuDB::Role::ID::Digest; BEGIN { $KiokuDB::Role::ID::Digest::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Role::ID::Digest::VERSION = '0.56'; } use Moose::Role; use namespace::clean -except => 'meta'; with qw( KiokuDB::Role::ID::Content KiokuDB::Role::WithDigest ); sub kiokudb_object_id { shift->digest } #has '+digest' => ( traits => [qw(KiokuDB::ID)] ); # to avoid data redundancy? __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Role::ID::Digest =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Sweep.pm100644001750000144 303312237006576 17151 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/GC/Naivepackage KiokuDB::GC::Naive::Sweep; BEGIN { $KiokuDB::GC::Naive::Sweep::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::GC::Naive::Sweep::VERSION = '0.56'; } use Moose; use namespace::clean -except => 'meta'; use KiokuDB::GC::Naive::Mark; with 'KiokuDB::Role::Scan' => { result_class => "KiokuDB::GC::Naive::Sweep::Results" }; { package KiokuDB::GC::Naive::Sweep::Results; BEGIN { $KiokuDB::GC::Naive::Sweep::Results::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::GC::Naive::Sweep::Results::VERSION = '0.56'; } use Moose; use Set::Object; has [qw(garbage)] => ( isa => "Set::Object", is => "ro", default => sub { Set::Object->new }, ); __PACKAGE__->meta->make_immutable; } has '+scan_ids' => ( default => 1 ); has mark_results => ( isa => "KiokuDB::GC::Naive::Mark::Results", is => "ro", required => 1, handles => qr/.*/, ); sub process_block { my ( $self, %args ) = @_; my ( $ids, $res ) = @args{qw(block results)}; my $seen = $self->seen; my @garbage = grep { not $seen->includes($_) } @$ids; $res->garbage->insert(@garbage); } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::GC::Naive::Sweep =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut typemap_entry_passthrough.t100644001750000144 767112237006576 20132 0ustar00doyusers000000000000KiokuDB-0.56/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Scalar::Util qw(refaddr blessed); use KiokuDB::TypeMap::Entry::Passthrough; use KiokuDB::TypeMap::Entry::Naive; use KiokuDB::TypeMap::Resolver; use KiokuDB::Collapser; use KiokuDB::Linker; use KiokuDB::LiveObjects; use KiokuDB::Backend::Hash; { package KiokuDB_Test_Foo; use Moose; has foo => ( is => "rw" ); package KiokuDB_Test_Bar; use Moose; has foo => ( is => "rw" ); package KiokuDB_Test_Gorch; use Moose; has foo => ( is => "rw" ); } my $foo = KiokuDB_Test_Foo->new( foo => "HALLO" ); my $bar = KiokuDB_Test_Gorch->new( foo => KiokuDB_Test_Bar->new( foo => "LULZ" ) ); my $p = KiokuDB::TypeMap::Entry::Passthrough->new(); my $pi = KiokuDB::TypeMap::Entry::Passthrough->new( intrinsic => 1 ); my $n = KiokuDB::TypeMap::Entry::Naive->new; my $tr = KiokuDB::TypeMap::Resolver->new( typemap => KiokuDB::TypeMap->new( entries => { KiokuDB_Test_Foo => $p, KiokuDB_Test_Bar => $pi, }, ), ); my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => KiokuDB::LiveObjects->new, typemap_resolver => $tr, ); my $sc = $v->live_objects->new_scope; my $l = KiokuDB::Linker->new( backend => KiokuDB::Backend::Hash->new, live_objects => KiokuDB::LiveObjects->new, typemap_resolver => $tr, ); { $l->live_objects->clear; my $sl = $l->live_objects->new_scope; my ( $buffer ) = $v->collapse( objects => [ $foo ], ); my $entries = $buffer->_entries; is( scalar(keys %$entries), 1, "one entry" ); my $entry = ( values %$entries )[0]; isa_ok( $entry->data, "KiokuDB_Test_Foo", "entry data" ); is( refaddr($entry->data), refaddr($foo), "refaddr equals" ); my $expanded = $l->expand_object($entry); isa_ok( $expanded, "KiokuDB_Test_Foo", "expanded object" ); is( refaddr($expanded), refaddr($foo), "refaddr equals" ); } { $l->live_objects->clear; my $sl = $l->live_objects->new_scope; my ( $buffer ) = $v->collapse( objects => [ $bar ], ); my $entries = $buffer->_entries; is( scalar(keys %$entries), 1, "one entry" ); my $entry = ( values %$entries )[0]; is( (blessed($entry->data)||''), '', "entry data not blessed" ); isa_ok( $entry->data->{foo}, "KiokuDB_Test_Bar", "intrinsic entry" ); is( refaddr($entry->data->{foo}), refaddr($bar->foo), "refaddr equals" ); my $expanded = $l->expand_object($entry); isa_ok( $expanded, "KiokuDB_Test_Gorch", "expanded object" ); is( refaddr($expanded->foo), refaddr($bar->foo), "expanded intrinsic refaddr" ); is_deeply( $expanded->foo, $bar->foo, "eq deeply" ); } # inflate data edge cases for backwards compat { $l->live_objects->clear; my $sl = $l->live_objects->new_scope; my ( $buffer ) = $v->collapse( objects => [ $bar ], ); my $entries = $buffer->_entries; is( scalar(keys %$entries), 1, "one entry" ); my $entry = ( values %$entries )[0]; $entry->data->{foo} = KiokuDB::Entry->new( data => $entry->data->{foo} ); my $expanded = $l->expand_object($entry); isa_ok( $expanded, "KiokuDB_Test_Gorch", "expanded object" ); is( refaddr($expanded->foo), refaddr($bar->foo), "expanded intrinsic refaddr" ); is_deeply( $expanded->foo, $bar->foo, "eq deeply" ); } { $l->live_objects->clear; my $sl = $l->live_objects->new_scope; my ( $buffer ) = $v->collapse( objects => [ $bar ], ); my $entries = $buffer->_entries; is( scalar(keys %$entries), 1, "one entry" ); my $entry = ( values %$entries )[0]; $entry->data->{foo} = KiokuDB::Entry->new( data => $entry->data->{foo}, class => ref($entry->data->{foo}) ); my $expanded = $l->expand_object($entry); isa_ok( $expanded, "KiokuDB_Test_Gorch", "expanded object" ); is( refaddr($expanded->foo), refaddr($bar->foo), "expanded intrinsic refaddr" ); is_deeply( $expanded->foo, $bar->foo, "eq deeply" ); } done_testing; Serializer000755001750000144 012237006576 16147 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBYAML.pm100644001750000144 135512237006576 17413 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Serializerpackage KiokuDB::Serializer::YAML; BEGIN { $KiokuDB::Serializer::YAML::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Serializer::YAML::VERSION = '0.56'; } use Moose; use namespace::clean -except => 'meta'; with qw( KiokuDB::Serializer KiokuDB::Backend::Serialize::YAML ); sub file_extension { "yml" } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Serializer::YAML =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut JSON.pm100644001750000144 135612237006576 17423 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Serializerpackage KiokuDB::Serializer::JSON; BEGIN { $KiokuDB::Serializer::JSON::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Serializer::JSON::VERSION = '0.56'; } use Moose; use namespace::clean -except => 'meta'; with qw( KiokuDB::Serializer KiokuDB::Backend::Serialize::JSON ); sub file_extension { "json" } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Serializer::JSON =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Default.pm100644001750000144 660012237006576 17501 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMappackage KiokuDB::TypeMap::Default; BEGIN { $KiokuDB::TypeMap::Default::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Default::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: A standard KiokuDB::TypeMap with predefined entries. use namespace::clean -except => 'meta'; with qw(KiokuDB::TypeMap::Composite); has intrinsic_sets => ( isa => "Bool", is => "ro", default => 0, ); has [qw( core_typemap tie_typemap path_class_typemap uri_typemap datetime_typemap authen_passphrase_typemap )] => ( traits => [qw(KiokuDB::TypeMap)], does => "KiokuDB::Role::TypeMap", is => "ro", lazy_build => 1, ); requires qw( _build_path_class_typemap _build_uri_typemap _build_datetime_typemap _build_authen_passphrase_typemap ); sub _build_core_typemap { my $self = shift; $self->_create_typemap( entries => { $self->reftype_entries }, isa_entries => { 'KiokuDB::Set::Base' => { type => "KiokuDB::TypeMap::Entry::Set", intrinsic => $self->intrinsic_sets, }, }, ); } sub reftype_entries { return ( 'ARRAY' => "KiokuDB::TypeMap::Entry::Ref", 'HASH' => "KiokuDB::TypeMap::Entry::Ref", 'SCALAR' => "KiokuDB::TypeMap::Entry::Ref", 'REF' => "KiokuDB::TypeMap::Entry::Ref", 'GLOB' => "KiokuDB::TypeMap::Entry::Ref", 'CODE' => "KiokuDB::TypeMap::Entry::Closure", ); } sub _build_tie_typemap { my $self = shift; $self->_create_typemap( isa_entries => { 'Tie::RefHash' => { type => 'KiokuDB::TypeMap::Entry::StorableHook', intrinsic => 1, }, }, entries => { 'Tie::IxHash' => { type => 'KiokuDB::TypeMap::Entry::Naive', intrinsic => 1, }, }, ); } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Default - A standard KiokuDB::TypeMap with predefined entries. =head1 VERSION version 0.56 =head1 SYNOPSIS # the user typemap implicitly inherits from the default one, which is # provided by the backend. my $dir = KiokuDB->new( backend => $b, typemap => $user_typemap, ); =head1 DESCRIPTION The default typemap is actually defined per backend, in L and L. The list of classes handled by both is the same, but the typemap entries themselves are tailored to the specific backend's requirements/capabilities. The entries have no impact unless you are actually using the listed modules. The default typemap is created using L and accepts all the standard options =head1 SUPPORTED TYPES The following typemaps provide support for these classes: =over 4 =item core L =item tie L, L =item datetime L =item uri_typemap L, L =item path_class L =item authen_passphrase L =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut WithDigest.pm100644001750000144 432312237006576 17512 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Rolepackage KiokuDB::Role::WithDigest; BEGIN { $KiokuDB::Role::WithDigest::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Role::WithDigest::VERSION = '0.56'; } use Moose::Role; use Carp qw(croak); use Digest::SHA qw(sha1_hex); use MooseX::Clone::Meta::Attribute::Trait::NoClone; use namespace::clean -except => 'meta'; has digest => ( traits => [qw(NoClone)], isa => "Str", is => "ro", lazy_build => 1, ); requires 'digest_parts'; sub _build_digest { my $self = shift; $self->_compute_digest( $self->_build_digest_strings ); } sub _compute_digest { my ( $self, @strings ) = @_; no warnings 'uninitialized'; sha1_hex(join ":", ref($self), @strings); } sub _build_digest_strings { my $self = shift; my @parts = $self->digest_parts; my @strings; foreach my $part ( $self->digest_parts ) { if ( ref $part ) { push @strings, $self->_extract_digest_input_strings($part); } else { push @strings, $part; } } return @strings; } sub _extract_digest_input_strings { my ( $self, $part ) = @_; return $part unless ref $part; no warnings 'uninitialized'; if ( blessed($part) ) { if ( $part->can("kiokudb_object_id") ) { return $part->kiokudb_object_id; } elsif ( $part->can("digest") ) { return $part->digest; } else { croak "Can't digest $part (no digest or ID method)"; } } elsif ( ref $part eq 'ARRAY' ) { return join("", '[', join(",", map { $self->_extract_digest_input_strings($_) } @$part), ']'); } elsif ( ref $part eq 'HASH' ) { return join("", '{', join(",", map { $_, ":", $self->_extract_digest_input_strings($part->{$_}) } sort keys %$part), '}'); } else { croak "Can't digest $part (not a simple ref type)"; } } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Role::WithDigest =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Content.pm100644001750000144 277612237006576 17357 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Role/IDpackage KiokuDB::Role::ID::Content; BEGIN { $KiokuDB::Role::ID::Content::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Role::ID::Content::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Content dependent object IDs use namespace::clean -except => 'meta'; with qw( KiokuDB::Role::ID KiokuDB::Role::Immutable ); __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Role::ID::Content - Content dependent object IDs =head1 VERSION version 0.56 =head1 SYNOPSIS package BLOB; use Moose; use Digest::SHA1; with qw(KiokuDB::Role::ID::Content); sub kiokudb_object_id { my $self = shift; sha1_hex($self->data); } has data => ( isa => "Str", is => "ro", required => 1, ); =head1 DESCRIPTION This is a role for L objects whose IDs depend on their content, or in other words content addressable objects. A canonical example is a string identified by its SHA-1 hash, as is demonstrated in the L. Objects which do this role are never updated in the database just like L objects. Additionally, it is not an error to insert such objects twice since the objects are assumed to be identical. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Role000755001750000144 012237006576 16266 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/BackendGC.pm100644001750000144 124312237006576 17255 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Rolepackage KiokuDB::Backend::Role::GC; BEGIN { $KiokuDB::Backend::Role::GC::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Role::GC::VERSION = '0.56'; } use Moose::Role; use namespace::clean -except => "meta"; requires qw(new_garbage_collector); # ex: set sw=4 et: __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Role::GC =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Collapser000755001750000144 012237006576 15762 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBBuffer.pm100644001750000144 1315512237006576 17716 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Collapserpackage KiokuDB::Collapser::Buffer; BEGIN { $KiokuDB::Collapser::Buffer::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Collapser::Buffer::VERSION = '0.56'; } use Moose; use Hash::Util::FieldHash::Compat qw(idhash); use Set::Object; use namespace::clean -except => 'meta'; has live_objects => ( isa => "KiokuDB::LiveObjects", is => "ro", required => 1, ); has _objects => ( isa => "HashRef", is => "ro", default => sub { idhash my %hash }, ); sub object_to_id { my ( $self, $object ) = @_; $self->_objects->{$object}; } sub merged_objects_to_ids { my ( $self, @objects ) = @_; my $l = $self->live_objects; map { $self->object_to_id($_) || $l->object_to_id($_) } @objects; } has _ids => ( isa => "HashRef", is => "ro", default => sub { return {} }, ); has _entry_args => ( isa => "HashRef", is => "ro", default => sub { return {} }, ); sub id_to_object { my ( $self, $id ) = @_; if ( defined ( my $obj = $self->_ids->{$id} ) ) { return $obj; } else { return $self->live_objects->id_to_object($id); } } has entries => ( traits => ["Hash"], isa => "HashRef", reader => "_entries", default => sub { return {} }, handles => { entries => "values", ids => "keys", }, ); sub id_to_entry { my ( $self, $id ) = @_; $self->_entries->{$id}; } has intrinsic => ( isa => "HashRef", is => "ro", default => sub { idhash my %hash }, ); sub intrinsic_entry { my ( $self, $obj ) = @_; $self->intrinsic->{$obj}; } sub insert_intrinsic { my ( $self, $object, $entry ) = @_; $self->intrinsic->{$object} = $entry; } # a list of the IDs of all simple entries has simple_entries => ( isa => 'ArrayRef', is => "ro", default => sub { [] }, ); # first_class keeps track of the simple references which are first class # (either weak or shared, and must have an entry) has first_class => ( isa => 'Set::Object', is => "ro", default => sub { Set::Object->new }, ); has options => ( isa => 'HashRef', is => "ro", default => sub { {} }, ); sub insert { my ( $self, $id, $object, @args ) = @_; $self->_objects->{$object} = $id; $self->_ids->{$id} = $object; $self->_entry_args->{$id} = \@args if @args; } sub insert_entry { my ( $self, $id, $entry, $object, @args ) = @_; $self->_entries->{$id} = $entry; $self->insert($id, $object, @args); } sub compact_entries { my $self = shift; my ( $entries, $fc, $simple, $options ) = ( $self->_entries, $self->first_class, $self->simple_entries, $self->options ); # unify non shared simple references if ( my @flatten = grep { not $fc->includes($_) } @$simple ) { my %flatten; @flatten{@flatten} = delete @{$entries}{@flatten}; $self->compact_entry($_, \%flatten) for values %$entries; } } sub compact_entry { my ( $self, $entry, $flatten ) = @_; my $data = $entry->data; if ( $self->compact_data($data, $flatten) ) { $entry->_data($data); } } sub compact_data { my ( $self, $data, $flatten ) = @_; if ( ref $data eq 'KiokuDB::Reference' ) { my $id = $data->id; if ( my $entry = $flatten->{$id} ) { # replace reference with data from entry, so that the # simple data is inlined, and mark that entry for removal $self->compact_entry($entry, $flatten); if ( $entry->tied or $entry->class ) { $entry->clear_id; $_[1] = $entry; } else { $_[1] = $entry->data; } return 1; } } elsif ( ref($data) eq 'ARRAY' ) { ref && $self->compact_data($_, $flatten) for @$data; } elsif ( ref($data) eq 'HASH' ) { ref && $self->compact_data($_, $flatten) for values %$data; } elsif ( ref($data) eq 'SCALAR' || ref($data) eq 'REF' ) { $self->compact_data($$data, $flatten); } elsif ( ref($data) eq 'KiokuDB::Entry' ) { $self->compact_entry($data, $flatten); } else { # passthrough } return; } sub imply_root { my ( $self, @ids ) = @_; my $entries = $self->_entries; foreach my $id ( @ids ) { my $entry = $entries->{$id} or next; next if $entry->has_root; # set by typemap $entry->root(1); } } sub commit { my ( $self, $backend ) = @_; my $l = $self->live_objects; $self->insert_to_backend($backend); $self->update_entries( in_storage => 1 ); } sub insert_to_backend { my ( $self, $backend ) = @_; $backend->insert($self->entries); } sub update_entries { my ( $self, @shared_args ) = @_; my ( $e, $o ) = ( $self->_entries, $self->_ids ); my $l = $self->live_objects; my $args = $self->_entry_args; foreach my $id ( keys %$e ) { my ( $object, $entry ) = ( $o->{$id}, $e->{$id} ); my @args = @{ $args->{$id} || [] }; # FIXME XXX FIXME FIXME XXX BLAH BLAH $l->register_entry( $id => $entry, @shared_args ); unless ( $l->object_to_id($object) ) { $l->register_object( $id => $object, @args ); } else { $l->update_object_entry( $object, $entry, @args ); } } } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Collapser::Buffer =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Resolver.pm100644001750000144 645712237006576 17730 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMappackage KiokuDB::TypeMap::Resolver; BEGIN { $KiokuDB::TypeMap::Resolver::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Resolver::VERSION = '0.56'; } use Moose; # ABSTRACT: Caching resolver for KiokuDB::TypeMap use Carp qw(croak); use KiokuDB::TypeMap; use KiokuDB::TypeMap::Entry::MOP; use namespace::clean -except => 'meta'; has typemap => ( does => "KiokuDB::Role::TypeMap", is => "ro", ); has _compiled => ( isa => "HashRef", is => "ro", default => sub { return {} }, ); has fallback_entry => ( does => "KiokuDB::TypeMap::Entry", is => "ro", default => sub { KiokuDB::TypeMap::Entry::MOP->new }, ); sub clear_compiled { my $self = shift; %{ $self->_compiled } = (); } sub resolved { my ( $self, $class ) = @_; exists $self->_compiled->{$class}; } sub collapse_method { my ( $self, $class ) = @_; return $self->find_or_resolve($class)->collapse_method; } sub expand_method { my ( $self, $class ) = @_; return $self->find_or_resolve($class)->expand_method; } sub refresh_method { my ( $self, $class ) = @_; return $self->find_or_resolve($class)->refresh_method; } sub id_method { my ( $self, $class ) = @_; return $self->find_or_resolve($class)->id_method; } sub compile_entry { my ( $self, $class, $entry ) = @_; return $self->register_compiled( $class, $entry->compile($class, $self) ); } sub register_compiled { my ( $self, $class, $compiled ) = @_; return ( $self->_compiled->{$class} = $compiled ); } sub find_or_resolve { my ( $self, $class ) = @_; return ( $self->_compiled->{$class} || $self->resolve($class) ); } sub resolve { my ( $self, $class ) = @_; if ( my $entry = $self->typemap->resolve($class) ) { return $self->compile_entry( $class, $entry ); } else { return $self->resolve_fallback($class); } } sub resolve_fallback { my ( $self, $class ) = @_; if ( my $meta = Class::MOP::get_metaclass_by_name($class) ) { return $self->resolve_fallback_with_meta($class, $meta); } else { return $self->resolve_fallback_without_meta($class); } } sub resolve_fallback_with_meta { my ( $self, $class, $meta ) = @_; # FIXME only allow with Storage? return $self->compile_entry( $class => $self->fallback_entry ); } sub resolve_fallback_without_meta { my ( $self, $class ) = @_; croak "$class has no metaclass, please provide a typemap entry or add to the allowed classes"; } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Resolver - Caching resolver for KiokuDB::TypeMap =head1 VERSION version 0.56 =head1 SYNOPSIS This object is used by L and L to map class names to collapsing/expanding method bodies. Since Ls are fairly complex, and L objects can benefit from specializing to a class by precomputing some things, resolution is performed once per class, and the results are cached in the resolver. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Fixture000755001750000144 012237006576 16403 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TestCAS.pm100644001750000144 552112237006576 17512 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Test/Fixturepackage KiokuDB::Test::Fixture::CAS; BEGIN { $KiokuDB::Test::Fixture::CAS::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Fixture::CAS::VERSION = '0.56'; } use Moose; use Test::More; use Scalar::Util qw(weaken); use KiokuDB::Test::Digested; use namespace::clean -except => 'meta'; with qw(KiokuDB::Test::Fixture); sub create { my $self = shift; KiokuDB::Test::Digested->new( foo => "pizza", ); } sub verify { my $self = shift; $self->no_live_objects; my $l = $self->directory->live_objects; my $cache = $l->cache; my $old_value = $l->leak_tracker; my $reset = Scope::Guard->new(sub { if ( $old_value ) { $l->leak_tracker($old_value); } else { $l->clear_leak_tracker; } }); $l->leak_tracker(sub { my $i = $Test::Builder::Level || 1; $i++ until (caller($i))[1] eq __FILE__; local $Test::Builder::Level = $i + 2; fail("no leaks"); diag("leaked @_"), }); my $id = $self->populate_ids->[0]; $self->txn_lives(sub { my $obj = $self->lookup_ok($id); is( $obj->digest, $id, "id is object digest" ); is( $obj->foo, "pizza", "field retained" ); }); if ( $cache ) { isa_ok( my $cached = $cache->get($id), "KiokuDB::Test::Digested", "cached object" ); $self->live_objects_are($cached); $cache->clear; } $self->no_live_objects(); $self->txn_lives(sub { # test idempotent insertions $self->insert_ok( KiokuDB::Test::Digested->new( foo => "pizza" ) ); }); $cache->clear if $cache; $self->no_live_objects(); $self->txn_lives(sub { my $obj = $self->lookup_ok($id); my $new_id = $self->insert_ok( $obj->clone ); local $TODO = "ID not yet returned"; is( $new_id, $id, "idempotent add when instance already live" ); }); $cache->clear if $cache; $self->no_live_objects(); $self->txn_lives(sub { my $obj = $self->lookup_ok($id); my $new_id = $self->insert_ok( $obj->clone( bar => "blah" ) ); ok( $new_id, "got a new ID" ); isnt( $new_id, $id, "idempotent add when instance already live" ); }); if ( $cache ) { isa_ok( my $cached = $cache->get($id), "KiokuDB::Test::Digested", "cached object" ); $self->live_objects_are($cached); $cache->clear; } $self->no_live_objects(); } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Fixture::CAS =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut TXN.pm100644001750000144 1566112237006576 17603 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Test/Fixturepackage KiokuDB::Test::Fixture::TXN; BEGIN { $KiokuDB::Test::Fixture::TXN::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Fixture::TXN::VERSION = '0.56'; } use Moose; use Test::More; use Test::Exception; use namespace::clean -except => 'meta'; extends qw(KiokuDB::Test::Fixture::Small); use constant required_backend_roles => qw(TXN); sub sort { 150 } around populate => sub { my ( $next, $self, @args ) = @_; $self->txn_do(sub { $self->$next(@args) }); }; sub verify { my $self = shift; my $l = $self->directory->live_objects; $self->exists_ok($self->joe); my $keep = $self->directory->live_objects->keep_entries; { my $s = $self->new_scope; my $joe = $self->lookup_ok( $self->joe ); is( $joe->name, "joe", "name attr" ); my $entry = $l->objects_to_entries($joe); isa_ok( $entry, "KiokuDB::Entry" ) if $keep; lives_ok { $self->txn_do(sub { $joe->name("HALLO"); $self->update_ok($joe); if ( $keep ) { my $updated_entry = $l->objects_to_entries($joe); isnt( $updated_entry, $entry, "entry updated" ); is( $updated_entry->prev, $entry, "parent of updated is orig" ); } }); } "successful transaction"; if ( $keep ) { my $updated_entry = $l->objects_to_entries($joe); isnt( $updated_entry, $entry, "entry updated" ); is( $updated_entry->prev, $entry, "parent of updated is orig" ); } is( $joe->name, "HALLO", "name attr" ); undef $joe; } $self->no_live_objects; { { my $s = $self->new_scope; my $joe = $self->lookup_ok( $self->joe ); my $entry = $l->objects_to_entries($joe); isa_ok( $entry, "KiokuDB::Entry" ) if $keep; throws_ok { $self->txn_do(sub { $joe->name("YASE"); $self->update_ok($joe); if ( $keep ) { my $updated_entry = $l->objects_to_entries($joe); isnt( $updated_entry, $entry, "entry updated" ); is( $updated_entry->prev, $entry, "parent of updated is orig" ); } die "foo"; }); } qr/foo/, "failed transaction"; if ( $keep ) { my $updated_entry = $l->objects_to_entries($joe); is( $updated_entry, $entry, "entry rolled back" ); } is( $joe->name, "YASE", "name not rolled back in live object" ); undef $joe; } $self->no_live_objects; { my $s = $self->new_scope; my $joe = $self->lookup_ok( $self->joe ); is( $joe->name, "HALLO", "name rolled back in DB" ); undef $joe; } $self->no_live_objects; } # txn_do nesting should still work, even if nested transactions are not supported { { my $s = $self->new_scope; my $joe = $self->lookup_ok( $self->joe ); is( $joe->name, "HALLO", "name attr" ); my $entry = $l->objects_to_entries($joe); isa_ok( $entry, "KiokuDB::Entry" ) if $keep; throws_ok { $self->txn_do(sub { $joe->name("lalalala"); $self->update_ok($joe); $self->txn_do(sub { $joe->name("oi"); $self->update_ok($joe); if ( $keep ) { my $updated_entry = $l->objects_to_entries($joe); isnt( $updated_entry, $entry, "entry updated" ); is( $updated_entry->prev->prev, $entry, "parent of parent of updated is orig" ); } die "foo"; }); }); } qr/foo/, "failed transaction"; if ( $keep ) { my $updated_entry = $l->objects_to_entries($joe); is( $updated_entry, $entry, "entry rolled back" ); } is( $joe->name, "oi", "name attr of object" ); undef $joe; } $self->no_live_objects; { my $s = $self->new_scope; my $joe = $self->lookup_ok( $self->joe ); is( $joe->name, "HALLO", "name rolled back in DB" ); undef $joe; } $self->no_live_objects; } { $self->txn_do( scope => 1, body => sub { my $s = $self->new_scope; { my $s = $self->new_scope; my $joe = $self->lookup_ok( $self->joe ); $joe->name("YASE"); $self->update_ok($joe); } $self->no_live_entries unless $self->backend->does("KiokuDB::Backend::Role::TXN::Memory"); }); $self->no_live_entries unless $self->backend->does("KiokuDB::Backend::Role::TXN::Memory"); } { { my $s = $self->new_scope; my $joe = $self->lookup_ok( $self->joe ); throws_ok { $self->txn_do(sub { $self->delete_ok($joe); $self->deleted_ok($self->joe); die "foo"; }); } qr/foo/, "failed transaction"; $self->exists_ok($self->joe); undef $joe; } $self->no_live_objects; { my $s = $self->new_scope; $self->exists_ok($self->joe); $self->lookup_ok( $self->joe ); } $self->no_live_objects; } { { my $s = $self->new_scope; throws_ok { $self->txn_do(sub { $self->delete_ok($self->joe); $self->deleted_ok($self->joe); die "foo"; }); } qr/foo/, "failed transaction"; $self->exists_ok($self->joe); } $self->no_live_objects; $self->exists_ok($self->joe); } { { my $s = $self->new_scope; $self->txn_do(sub { $self->delete_ok($self->joe); $self->deleted_ok($self->joe); }); $self->deleted_ok($self->joe); } $self->no_live_objects; $self->deleted_ok($self->joe); } } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Fixture::TXN =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut TXN.pm100644001750000144 543312237006576 17442 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Rolepackage KiokuDB::Backend::Role::TXN; BEGIN { $KiokuDB::Backend::Role::TXN::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Role::TXN::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Backend level transaction support. use Carp qw(croak); use Try::Tiny; use namespace::clean -except => 'meta'; requires qw(txn_begin txn_commit txn_rollback); sub txn_do { my ( $self, $coderef, %args ) = @_; my @args = @{ $args{args} || [] }; my ( $commit, $rollback ) = @args{qw(commit rollback)}; ref $coderef eq 'CODE' or croak '$coderef must be a CODE reference'; my @txn_args = $self->txn_begin; try { my @ret; if ( wantarray ) { @ret = $coderef->(@args); } elsif ( defined wantarray ) { $ret[0] = $coderef->(@args); } else { $coderef->(@args); } $commit->() if $commit; $self->txn_commit(@txn_args); return wantarray ? @ret : $ret[0]; } catch { my $err = $_; try { $self->txn_rollback(@txn_args); $rollback->() if $rollback; } catch { croak "Transaction aborted: $err, rollback failed: $_"; }; die $err; } } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Role::TXN - Backend level transaction support. =head1 VERSION version 0.56 =head1 SYNOPSIS package MyBackend; use Moose; with qw( KiokuDB::Backend KiokuDB::Backend::Role::TXN ); sub txn_begin { ... } sub txn_commit { ... } sub txn_rollback { ... } =head1 DESCRIPTION This API is inspired by standard database transactions much like you get with L. This is the low level interface required by L. =head1 OPTIONAL METHODS =over 4 =item txn_do $code, %callbacks This method should evaluate the code reference in the context of a transaction, inside an C. If any errors are caught the transaction should be aborted, otherwise it should be committed. This is much like L. The C callback should be fired when the transaction will be aborted. =back =head1 REQUIRED METHODS =over 4 =item txn_begin [ $parent_txn ] Begin a new transaction. This method can return a transaction handle that will later be passed to C or C as necessary. The current handle will be passed to nested calls to C. =item txn_commit $txn Commit the transaction. =item txn_rollback $txn Rollback the transaction. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Memory.pm100644001750000144 130112237006576 20110 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Serializerpackage KiokuDB::Serializer::Memory; BEGIN { $KiokuDB::Serializer::Memory::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Serializer::Memory::VERSION = '0.56'; } use Moose; use namespace::clean -except => 'meta'; with qw( KiokuDB::Backend::Serialize::Memory ); __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Serializer::Memory =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Composite.pm100644001750000144 1536612237006576 20110 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMappackage KiokuDB::TypeMap::Composite; BEGIN { $KiokuDB::TypeMap::Composite::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Composite::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: A role for KiokuDB::TypeMaps created out of many smaller typemaps use KiokuDB::TypeMap; use namespace::clean -except => 'meta'; { package KiokuDB::TypeMap::Composite::TypeMapAttr; BEGIN { $KiokuDB::TypeMap::Composite::TypeMapAttr::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Composite::TypeMapAttr::VERSION = '0.56'; } use Moose::Role; use namespace::clean -except => 'meta'; sub Moose::Meta::Attribute::Custom::Trait::KiokuDB::TypeMap::register_implementation { __PACKAGE__ } } has override => ( isa => "HashRef[HashRef]", is => "ro", default => sub { +{} }, ); has exclude => ( isa => "ArrayRef[Str]", is => "ro", default => sub { [] }, ); has _exclude => ( is => "ro", lazy_build => 1, ); sub _build__exclude { my $self = shift; return { map { $_ => undef } @{ $self->exclude } }; } sub _build_includes { my $self = shift; my @attrs = $self->meta->get_all_attributes; my $exclude = $self->_exclude; my @typemap_attrs = grep { ( my $short_name = $_->name ) =~ s/_typemap$//; $_->does("KiokuDB::TypeMap::Composite::TypeMapAttr") and ( !$short_name or !exists($exclude->{$short_name}) ) and !exists($exclude->{$_->name}) } @attrs; return [ map { $_->get_value($self) } @typemap_attrs ]; } sub _construct_entry { my ( $self, @args ) = @_; my $args = $self->_entry_options(@args); my $type = delete $args->{type}; Class::MOP::load_class($type); $type->new($args); } sub _entry_options { my ( $self, %args ) = @_; my $class = delete $args{class}; return { %args, %{ $self->override->{$class} || {} }, }; } sub _create_entry { my ( $self, $class, $entry ) = @_; return if exists $self->_exclude->{$class}; if ( blessed $entry ) { return ( $class => $entry ); } elsif ( ref $entry ) { return ( $class => $self->_construct_entry( %$entry, class => $class ) ); } else { return ( $class => $self->_construct_entry( type => $entry, class => $class ) ); } } sub _create_entries { my ( $self, $entries ) = @_; my $excl; return { map { my $class = $_; my $entry = $entries->{$class}; $self->_create_entry($class, $entry); } keys %$entries }; } sub _create_typemap { my ( $self, %args ) = @_; foreach my $entries ( @args{grep { exists $args{$_} } qw(entries isa_entries does_entries)} ) { next unless $entries; $entries = $self->_create_entries($entries); } KiokuDB::TypeMap->new(%args); } sub _naive_isa_typemap { my ( $self, $class, @args ) = @_; $self->_create_typemap( isa_entries => { $class => { type => "KiokuDB::TypeMap::Entry::Naive", @args, }, }, ); } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Composite - A role for KiokuDB::TypeMaps created out of many smaller typemaps =head1 VERSION version 0.56 =head1 SYNOPSIS package MyTypeMap; use Moose; extends qw(KiokuDB::TypeMap); with qw(KiokuDB::TypeMap::Composite); # declare typemaps to inherit from using the KiokuDB::TypeMap trait # the 'includes' attribute will be built by collecting these attrs: has foo_typemap => ( traits => [qw(KiokuDB::TypeMap)], # register for inclusion does => "KiokUDB::Role::TypeMap", is => "ro", lazy_build => 1, ); # this role also provides convenience methods for creating typemap objects # easily: sub _build_foo_typemap { my $self = shift; $self->_create_typemap( isa_entries => { $class => { type => 'KiokuDB::TypeMap::Entry::Callback', intrinsic => 1, collapse => "collapse", expand => "new", }, }, ); } sub _build_bar_typemap { my $self = shift; # create a typemap with one naive isa entry $self->_naive_isa_typemap("Class::Foo", @entry_args); } # you also get some construction time customization: MyTypeMap->new( exclude => [qw(Class::Blort foo)], override => { "Class::Blah", => $alternate_entry, }, ); =head1 DESCRIPTION This role provides a declarative, customizable way to set values for L's C attribute. Any class consuming this role can declare attributes with the trait C. The result is a typemap instance that inherits from the specified typemap in a way that is composable for the author and flexible for the user. L is created using this role. =head1 ATTRIBUTES =over 4 =item exclude An array reference containing typemap attribute names (e.g. C in the default typemap) or class name to exclude. Class exclusions are handled by C<_create_typemap> and do not apply to already constructed typemaps. =item override A hash reference of classes to L objects. Class overrides are handled by C<_create_typemap> and do not apply to already constructed typemaps. Classes which don't have a definition will not be merged into the resulting typemap, simply create a typemap of your own and inherit if that's what you want. =back =head1 METHODS =over 4 =item _create_typemap %args Creates a new typemap. The entry arguments are converted before passing to L: $self->_create_typemap( entries => { Foo => { type => "KiokuDB::TypeMap::Entry::Naive", intrinsic => 1, }, }, ); The nested hashref will be used as arguments to L in this example. C and C are taken into account by the hashref conversion code. =item _naive_isa_typemap $class, %entry_args A convenience method to create a one entry typemap with a single inherited entry for C<$class> of the type L. This is useful for when you have a base class that you'd like KiokuDB to persist automatically: sub _build_my_class_typemap { shift->_naive_isa_typemap( "My::Class::Base" ); } =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Entry000755001750000144 012237006576 16516 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMapRef.pm100644001750000144 237512237006576 17737 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMap/Entrypackage KiokuDB::TypeMap::Entry::Ref; BEGIN { $KiokuDB::TypeMap::Entry::Ref::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Entry::Ref::VERSION = '0.56'; } use Moose; no warnings 'recursion'; use namespace::clean -except => 'meta'; with qw( KiokuDB::TypeMap::Entry KiokuDB::TypeMap::Entry::Std::Compile KiokuDB::TypeMap::Entry::Std::ID ); sub compile_collapse { my ( $self, $reftype ) = @_; return "visit_ref_fallback"; } sub compile_expand { my ( $self, $reftype ) = @_; return "expand_object"; } sub compile_refresh { my ( $self, $class, @args ) = @_; return sub { my ( $linker, $object, $entry ) = @_; my $new = $linker->expand_object($entry); require Data::Swap; Data::Swap::swap($new, $object); # FIXME remove! return $object; }; } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Entry::Ref =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut MOP.pm100644001750000144 4473412237006576 17703 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMap/Entrypackage KiokuDB::TypeMap::Entry::MOP; BEGIN { $KiokuDB::TypeMap::Entry::MOP::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Entry::MOP::VERSION = '0.56'; } use Moose; # ABSTRACT: A KiokuDB::TypeMap entry for objects with a metaclass. use Scalar::Util qw(refaddr); use Carp qw(croak); use KiokuDB::Thunk; no warnings 'recursion'; sub does_role { my ($meta, $role) = @_; return unless my $does = $meta->can('does_role'); return $meta->$does($role); } use namespace::clean -except => 'meta'; with ( 'KiokuDB::TypeMap::Entry::Std', 'KiokuDB::TypeMap::Entry::Std::Expand' => { -alias => { compile_expand => 'compile_expand_body' }, } ); has check_class_versions => ( isa => "Bool", is => "ro", default => 1, ); has version_table => ( isa => "HashRef[Str|CodeRef|HashRef]", is => "ro", default => sub { return {} }, ); has class_version_table => ( isa => "HashRef[HashRef[Str|CodeRef|HashRef]]", is => "ro", default => sub { return {} }, ); has write_upgrades => ( isa => "Bool", is => "ro", default => 0, ); # FIXME collapser and expaner should both be methods in Class::MOP::Class, # apart from the visit call sub compile_collapse_body { my ( $self, $class, @args ) = @_; my $meta = Class::MOP::get_metaclass_by_name($class); my @attrs = grep { !does_role($_->meta, 'KiokuDB::Meta::Attribute::DoNotSerialize') and !does_role($_->meta, 'MooseX::Storage::Meta::Attribute::Trait::DoNotSerialize') } $meta->get_all_attributes; my %lazy; foreach my $attr ( @attrs ) { $lazy{$attr->name} = does_role($attr->meta, "KiokuDB::Meta::Attribute::Lazy"); } my $meta_instance = $meta->get_meta_instance; my %attrs; if ( $meta->is_anon_class ) { # FIXME ancestral roles all the way up to first non anon ancestor, # at least check for additional attributes or other metadata which we # should probably error on anything we can't store # theoretically this can do multiple inheritence too my $ancestor = $meta; my @anon; search: { push @anon, $ancestor; my @super = $ancestor->superclasses; if ( @super == 1 ) { $ancestor = Class::MOP::get_metaclass_by_name($super[0]); if ( $ancestor->is_anon_class ) { redo search; } } elsif ( @super > 1 ) { croak "Cannot resolve anonymous class with multiple inheritence: " . $meta->name; } else { croak "no super, ancestor: $ancestor (" . $ancestor->name . ")"; } } my $class_meta = $ancestor->name; foreach my $anon ( reverse @anon ) { $class_meta = { roles => [ map { $_->name } map { $_->isa("Moose::Meta::Role::Composite") ? @{$_->get_roles} : $_ } @{ $anon->roles } ], superclasses => [ $class_meta ], }; } if ( $class_meta->{superclasses}[0] eq $ancestor->name ) { # no need for redundancy, expansion will provide this as the default delete $class_meta->{superclasses}; } %attrs = ( class => $ancestor->name, class_meta => $class_meta, ); } my $immutable = does_role($meta, "KiokuDB::Role::Immutable"); my $content_id = does_role($meta, "KiokuDB::Role::ID::Content"); my @extra_args; if ( defined( my $version = $meta->version ) ) { push @extra_args, class_version => "$version"; # force stringification for version objects } return ( sub { my ( $self, %args ) = @_; my $object = $args{object}; if ( $immutable ) { # FIXME this doesn't handle unset_root if ( $self->live_objects->object_in_storage($object) ) { return $self->make_skip_entry( %args, prev => $self->live_objects->object_to_entry($object) ); } elsif ( $content_id ) { if ( ($self->backend->exists($args{id}))[0] ) { # exists works in list context return $self->make_skip_entry(%args); } } } my %collapsed; attr: foreach my $attr ( @attrs ) { my $name = $attr->name; if ( $attr->has_value($object) ) { if ( $lazy{$name} ) { my $value = $meta_instance->Class::MOP::Instance::get_slot_value($object, $name); # FIXME fix KiokuDB::Meta::Instance to allow fetching thunk if ( ref $value eq 'KiokuDB::Thunk' ) { $collapsed{$name} = $value->collapsed; next attr; } } my $value = $attr->get_raw_value($object); $collapsed{$name} = ref($value) ? $self->visit($value) : $value; } } return $self->make_entry( @extra_args, %args, data => \%collapsed, ); }, %attrs, ); } sub compile_expand { my ( $self, $class, $resolver, @args ) = @_; my $meta = Class::MOP::get_metaclass_by_name($class); my $typemap_entry = $self; my $anon = $meta->is_anon_class; my $inner = $self->compile_expand_body($class, $resolver, @args); my $version = $meta->version; return sub { my ( $linker, $entry, @args ) = @_; if ( $entry->has_class_meta and !$anon ) { # the entry is for an anonymous subclass of this class, we need to # compile that entry and short circuit to it. if $anon is true then # we're already compiled, and the class_meta is already handled my $anon_meta = $self->reconstruct_anon_class($entry); my $anon_class = $anon_meta->name; unless ( $resolver->resolved($anon_class) ) { $resolver->compile_entry($anon_class, $typemap_entry); } my $method = $resolver->expand_method($anon_class); return $linker->$method($entry, @args); } if ( !$self->check_class_versions or $self->is_version_up_to_date($meta, $version, $entry->class_version) ) { $linker->$inner($entry, @args); } else { my $upgraded = $self->upgrade_entry( linker => $linker, meta => $meta, entry => $entry, expand_args => \@args); if ( $self->write_upgrades ) { croak "Upgraded entry can't be updated (mismatch in 'prev' chain)" unless refaddr($entry) == refaddr($upgraded->root_prev); $linker->backend->insert($upgraded); } $linker->$inner($upgraded, @args); } } } { my %cache; sub is_version_up_to_date { my ( $self, $meta, $version, $entry_version ) = @_; # no clever stuff, only if they are the same string they are the same version no warnings 'uninitialized'; # undef $VERSION is allowed return 1 if $version eq $entry_version; my $key = join(":", $meta->name, $entry_version); # $VERSION isn't supposed to change at runtime return $cache{$key} if exists $cache{$key}; # check the version table for equivalent versions (recursively) # ref handlers are upgrade hooks foreach my $handler ( $self->find_version_handlers($meta, $entry_version) ) { return $cache{$key} = $self->is_version_up_to_date( $meta, $version, $handler ) if not ref $handler; } return $cache{$key} = undef; } sub clear_version_cache { %cache = () } } sub find_version_handlers { my ( $self, $meta, $version ) = @_; no warnings 'uninitialized'; # undef $VERSION is allowed if ( does_role($meta, "KiokuDB::Role::Upgrade::Handlers") ) { return $meta->name->kiokudb_upgrade_handler($version); } else { return grep { defined } map { $_->{$version} } $self->class_version_table->{$meta->name}, $self->version_table; } } sub upgrade_entry { my ( $self, %args ) = @_; my ( $meta, $entry ) = @args{qw(meta entry)}; if ( does_role($meta, "KiokuDB::Role::Upgrade::Data") ) { return $meta->name->kiokudb_upgrade_data(%args); } else { return $self->upgrade_entry_from_version( %args, from_version => $entry->class_version ); } } sub upgrade_entry_from_version { my ( $self, %args ) = @_; my ( $meta, $from_version, $entry ) = @args{qw(meta from_version entry)}; no warnings 'uninitialized'; # undef $VERSION is allowed foreach my $handler ( $self->find_version_handlers($meta, $from_version) ) { if ( ref $handler ) { my $cb = $self->_process_upgrade_handler($handler); # apply handler my $converted = $self->$cb(%args); if ( $self->is_version_up_to_date( $meta, $meta->version, $converted->class_version ) ) { return $converted; } elsif ( $entry->class_version eq $converted->class_version ) { croak "Upgrade from " . $entry->class_version . " did change 'class_version' field"; } else { # more error context return try { $self->upgrade_entry_from_version(%args, entry => $converted, from_version => $converted->class_version); } catch { croak "$_\n... when upgrading from $from_version"; }; } } else { # nonref is equivalent version, recursively search for handlers for that version return $self->upgrade_entry_from_version( %args, from_version => $handler ); } } croak "No handler found for " . $meta->name . " version $from_version" . ( $entry->class_version ne $from_version ? "(entry version is " . $entry->class_version . ")" : "" ); } sub _process_upgrade_handler { my ( $self, $handler ) = @_; if ( ref $handler eq 'HASH' ) { croak "Data provided in upgrade handler must be a hash" if ref $handler->{data} and ref $handler->{data} ne 'HASH'; croak "No class_version provided in upgrade handler" unless defined $handler->{class_version}; return sub { my ( $self, %args ) = @_; my $entry = $args{entry}; croak "Entry data not a hash reference" unless ref $entry->data eq 'HASH'; $entry->derive( %$handler, data => { %{ $entry->data }, %{ $handler->{data} || {} }, }, ); }; } return $handler; } sub compile_create { my ( $self, $class ) = @_; my $meta = Class::MOP::get_metaclass_by_name($class); my $meta_instance = $meta->get_meta_instance; my $cache = does_role($meta, "KiokuDB::Role::Cacheable"); my @register_args = ( ( $cache ? ( cache => 1 ) : () ), ); return sub { return ( $meta_instance->create_instance(), @register_args ); }; } sub compile_clear { my ( $self, $class ) = @_; return sub { my ( $linker, $obj ) = @_; %$obj = (); # FIXME } } sub compile_expand_data { my ( $self, $class, @args ) = @_; my $meta = Class::MOP::get_metaclass_by_name($class); my $meta_instance = $meta->get_meta_instance; my ( %attrs, %lazy ); my @attrs = grep { !does_role($_->meta, 'KiokuDB::Meta::Attribute::DoNotSerialize') and !does_role($_->meta, 'MooseX::Storage::Meta::Attribute::Trait::DoNotSerialize') } $meta->get_all_attributes; foreach my $attr ( @attrs ) { $attrs{$attr->name} = $attr; $lazy{$attr->name} = does_role($attr->meta, "KiokuDB::Meta::Attribute::Lazy"); } return sub { my ( $linker, $instance, $entry, @args ) = @_; my $data = $entry->data; my @values; foreach my $name ( keys %$data ) { my $attr = $attrs{$name} or croak "Unknown attribute: $name"; my $value = $data->{$name}; if ( ref $value ) { if ( $lazy{$name} ) { my $thunk = KiokuDB::Thunk->new( collapsed => $value, linker => $linker, attr => $attr ); $attr->set_raw_value($instance, $thunk); } else { my @pair = ( $attr, undef ); $linker->inflate_data($value, \$pair[1]) if ref $value; push @values, \@pair; } } else { $attr->set_raw_value($instance, $value); } } $linker->queue_finalizer(sub { foreach my $pair ( @values ) { my ( $attr, $value ) = @$pair; $attr->set_raw_value($instance, $value); $attr->_weaken_value($instance) if $attr->is_weak_ref; } }); return $instance; } } sub reconstruct_anon_class { my ( $self, $entry ) = @_; $self->inflate_class_meta( superclasses => [ $entry->class ], %{ $entry->class_meta }, ); } sub inflate_class_meta { my ( $self, %meta ) = @_; foreach my $super ( @{ $meta{superclasses} } ) { $super = $self->inflate_class_meta(%$super)->name if ref $super; } # FIXME should probably get_meta_by_name($entry->class) Moose::Meta::Class->create_anon_class( cache => 1, %meta, ); } sub compile_id { my ( $self, $class ) = @_; if ( does_role(Class::MOP::get_metaclass_by_name($class), "KiokuDB::Role::ID") ) { return sub { my ( $self, $object ) = @_; return $object->kiokudb_object_id; } } else { return "generate_uuid"; } } sub should_compile_intrinsic { my ( $self, $class, @args ) = @_; my $meta = Class::MOP::get_metaclass_by_name($class); if ( $self->has_intrinsic ) { return $self->intrinsic; } elsif ( does_role($meta, "KiokuDB::Role::Intrinsic") ) { return 1; } else { return 0; } } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Entry::MOP - A KiokuDB::TypeMap entry for objects with a metaclass. =head1 VERSION version 0.56 =head1 SYNOPSIS KiokuDB::TypeMap->new( entries => { 'My::Class' => KiokuDB::TypeMap::Entry::MOP->new( intrinsic => 1, ), }, ); =head1 DESCRIPTION This typemap entry handles collapsing and expanding of L based objects. It supports anonymous classes with runtime roles, the L role. Code for immutable classes is cached and performs several orders of magnitude better, so make use of L. =head1 ATTRIBUTES =over 4 =item intrinsic If true the object will be collapsed as part of its parent, without an ID. =item check_class_versions If true (the default) then class versions will be checked on load and if there is a mismatch between the stored version number and the current version number, the version upgrade handler tables will be used to convert the out of date entry. =item version_table =item class_version_table Tables of handlers. See also L and L for convenience roles that do not require a central table. The first is a global version table (useful when the typemap entry is only handling one class) and the second is a table of tables keyed by the class name. The tables are keyed by version number (as a string, C and C<""> are considered the same), and the value can be either a code reference that processes the entry to bring it up to date, a hash reference of overridden fields, or a string denoting a version number that this version is equivalent to. Version numbers have no actual ordinal meaning, they are taken as simple string identifiers. If we had 3 versions, C<1.0>, C<1.1> and C<2.0>, where C<1.1> is a minor update to the class that requires no structural changes from C<1.0>, our table could be written like this: { '1.0' => '1.1', # upgrading the data from 1.0 to 1.1 is a noop '1.1' => sub { my ( $self, %args ) = @_; # manually convert the entry data return $entry->clone( class_version => '2.0', prev => $entry, data => ..., ), }, } When an object that was stored as version C<1.0> is retrieved from the database, and the current definition of the class has C<$VERSION> C<2.0>, table declares C<1.0> is the same as C<1.1>, so we search for the handler for C<1.1> and apply it. The resulting class has the version C<2.0> which is the same as what we have now, so this object can be thawed. The callback is invoked with the following arguments: =over 4 =item entry The entry to upgrade. =item from_version The key under which the handler was found (not necessarily the same as C<< $entry->class_version >>). =item meta The L of the entry's class. =item linker The L instance that is inflating this object. Can be used to retrieve additional required objects (cycles are not a problem but be aware that the objects might not be usable yet at the time of the callback's invocation). =back When a hash is provided as a handler it'll be used to create an entry like this: $entry->derive( %$handler, data => { %{ $entry->data }, %{ $handler->{data} || {} }, }, ); The field C is required, and C must contain a hash: KiokuDB->connect( class_version_table => { Foo => { "0.02" => { class_version => "0.03", # upgrade 0.02 to 0.03 data => { a_new_field => "default_value", }, }, }, }, ); =item write_upgrades If true, after applying version upgrade handlers, the updated entry will be written back to the database. Defaults to false but might default to true in future versions (unless the database is in readonly mode). =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Std.pm100644001750000144 265712237006576 17760 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMap/Entrypackage KiokuDB::TypeMap::Entry::Std; BEGIN { $KiokuDB::TypeMap::Entry::Std::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Entry::Std::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Role for more easily specifying collapse/expand methods use KiokuDB::TypeMap::Entry::Compiled; use namespace::clean -except => 'meta'; with qw( KiokuDB::TypeMap::Entry KiokuDB::TypeMap::Entry::Std::ID KiokuDB::TypeMap::Entry::Std::Compile KiokuDB::TypeMap::Entry::Std::Intrinsic ); __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Entry::Std - Role for more easily specifying collapse/expand methods =head1 VERSION version 0.56 =head1 SYNOPSIS TODO =head1 DESCRIPTION This role just integrates other roles into a single place for convenience. The roles that it integrates are: =over 4 =item KiokuDB::TypeMap::Entry =item KiokuDB::TypeMap::Entry::Std::ID =item KiokuDB::TypeMap::Entry::Std::Compile =item KiokuDB::TypeMap::Entry::Std::Intrinsic =back =head1 SEE ALSO L L L L =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Set.pm100644001750000144 776312237006576 17764 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMap/Entrypackage KiokuDB::TypeMap::Entry::Set; BEGIN { $KiokuDB::TypeMap::Entry::Set::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Entry::Set::VERSION = '0.56'; } use Moose; # ABSTRACT: A typemap entry for KiokuDB::Sets no warnings 'recursion'; use KiokuDB::Set::Stored; use KiokuDB::Set::Deferred; use KiokuDB::Set::Loaded; use namespace::clean -except => 'meta'; with qw( KiokuDB::TypeMap::Entry::Std KiokuDB::TypeMap::Entry::Std::Expand ); has defer => ( isa => "Bool", is => "ro", default => 1, ); sub compile_collapse_wrapper { my ( $self, $method, $class, @args ) = @_; my ( $body, @extra ) = $self->compile_collapse_body(@args); return sub { shift->$method( $body, @extra, @_, class => "KiokuDB::Set::Stored" ); } } sub compile_collapse_body { my ( $self, $class ) = @_; if ( $class->isa("KiokuDB::Set::Deferred") ) { # if it's deferred we just return the IDs return sub { my ( $collapser, %args ) = @_; return $collapser->make_entry( %args, data => [ $args{object}->_objects->members ], ); }; } else { # otherwise we collapse the objects recursively return sub { my ( $collapser, %args ) = @_; my @inner = $collapser->visit($args{object}->_objects->members); # we flatten references to just IDs foreach my $item ( @inner ) { $item = $item->id if ref($item) eq 'KiokuDB::Reference'; $collapser->_buffer->first_class->insert($item); # mark it first class so it doesn't get compacted } return $collapser->make_entry( %args, data => \@inner, ); }; } } sub compile_create { my ( $self, $class ) = @_; if ( $self->defer ) { return sub { my ( $linker, $entry ) = @_; my $members = $entry->data; if ( grep { ref } @$members ) { return KiokuDB::Set::Loaded->new( set => Set::Object::Weak->new(), _linker => $linker ); } else { return KiokuDB::Set::Deferred->new( set => Set::Object->new( @$members ), _linker => $linker ); } }; } else { return sub { my ( $linker, $entry ) = @_; return KiokuDB::Set::Loaded->new( set => Set::Object::Weak->new, _linker => $linker ); }; } } sub compile_clear { my ( $self, $class ) = @_; sub { my ( $linker, $obj ) = @_; $obj->_set_ids( Set::Object->new() ); } } sub compile_expand_data { my ( $self, $class ) = @_; my $defer = $self->defer; return sub { my ( $linker, $instance, $entry ) = @_; my $members = $entry->data; my $inner_set = $instance->_objects; if ( ref $instance eq 'KiokuDB::Set::Deferred' ) { $inner_set->insert( @$members ); } else { foreach my $item ( @$members ) { if ( ref $item ) { $linker->inflate_data( $item, \( my $obj ) ); $inner_set->insert( $obj ); } else { # FIXME add partially loaded set support $inner_set->insert( $linker->get_or_load_object($item) ); } } } } } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Entry::Set - A typemap entry for KiokuDB::Sets =head1 VERSION version 0.56 =head1 DESCRIPTION This is an internal typemap entry that handles L objects of various flavours. You shouldn't need to use it directly, as the default typemap will contain an entry for it. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut LiveObjects000755001750000144 012237006576 16247 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBGuard.pm100644001750000144 174412237006576 20015 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/LiveObjectspackage KiokuDB::LiveObjects::Guard; BEGIN { $KiokuDB::LiveObjects::Guard::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::LiveObjects::Guard::VERSION = '0.56'; } use strict; use warnings; use Scalar::Util qw(weaken); use namespace::clean -except => 'meta'; sub new { my ( $class, $hash, $key ) = @_; my $self = bless [ $hash, $key ], $class; weaken $self->[0]; return $self; } sub key { $_[0][1]; } sub DESTROY { my $self = shift; my ( $hash, $key ) = splice @$self; delete $hash->{$key} if $hash; } sub dismiss { my $self = shift; @$self = (); } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::LiveObjects::Guard =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Scope.pm100644001750000144 502212237006576 20015 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/LiveObjectspackage KiokuDB::LiveObjects::Scope; BEGIN { $KiokuDB::LiveObjects::Scope::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::LiveObjects::Scope::VERSION = '0.56'; } use Moose; # ABSTRACT: Scope helper object use namespace::clean -except => 'meta'; has objects => ( traits => [qw(Array)], isa => "ArrayRef", default => sub { [] }, clearer => "_clear_objects", handles => { push => "push", objects => "elements", clear => "clear", }, ); has parent => ( isa => __PACKAGE__, is => "ro", ); has live_objects => ( isa => "KiokuDB::LiveObjects", is => "ro", clearer => "_clear_live_objects", ); sub DEMOLISH { my $self = shift; # consider possibilities of optimizing live object set removal at this # point # problems can arise from an object outliving the scope it was loaded in: # { my $outer = lookup(...); { my $inner = lookup(...); $outer->foo($inner) } } $self->remove; } sub detach { my $self = shift; if ( my $l = $self->live_objects ) { $l->detach_scope($self); } } sub remove { my $self = shift; if ( my $l = $self->live_objects ) { # can be false under global destruction $l->remove_scope($self); $self->_clear_live_objects; } } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::LiveObjects::Scope - Scope helper object =head1 VERSION version 0.56 =head1 SYNOPSIS { my $scope = $dir->new_scope; ... do work on $dir ... } =head1 DESCRIPTION Live object scopes exist in order to ensure objects don't die too soon if the only other references to them are weak. When scopes are destroyed the refcounts of the objects they refer to go down, and the parent scope is replaced in the live object set. =head1 METHODS =over 4 =item push Adds objects or entries, increasing their reference count. =item clear Clears the objects from the scope object. =item detach Marks this scope as no longer the "current" live object scope, if it is the current one. This allows keeping branching of scopes, which can be useful under long running applications. =item remove Effectively kills the scope by clearing it and removing it from the live object set. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Sets.pm100644001750000144 1447312237006576 20050 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Test/Fixturepackage KiokuDB::Test::Fixture::Sets; BEGIN { $KiokuDB::Test::Fixture::Sets::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Fixture::Sets::VERSION = '0.56'; } use Moose; use Test::More; use Scalar::Util qw(weaken); use KiokuDB::Set::Transient; use KiokuDB::Set::Deferred; use KiokuDB::Test::Person; use namespace::clean -except => "meta"; with qw(KiokuDB::Test::Fixture); sub create { map { KiokuDB::Test::Person->new( name => $_ ) } qw(jemima elvis norton); } sub verify { my $self = shift; my @ids = @{ $self->populate_ids }; { my $s = $self->new_scope; my @people = $self->lookup_ok(@ids); my $set = KiokuDB::Set::Transient->new( set => Set::Object->new ); is_deeply([ $set->members ], [], "no members"); $set->insert($people[0]); is_deeply( [ $set->members ], [ $people[0] ], "set members", ); ok( $set->loaded, "set is loaded" ); $set->insert( $people[0] ); is( $set->size, 1, "inserting ID of live object already in set did not affect set size" ); ok( $set->loaded, "set still loaded" ); $set->insert( $people[2] ); is( $set->size, 2, "inserting ID of live object" ); ok( $set->loaded, "set still loaded" ); is_deeply( [ sort $set->members ], [ sort @people[0, 2] ], "members", ); $set->remove( $people[2] ); is( $set->size, 1, "removed element" ); can_ok( $set, "union" ); foreach my $other ( Set::Object->new( $people[2] ), KiokuDB::Set::Transient->new( set => Set::Object->new( $people[2] ) ) ) { my $union = $set->union($other); isa_ok( $union, "KiokuDB::Set::Transient", "union" ); is_deeply( [ sort $union->members ], [ sort @people[0, 2] ], "members", ); } } { my $s = $self->new_scope; my $set = KiokuDB::Set::Deferred->new( set => Set::Object->new($ids[0]), _linker => $self->directory->linker ); ok( !$set->loaded, "set not loaded" ); is_deeply( [ $set->members ], [ $self->lookup_ok($ids[0]) ], "set vivified", ); ok( $set->loaded, "now marked as loaded" ); my @people = $self->lookup_ok(@ids); foreach my $other ( Set::Object->new( $people[2] ), KiokuDB::Set::Transient->new( set => Set::Object->new( $people[2] ) ) ) { my $union = $set->union($other); isa_ok( $union, "KiokuDB::Set::Loaded", "union" ); is_deeply( [ sort $union->members ], [ sort @people[0, 2] ], "members", ); } } { my $s = $self->new_scope; my $set = KiokuDB::Set::Deferred->new( _linker => $self->directory->linker ); is( $set->size, 0, "set size is 0" ); is_deeply([ $set->members ], [], "no members" ); is( ref($set), "KiokuDB::Set::Deferred", 'calling members on empty set does not load it' ); $set->insert($self->lookup_ok(@ids)); ok( !$set->loaded, "set not loaded by insertion of live objects" ); $set->remove( $self->lookup_ok($ids[0]) ); is( $set->size, ( @ids - 1 ), "removed element" ); ok( !$set->loaded, "set not loaded" ); my $other = KiokuDB::Set::Deferred->new( set => Set::Object->new($ids[0]), _linker => $self->directory->linker ); isa_ok( my $union = $set->union($other), "KiokuDB::Set::Deferred" ); ok( !$union->loaded, "union is deferred" ); is_deeply( [ sort $set->members ], [ sort $self->lookup_ok(@ids[1, 2]) ], "members", ); ok( $set->loaded, "now it is loaded" ); is_deeply( [ sort $union->members ], [ sort $self->lookup_ok(@ids[0, 1, 2]) ], "union", ); } $self->no_live_objects; { my $s = $self->new_scope; my $set = KiokuDB::Set::Deferred->new( _linker => $self->directory->linker ); is_deeply([ $set->members ], [], "no members"); $set->_objects->insert(@ids); ok( !$set->loaded, "set not loaded" ); $set->clear; is( $set->size, 0, "cleared" ); ok( $set->loaded, "cleared set is loaded" ); } $self->no_live_objects; my $set_id = do { my $s = $self->new_scope; my @people = $self->lookup_ok(@ids); $self->store_ok( KiokuDB::Set::Transient->new( set => Set::Object->new($people[0]) ) ); }; $self->no_live_objects; { my $s = $self->new_scope; my $set = $self->lookup_ok($set_id); isa_ok( $set, "KiokuDB::Set::Deferred", "deferred set" ); is( $set->size, 1, "set size" ); is_deeply( [ $set->members ], [ $self->lookup_ok($ids[0]) ], "members", ); ok( $set->loaded, "loaded set" ); } $self->no_live_objects; { my $s = $self->new_scope; my $set = $self->lookup_ok($set_id); isa_ok( $set, "KiokuDB::Set::Deferred", "deferred set" ); is( $set->size, 1, "set size" ); $set->insert( $self->lookup_ok($ids[2]) ); is( $set->size, 2, "set size is 2"); ok( !$set->loaded, "set not loaded" ); $self->store_ok($set); ok( !$set->loaded, "set not loaded by ->store" ); } $self->no_live_objects; { my $s = $self->new_scope; my $set = $self->lookup_ok($set_id); isa_ok( $set, "KiokuDB::Set::Deferred", "deferred set" ); is( $set->size, 2, "set size" ); is_deeply( [ sort $set->members ], [ sort $self->lookup_ok(@ids[0, 2]) ], "members", ); ok( $set->loaded, "loaded set" ); } $self->no_live_objects; } __PACKAGE__->meta->make_immutable; # ex: set sw=4 et: __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Fixture::Sets =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Scan.pm100644001750000144 566012237006576 17774 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Test/Fixturepackage KiokuDB::Test::Fixture::Scan; BEGIN { $KiokuDB::Test::Fixture::Scan::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Fixture::Scan::VERSION = '0.56'; } use Moose; use Test::More; use Test::Moose; use KiokuDB::Test::Person; use namespace::clean -except => 'meta'; with qw(KiokuDB::Test::Fixture) => { -excludes => 'required_backend_roles' }; use constant required_backend_roles => qw(Clear Scan); sub create { my $self = shift; ( map { KiokuDB::Test::Person->new(%$_) } { name => "foo", age => 3 }, { name => "bar", age => 3 }, { name => "gorch", age => 5, friends => [ KiokuDB::Test::Person->new( name => "quxx", age => 6 ) ] }, ); } before populate => sub { my $self = shift; $self->backend->clear; }; sub verify { my $self = shift; $self->txn_lives(sub { my $root = $self->root_set; does_ok( $root, "Data::Stream::Bulk" ); my @objs = $root->all; my @ids = $self->objects_to_ids(@objs); is_deeply( [ sort map { $_->name } @objs ], [ sort qw(foo bar gorch) ], "root set", ); is_deeply( [ sort $self->backend->root_entry_ids->all ], [ sort @ids ], "root set IDs", ); }); $self->txn_lives(sub { my $child_entries = $self->backend->child_entries; does_ok( $child_entries, "Data::Stream::Bulk" ); my $children = $child_entries->filter(sub {[ $self->directory->linker->register_and_expand_entries(@$_) ]}); my @objs = $children->all; my @ids = $self->objects_to_ids(@objs); is_deeply( [ sort map { $_->name } @objs ], [ sort qw(quxx) ], "nonroot entries", ); is_deeply( [ sort $self->backend->child_entry_ids->all ], [ sort @ids ], "nonroot IDs", ); }); $self->txn_lives(sub { my $all_entries = $self->backend->all_entries; does_ok( $all_entries, "Data::Stream::Bulk" ); my $all = $all_entries->filter(sub {[ $self->directory->linker->register_and_expand_entries(@$_) ]}); my @objs = $all->all; my @ids = $self->objects_to_ids(@objs); is_deeply( [ sort map { $_->name } @objs ], [ sort qw(foo bar gorch quxx) ], "all entries", ); is_deeply( [ sort $self->backend->all_entry_ids->all ], [ sort @ids ], "all IDs", ); }); } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Fixture::Scan =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Upgrade000755001750000144 012237006576 16326 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/RoleData.pm100644001750000144 262012237006576 17675 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Role/Upgradepackage KiokuDB::Role::Upgrade::Data; BEGIN { $KiokuDB::Role::Upgrade::Data::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Role::Upgrade::Data::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Classes that provide their own upgrade routine. use namespace::clean; requires "kiokudb_upgrade_data"; # ex: set sw=4 et: __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Role::Upgrade::Data - Classes that provide their own upgrade routine. =head1 VERSION version 0.56 =head1 SYNOPSIS with qw(KiokuDB::Role::Upgrade::Data); sub kiokudb_upgrade_data { my ( $class, %args ) = @_; # convert the data from the old version of the class to the new version # as necessary $args{entry}->derive( class_version => our $VERSION, ... ); } =head1 DESCRIPTION This class allows you to take control the data conversion process completely (there is only one handler per class, not one handler per version with this approach). See L for a more DWIM approach, and L for more details. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Serialize.pm100644001750000144 427412237006576 20021 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backendpackage KiokuDB::Backend::Serialize; BEGIN { $KiokuDB::Backend::Serialize::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Serialize::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Serialization role for backends use Moose::Util::TypeConstraints; use namespace::clean -except => 'meta'; requires qw(serialize deserialize); my %types = ( storable => "KiokuDB::Serializer::Storable", json => "KiokuDB::Serializer::JSON", yaml => "KiokuDB::Serializer::YAML", memory => "KiokuDB::Serializer::Memory", ); coerce( __PACKAGE__, from Str => via { my $class = $types{lc($_)}; Class::MOP::load_class($class); $class->new; }, from HashRef => via { my %args = %$_; my $class = $types{lc(delete $args{format})}; Class::MOP::load_class($class); $class->new(%args); }, ); __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Serialize - Serialization role for backends =head1 VERSION version 0.56 =head1 SYNOPSIS package KiokuDB::Backend::Serialize::Foo; use Moose::Role; use Foo; use namespace::clean -except => 'meta'; with qw(KiokuDB::Backend::Serialize); sub serialize { my ( $self, $entry ) = @_; Foo::serialize($entry) } sub deserialize { my ( $self, $blob ) = @_; Foo::deserialize($blob); } =head1 DESCRIPTION This role provides provides a consistent way to use serialization modules to handle backend serialization. See L, L and L for examples. =head1 REQUIRED METHODS =over 4 =item serializate $entry Takes a L as an argument. Should return a value suitable for storage by the backend. =item deserialize $blob Takes whatever C returned and should inflate and return a L. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Scan.pm100644001750000144 421512237006576 17652 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Rolepackage KiokuDB::Backend::Role::Scan; BEGIN { $KiokuDB::Backend::Role::Scan::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Role::Scan::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Root set iteration sub entries_to_ids { my $stream = shift; $stream->filter(sub {[ map { $_->id } @$_ ]}); } use namespace::clean -except => 'meta'; requires "all_entries"; sub root_entries { my $self = shift; return $self->all_entries->filter(sub {[ grep { $_->root } @$_ ]}); } sub child_entries { my $self = shift; return $self->all_entries->filter(sub {[ grep { not $_->root } @$_ ]}); } sub all_entry_ids { my $self = shift; entries_to_ids($self->all_entries); } sub root_entry_ids { my $self = shift; entries_to_ids($self->root_entries); } sub child_entry_ids { my $self = shift; entries_to_ids($self->child_entries); } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Role::Scan - Root set iteration =head1 VERSION version 0.56 =head1 SYNOPSIS with qw(KiokuDB::Backend::Role::Scan); sub all_entries { my $self = shift; # return all root set entries return Data::Stream::Bulk::Foo->new(...); } =head1 DESCRIPTION This is a role for iterative scanning of all entries in a backend. It is used for database backups, and various other tasks. =head1 REQUIRED METHODS =over 4 =item all_entries Should return a L stream enumerating all entries in the database. =back =head1 OPTIONAL METHODS These method have default implementations defined in terms of C but maybe overridden if there is a more optimal solution than just filtering that stream. =over 4 =item root_entries Should return a L of just the root entries. =item child_entries Should return a L of everything but the root entries. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut KiokuDB000755001750000144 012237006576 15034 5ustar00doyusers000000000000KiokuDB-0.56/lib/POD2/JATutorial.pod100644001750000144 14442712237006576 17557 0ustar00doyusers000000000000KiokuDB-0.56/lib/POD2/JA/KiokuDB=encoding utf-8 =pod =head1 NAME POD2::JA::KiokuDB::Tutorial - Lを始めよう =begin original KiokuDB::Tutorial - Getting started with L =end original =head1 Install (インストール) =begin original The easiest way to install L along with a number of backends is L. =end original Lとバックエンドと一緒にインストールするには、Lをインストールするのが一番簡単です。 =begin original L depends on L and a few other modules out of the box, but no specific storage module. =end original LはLと、いくつかのすぐに使えるモジュールに依存していますが、 特定のストレージモジュールには依存していません。 =begin original L is a frontend to several backends, much like L uses DBDs to connect to actual databases. =end original Lは複数のバックエンドのフロントエンドです。 Lが実際のデータベースへの接続にDBDを使っているのに似ています。 =begin original For development and testing you can use the L backend, which is an in memory store, but for production use L or L are the recommended backends. =end original 開発用やテストとして、メモリに保存するLバックエンドを使うことができます。 プロダクションには、LかLかL をバックエンドとして推奨します。 =begin original See below for instructions on getting L installed. =end original Lをインストールして、以下のインストラクションを見てください。 =head1 CREATING A DIRECTORY HANDLE (ディレクトリハンドルの作成) =begin original A KiokuDB directory is the main object through which all work is done. =end original KiokuDBディレクトリは、すべての仕事がされるメインのオブジェクトです。 =begin original The simplest directory that is ready for use can be created like this: =end original すぐに使えるもっとも単純なディレクトリは次のように作れます: my $dir = KiokuDB->new( backend => KiokuDB::Backend::Hash->new ); =begin original We will revisit other more interesting backend configuration later in this document, but for now this will do. =end original このドキュメントの最後に、他のもっと面白いバックエンドの設定を紹介しますが、 とりあえず、やってみます。 =begin original You can also use DSN strings to connect to the various backends: =end original いろいろなバックエンドに接続するためのDSN文字列を使うこともできます。 KiokuDB->connect("hash"); KiokuDB->connect("dbi:SQLite:dbname=foo", create => 1); KiokuDB->connect("bdb:dir=foo", create => 1); =begin original You can also use a configuration file: =end original 設定ファイルを使うこともできます。 KiokuDB->connect("/path/to/my_db.yml"); =begin original Which is just a YAML file: =end original 設定YAMLファイルです: --- # these are basically the arguments for 'new' backend: class: KiokuDB::Backend::DBI dsn: dbi:SQLite:dbname=/tmp/test.db create: 1 =head1 USING THE DBI BACKEND (DBIバックエンドを使う) =begin original During this tutorial we will be using the DBI backend for two reasons. The first is L's ubiquity. The second is the possibility of easily looking behind the scenes, to more clearly demonstrate what L is doing. =end original 2つの理由で、このチュートリアルではDBIバックエンドを使います。 1つ目の理由は、Lがどこにでもあるからです。 2つ目の理由は、簡単に裏舞台を見ることが出来るからです。 Lが何をしているかをよりわかりやすくデモンストレーションできるからです。 =begin original That said, the examples will work with all backends exactly the same. =end original この例ですべてのバックエンドがまったく同じように動きます。 =begin original The C<$dir> variable used below is created like this: =end original 以下で使うC<$dir>変数は下記のように作られます: my $dir = KiokuDB->connect( "dbi:SQLite:dbname=kiokudb_tutorial.db", create => 1, # this causes the tables to be created ); =begin original Note that if you are connecting with a username and password you need to specify these as named arguments: =end original ユーザー名とパスワードで接続する場合、名前付きの引数を指定しないといけません: my $dir = KiokuDB->connect( $dsn, user => $user, password => $password, ); =head1 INSERTING OBJECTS (オブジェクトのインサート) =begin original Let's start by defining a simple class using L: =end original Lを使った簡単なクラスを定義してみましょう: package Person; use Moose; has name => ( isa => "Str", is => "rw", ); =begin original We can instantiate it: =end original それをインスタント化します: my $obj = Person->new( name => "Homer Simpson" ); =begin original and insert the object to the database as follows: =end original 下記のようにオブジェクトをデータベースに入れます: my $scope = $dir->new_scope; my $homer_id = $dir->store($obj); =begin original This is very trivial use of L, but it illustrates a few important things. =end original これは、Lのとても普通の使い方です。ですが、いくつか重要なことを示しています。 =begin original First, no schema is necessary. L uses L to introspect your object without needing to predefine anything like tables. =end original 1番目に、スキーマは必要ありません。Lはテーブルのような何かを事前に定義する必要はありません。 オブジェクトの情報を取り出すために、Lを使うことができます。 =begin original Second, every object in the database has an ID. If you don't choose an ID for an object, L will assign a UUID instead. =end original 2番目に、データベースに入っているすべてのオブジェクトにはIDがあります。 オブジェクトにIDを選ばなけれあば、Lが代わりにUUIDを割り当てます。 =begin original This ID is like a primary key in a relational database. You can also specify an ID instead of letting one be generated: =end original IDはリレーショナルデータベースのプライマリーキーのようなものです。 自分でオブジェクトにIDを振りたければ、次のようにすることができます: $dir->store( homer => $obj ); =begin original Third, all L operations need to be performed within a B. The scope is not really doing anything important in this simple example, but becomes necessary when cycles and weak references are in use. We will look into that in more detail later. =end original 3番目に、すべてのL操作はB内で行う必要があります。 スコープは上のような簡単な例では大して重要ではありませんが、 循環参照やweakリファレンスが使われるようになると、必要になります。 後でより詳細に見ていきます。 =head1 LOADING OBJECTS (オブジェクトの読み出し) =begin original So now that Homer has been inserted into the database, we can fetch him out of there using the ID we got from C. =end original さて、データベースにHomerが入りました。Cから得たIDで取り出せます。 my $homer = $dir->lookup($homer_id); =begin original Assuming that C<$scope> and C<$obj> are still in scope, C<$homer> and C<$obj> will actually be the same object: =end original C<$scope>とC<$obj>は、スコープ内にあるとします。C<$homer>とC<$obj>は実際に、同じオブジェクトになります。 # this is true: refaddr($homer) == refaddr($obj) =begin original This is because L tracks which objects are "live" in the B (L). =end original B<生存しているオブジェクトセット> (L)内のオブジェクトが "生存"しているかをLが追跡しているからです。 =begin original If the object wasn't already in memory then L would have fetched it from the backend instead. =end original オブジェクト既にメモリにあるなら、Lはインスタンスを バックエンドから取得します。 =head1 WHAT WAS STORED (何が保存されたか) =begin original Let's peek into the database: =end original データベースを覗いてみましょう: % sqlite3 kiokudb_tutorial.db SQLite version 3.4.0 Enter ".help" for instructions sqlite> =begin original The database schema has two tables, C and C: =end original データベースのスキーマには2つのテーブルがあります。CとCです: sqlite> .tables entries gin_index =begin original C is used for more complex queries, and we'll get back to it at the end of the tutorial. =end original Cはより複雑なクエリに使われます。チュートリアルの最後に扱います。 =begin original For now let's just have a closer look at C: =end original さて、Cに近付いてよく見ましょう: sqlite> .schema entries CREATE TABLE entries ( id varchar NOT NULL, data blob NOT NULL, class varchar, root boolean NOT NULL, tied char(1), PRIMARY KEY (id) ); =begin original The main columns are C and C. In L every object has an ID which serves as a primary key and a BLOB of data associated with it. =end original メインのカラムはCとCです。Lにある、すべてのオブジェクトにはIDがあり、 プライマリキーとBLOBデータが関連付けられています。 =begin original Since the default serializer for the DBI backend is L, we examine the data. =end original DBIバックエンドのデフォルトのシリアライザーはLですので、 データを調査できます。 =begin original First let's set C's output mode to C. This is easier to read with large columns: =end original 最初に、Cの出力モードをCにセットしましょう。大きいカラムでも 見やすくなります: sqlite> .mode line =begin original And select the data from the table: =end original テーブルからデータを取得します: sqlite> select id, data from entries; id = 201C5B55-E759-492F-8F20-A529C7C02C8B data = {"__CLASS__":"Person","data":{"name":"Homer Simpson"},"id":"201C5B55-E759-492F-8F20-A529C7C02C8B","root":true} =begin original As you can see the C attribute is stored under the C key inside the blob, as is the object's class. =end original 上記のように、C属性はblob内のCキーにオブジェクトのクラスとして保存されています。 =begin original The C column contains all of the data necessary to recreate the object. =end original Cカラムはオブジェクトを再作成するのに必要なすべてのデータを含んでいます。 =begin original All the other columns are only for searches. Later on you'll also see how to create user defined columns. =end original 他のすべてのカラムは検索のためだけに使われます。後で、どのようにユーザー定義のカラムを 作るのかを見せます。 =begin original When using L the on-disk format is just a hash of C to C with no additional columns. =end original Lを使った場合は、ディスク上のフォーマットは、CからCのハッシュになり、 他の追加のカラムはありません。 =head1 OBJECT RELATIONSHIPS (オブジェクトのリレーションシップ) =begin original Let's extend the C class to hold some more interesting data than just a C: =end original CクラスにCよりも、もっと面白いデータを追加してみましょう: package Person; has spouse => ( isa => "Person", is => "rw", weak_ref => 1, ); =begin original This new C attribute will hold a reference to another person object. =end original C属性は他のPersonオブジェクトのリファレンスを持ちます。 =begin original Let's first create and insert another object: =end original まずは、他のオブジェクトを作りましょう: my $marge_id = $dir->store( Person->new( name => "Marge Simpson" ), ); =begin original Now that we have both objects in the database, let's link them together: =end original データベースに両方のオブジェクトを持たせます。2つを一緒にリンクしましょう: { my $scope = $dir->new_scope; my ( $marge, $homer ) = $dir->lookup( $marge_id, $homer_id ); $marge->spouse($homer); $homer->spouse($marge); $dir->store( $marge, $homer ); } =begin original Now we have created a persistent B, that is several objects which point to each other. =end original 今、永続的なB<オブジェクトグラフ>を作りました。これは、複数のオブジェクトが お互いに参照しています。 =begin original The reason C had the C option was so that this circular structure will not leak. =end original CにはCオプションがありましたので、この循環構造はリークしません。 =begin original When then objects are updated in the database, L sees that their C attribute contains references, and this relationship will be encoded using their unique ID in storage. =end original データベースでオブジェクトが更新されたら、LはC属性を含むリファレンスを見て、 この関係はストレージ内でユニークなIDを使ってエンコードされます。 =begin original To load the graph, we can do something like this: =end original このグラフをロードするために、次のようにできます: { my $scope = $dir->new_scope; my $homer = $dir->lookup($homer_id); print $homer->spouse->name; # Marge Simpson } { my $scope = $dir->new_scope; my $marge = $dir->lookup($marge_id); print $marge->spouse->name; # Homer Simpson refaddr($marge) == refaddr($marge->spouse->spouse); # true } =begin original When L is loading the initial object, all the objects the object depends on will also be loaded. The C attribute contains a reference to another object (by ID), and this link is resolved at inflation time. =end original Lが最初のオブジェクトをロードしたら、そのオブジェクトが依存している すべてのオブジェクトがロードされます。C属性は他のオブジェクトを(IDで) 持っているので、インフレーション時にそのリンクを解決します。 =head2 The purpose of C (Cの目的) =begin original This is where C becomes important. As objects are inflated from the database, they are pushed onto the live object scope, in order to increase their reference count. =end original Cが重要になるところです。オブジェクトはデータベースからインフレートされ、 リファレンスカウントを増やすために、生存しているオブジェクトスコープに追加されます。 =begin original If this was not done, by the time C<$homer> was returned from C his C attribute would have been cleared because there is no other reference to Marge. =end original これがされていなければ、CからC<$homer>が戻ってくる時までに、 C属性がクリアされます。マージする他のリファレンスがないからです。 =begin original This demonstrates why: =end original 次のコードが理由をデモンストレートします: sub get_homer { my $homer = Person->new( name => "Homer Simpson" ); my $marge = Person->new( name => "Marge Simpson" ); $homer->spouse($marge); $marge->spouse($homer); return $homer; # at this point $homer and $marge go out of scope # $homer has a refcount of 1 because it's the return value # $marge has a refcount of 0, and gets destroyed # the weak reference in $homer->spouse is cleared } my $homer = get_homer(); $homer->spouse; # this returns undef =begin original By using this idiom: =end original 次のイディオムを使って: { my $scope = $dir->new_scope; # do all KiokuDB work in here } =begin original You are ensuring that the objects live at least as long as is necessary. =end original 少なくとも必要である時間はオブジェクトが生きていることを確保できます。 =begin original In a web application context you usually create one new scope per request. In fact, L does this automatically. =end original Webアプリケーションのコンテキストでは、普通リクエストごとに新しいスコープを作ります。 実際、Lは、自動的にそうしています。 =head1 REFERENCES IN THE DATABASE (データベース内のリファレンス) =begin original Now that we have an object graph in the database let's have another look at what's inside. =end original さて、データベースにオブジェクトグラフがあります。内部がどうなっているか見てみましょう。 sqlite> select id, data from entries; id = 201C5B55-E759-492F-8F20-A529C7C02C8B data = {"__CLASS__":"Person","data":{"name":"Homer Simpson","spouse":{"$ref":"05A8D61C-6139-4F51-A748-101010CC8B02.data"}},"id":"201C5B55-E759-492F-8F20-A529C7C02C8B","root":true} id = 05A8D61C-6139-4F51-A748-101010CC8B02 data = {"__CLASS__":"Person","data":{"name":"Marge Simpson","spouse":{"$ref":"201C5B55-E759-492F-8F20-A529C7C02C8B.data"}},"id":"05A8D61C-6139-4F51-A748-101010CC8B02","root":true} =begin original You'll notice the C field has a JSON object with a C<$ref> field inside it holding the UUID of the target object. =end original CフィールドがJSONオブジェクトということに気づくでしょう。 そして、その内部のC<$ref>フィールドには、対象のオブジェクトのUUIDがあります。 =begin original When data is loaded L queues up references to unloaded objects and then loads them in order to materialize the memory resident object graph. =end original データがロードされると、Lはロードさえていないオブジェクトへのリファレンスを キューに入れて、オブジェクトグラフをメモリに常駐させるために、それらをロードします。 =begin original If you're curious about why the data is represented this way, this format is called C, or JavaScript Persistent Object Notation (L). When using L the L and L objects are serialized with their storable hooks instead. =end original データがこのような方法で表現されている理由について知りたければ、 このフォーマットは、Cか JavaScript Persistent Object notation(L)と呼ばれています。 Lを使うと、LとLオブジェクトは、 代わりに、storableフックでシリアライズされます。 =head1 OBJECT SETS (オブジェクトセット) =begin original More complex relationships (not necessarily 1 to 1) are usually easy to model with L. =end original より複雑なリレーションシップ(1対1に限らない)は、Lでふつう簡単にモデル化できます。 =begin original Let's extend the C class to add such a relationship: =end original Cクラスを拡張してそのようなリレーションシップを足してみましょう: package Person; has children => ( does => "KiokuDB::Set", is => "rw", ); =begin original L objects are L specific wrappers for L. =end original Lオブジェクトは、LのL用のラッパーです。 my @kids = map { Person->new( name => $_ ) } qw(maggie lisa bart); use KiokuDB::Util qw(set); my $set = set(@kids); $homer->children($set); $dir->store($homer); =begin original The C convenience function creates a new L object. A transient set is one which started its life in memory space (as opposed to a set that was loaded from the database). =end original Cという便利な関数は新しいLオブジェクトを作ります。 一時的なセットはメモリスペースに存在するものです (データベースからロードされたセットとは反対に)。 =begin original The C convenience function also exists, creating a transient set with L used internally to help avoid circular structures (for instance if setting a C attribute in our example). =end original Cという便利な関数もあります。 循環構造(例えば、今の例にC属性を追加する)を避けるために内部で使われている、 Lで一時的なセットを作ります。 =begin original The set object behaves pretty much like a normal L: =end original このオブジェクトは普通のLとほとんど同じように振る舞います。 my @kids = $dir->lookup($homer_id)->children->members; =begin original The main difference is that sets coming from the database are deferred by default, that is the objects in C<@kids> are not loaded until they are actually needed. =end original 主な違いは、セットがデータベースから来るのがデフォルトで遅延されていることです。 C<@kids>にあるオブジェクトは、実際に必要になるときまでロードされません。 =begin original This allows large object graphs to exist in the database, while only being partially loaded, without breaking the encapsulation of user objects. This behavior is implemented in L and L. =end original このことにより、ユーザーのオブジェクトのカプセル化を壊すこと無しに、 部分的にロードされるので、データベースに巨大なオブジェクトグラフがあっても問題になりません。 この振る舞いはLとLで実装されています。 =begin original This set object is optimized to make most operations defer loading. For instance, if you intersect two deferred sets, only the members of the intersection set will need to be loaded. =end original このセットオブジェクトは、遅延ロードの操作に最適化されています。 例えば、2つの遅延セットを横断するなら、横断するセットのみがロードされる必要があります。 =head1 THE TYPEMAP =begin original Storing an object with L involves passing it to L, the object that "flattens" objects into L before the entries are inserted into the backend. =end original Lにオブジェクトが保存される際に、Lを通過します。 エントリーがバックエンドにインサートされる前に、Lに、 "平たく"されたオブジェクトを入れます。 =begin original The collapser uses a L object that tells it how objects of each type should be collapsed. =end original collapserには、Lオブジェクトを使います。このオブジェクトは、 それぞれのタイプのオブジェクトがどのように破壊するかを教えます。 =begin original During retrieval of objects the same typemap is used to reinflate objects back into working objects. =end original オブジェクトを取ってくる間、オブジェクトを再インフレートして、 ワーキングオブジェクトにするのに、同じtypemapが使われます。 =begin original Trying to store an object that is not in the typemap is an error. The reason behind this is that it doesn't make sense to store every type of object (for instance C handles need a socket, objects based on XS modules have an internal pointer as an integer, whose address won't be valid the next time it's loaded), and even though the majority of objects are safe to serialize, even a small bit of unreported fragility is usually enough to create large, hard to debug problems. =end original typemapにないオブジェクトを保存しようとするとエラーになります。その理由は すべてのタイプのオブジェクトを保存できるか分からないからです。(例えば、 Cはソケット、オブジェクト。XSベースのモジュールは数値のような内部的な ポインタを持ちます。そのアドレスは次回のロード時には正しくなくなっています)。 大半のオブジェクトは安全にシリアライズできるにもかかわらず、 わずかな報告されないもろさが、大きなデバッグの難しい問題を作るのはありがちなことです。 =begin original An exception to this rule is L based objects, because they have sufficient meta information available through L's powerful reflection support in order to be safely serialized. =end original このルールの例外は、Lベースのオブジェクトです。Lの強大な リフレクションサポートを通して、十分なメタ情報が利用できるので、 安全にシリアライズ出来ます。 =begin original Additionally, the standard backends provide a default typemap for common objects (L, L, etc), which by default is merged with any custom typemap you pass to L. =end original 加えて、標準のバックエンドは共通のオブジェクト(L, Lなど>)用に デフォルトのtypemapを提供しています。Lにどんなカスタムのtypemapが渡されても、 デフォルトとマージされます。 =begin original So, in order to actually get L to store things like L based objects, you can do something like this: =end original それで、実際にLにLベースのオブジェクトのようなものを保存させるには、 次のようにします: KiokuDB->new( backend => $backend, allow_classes => [qw(My::Object)], ); =begin original Which is shorthand for: =end original これは次の省略形です: my $dir = KiokuDB->new( backend => $backend, typemap => KiokuDB::TypeMap->new( entries => { "My::Object" => KiokuDB::TypeMap::Entry::Naive->new, }, ), ); =begin original L is a type map entry that performs naive collapsing of the object, by simply walking it recursively. =end original Lは単純に再帰的にたどることで、 オブジェクトのナイーブな破壊を行います。 =begin original When the collapser encounters an object it will ask L for a collapsing routine based on the class of the object. =end original collapser は、オブジェクトを見つけると、Lに、 オブジェクトのクラスに応じた、破壊ルーチンを尋ねます。 =begin original This lookup is typically performed by C, not using inheritance, because a typemap entry that is safe to use with a superclass isn't necessarily safe to use with a subclass. If you B want inherited entries, specify C: =end original この検索は、典型的には、Cで行われ、継承を使いません。 スーパークラスで安全に使われているtypemapエントリーは、 必ずしもサブクラスで安全に使えるとは限らないからです。 継承されたエントリーにB<したい>なら、Cを指定してください。 KiokuDB::TypeMap->new( isa_entries => { "My::Object" => KiokuDB::TypeMap::Entry::Naive->new, }, ); =begin original If no normal (C keyed) entry is found for an object, the isa entries are searched for a superclass of that object. Subclass entries are tried before superclass entries. The result of this lookup is cached, so it only happens once per class. =end original オブジェクトに通常の(C keyed)エントリーが見つからなければ、 isaエントリーがオブジェクトスーパークラスのために探されます。 サブクラスエントリーはスーパークラスエントリーより前に試されます。 この検索の結果はキャッシュされるので、クラスごとに一回しか起こりません。 =head2 Typemap Entries =begin original If you want to do custom serialization hooks, you can specify hooks to collapse your object: =end original カスタムのシリアライズのフックが欲しければ、自分のオブジェクトを破壊するための フックを指定できます。 KiokuDB::TypeMap::Entry::Callback->new( collapse => sub { my $object = shift; ... return @some_args; }, expand => sub { my ( $class, @some_args ) = @_; ... return $object; }, ); =begin original These hooks are called as methods on the object to be collapsed. =end original これらのフックはオブジェクトを破壊するときに、メソッドとして呼ばれます。 =begin original For instance the L related typemap ISA entry is: =end original 例えば、typemapのISAに関連するLは: 'Path::Class::Entity' => KiokuDB::TypeMap::Entry::Callback->new( intrinsic => 1, collapse => "stringify", expand => "new", ); =begin original The C flag is discussed in the next section. =end original Cフラグは次のセクションで述べます。 =begin original Another option for typemap entries is L, which is appropriate when you know the backend's serialization can handle that data type natively. =end original typemapエントリのもう一つの選択はLです。 バックエンドのシリアライズがネイティブにデータタイプを扱うことができると分かっていれば、 これは適切です。 =begin original For example, if your object has a L hook which you know is appropriate (e.g. contains no sub objects that need to be collapsible) and your backend uses L. L is an example of a class with such storable hopes: =end original 例えば、オブジェクトに適切なLフックがあり(破壊する必要のあるサブオブジェクトを含まない)、 バックエンドには、Lを使う場合です。 Lはそのようにstorableが望むクラスの例です: 'DateTime' => KiokuDB::Backend::Entry::Passthrough->new( intrinsic => 1 ) =head2 Intrinsic vs. First Class =begin original In L every object is normally assigned an ID, and if the object is shared by several objects this relationship will be preserved. =end original Lでは、すべてのオブジェクトに、通常、IDが割り当てられます。 オブジェクトが複数のオブジェクトに共有されている場合、このリレーションは維持されます。 =begin original However, for some objects this is not the desired behavior. These are objects that represent values, like L, L entries, L objects, etc. =end original しかし、いくつかのオブジェクトは望ましい振る舞いをしません。 それらは、Lや、Lエントリ、Lオブジェクトのようなもので、 値を表現します。 =begin original L can be asked to collapse such objects B, that is instead of creating a new L with its own ID for the object, the object gets collapsed directly into its parent's structures. =end original LはBに、そのようなオブジェクトを、 そのオブジェクトにそれ自身のIDと新しいLを作る代わりに、 破壊するよう要求できます。オブジェクトが直接破壊できれば、親の構造の中に入ります。 =begin original This means that shared references that are collapsed intrinsically will be loaded back from the database as two distinct copies, so updates to one will not affect the other. =end original 破壊され、共有されたリファレンスは、もともと2つの区別されたコピーとして データーベースからロードされます。ですので、一つをアップデートしても、 もう一方には影響がありません。 =begin original For instance, when we run the following code: =end original 例えば、下記のようなコードを動かしたとして: use Path::Class; my $path = file(qw(path to foo)); $obj_1->file($path); $obj_2->file($path); $dir->store( $obj_1, $obj_2 ); =begin original While the following is true when the data is being inserted, it will no longer be true when C<$obj_1> and C<$obj_2> are loaded from the database: =end original データがインサートされるときには、下記は真ですが、 C<$obj_1>とC<$obj_2>がデーターベースからロードされると、もはや真ではありません: refaddr($obj_1->file) == refaddr($obj_2->file) =begin original This is because both C<$obj_1> and C<$obj_2> each got its own copy of C<$path>. =end original C<$obj_1>とC<$obj_2>の両方がC<$path>のコピーだからです。 =begin original This behavior is usually more appropriate for objects that aren't mutated, but are instead cloned and replaced, and for which creating a first class entry in the backend with its own ID is undesired. =end original この現象は、通常、変異されず、複製されたり置き換えられたりするオブジェクトに適しています。 そのようなオブジェクトのためには、最初のクラスエントリが独自のIDでバックエンドに作られるのは、 望まれていないからです。 =head2 The Default Typemap =begin original Each backend comes with a default typemap, with some built in entries for common CPAN modules' objects. L contains more details. =end original それぞれのバックエンドには、デフォルトのtypemapがついています。 それには、共通のCPANモジュールオブジェクトのために、いくつか共通のビルトインのエントリもあります。 Lにより詳細があります。 =head1 SIMPLE SEARCHES (単純な検索) =begin original Most backends support an inefficient but convenient simple search, which scans the entries and matches fields. =end original ほとんどのバックエンドが効率的ではないものの、便利な単純な検索があります。 これは、エントリをスキャンして、フィールドにマッチさせます。 =begin original If you want to make use of this API we suggest using L since simple searching is implemented using an SQL where clause, which is much more efficient (you do have to set up the column manually though). =end original このAPIを使いたいなら、Lを使うことをおすすめします。 単純亜検索はSQLのwhere節を使って実装でき、より効率的だからです。 (ただし、手でカラムをセットアップしないといけませんが) =begin original Calling the C method with a hash reference as the only argument invokes the simple search functionality, returning a L with the results: =end original Cメソッドに引数としてハッシュリファレンスのみを渡して呼びます。 単純な検索機能が呼び出され、Lが結果と一緒に戻ってきます: my $stream = $dir->search({ name => "Homer Simpson" }); while ( my $block = $stream->next ) { foreach my $object ( @$block ) { # $object->name eq "Homer Simpson" } } =begin original This exact API is intentionally still underdefined. In the future it will be compatible with L 0.09's syntax. =end original 正確なAPIはまだ決められていません。将来的に、L 0.09のシンタックスと 互換にするつもりです。 =head2 DBI SEARCH COLUMNS =begin original In order to make use of the simple search API we need to configure columns for our DBI backend. =end original この簡単な検索APIを使うには、DBIバックエンドにカラムを設定しなければいけません。 =begin original Let's create a 'name' column to search by: =end original 検索するために、'name'カラムを作りましょう: my $dir = KiokuDB->connect( "dbi:SQLite:dbname=foo", columns => [ # specify extra columns for the 'entries' table # in the same format you pass to DBIC's add_columns name => { data_type => "varchar", is_nullable => 1, # probably important }, ], ); =begin original You can either alter the schema manually, or use C to back up your data, delete the database, connect with C<< create => 1 >> and then use C. =end original スキーマを手で変更することもできますし、また、データをバックアップするのに、Cを使い、 データベースを削除し、C<< create => 1 >>で接続し、Cを使うことも出来ます。 =begin original To populate this column we'll need to load Homer and update him: =end original このカラムを埋め込むために、Homerをロードして、更新する必要があります: { my $s = $dir->new_scope; $dir->update( $dir->lookup( $homer_id ) ); } =begin original And this is what it looks in the database: =end original データベースでは次のようになります: id = 201C5B55-E759-492F-8F20-A529C7C02C8B name = Homer Simpson =head1 GETTING STARTED WITH BDB (BDBを始めよう) =begin original The most mature backend for L is L. It performs very well, and supports many features, like L integration to provide customized indexing of your objects and transactions. =end original Lでもっとも成熟したバックエンドは、Lです(訳注:DBIのほうが安定しているとYAPC::Asia 2009で聞きました)。 十分に動きますし、多くの機能をサポートします。 オブジェクトのインデックスのカスタマイズやトランザクションを提供する Lのようなインテグレーションもあります。 =begin original L is newer and not as tested, but also supports transactions and L based queries. It performs quite well too, but isn't as fast as L. =end original Lはより新しいですが、そこまでテストされていません。 ですが、トランザクションもサポートしますし、クエリベースのLもあります。 これも、なかなかよく動きます。ですが、Lと同じくらい速くはありません (訳注:YAPC::Asia 2009では、ほぼ変わらないと聞きました) =head2 Installing L =begin original L needs the L module, and a recent version of Berkeley DB itself, which can be found here: L. =end original Lは、Lモジュールが必要です。 また、最近のバージョンのBerkeley DB自身も必要です。Berkeley DBは、以下のURLにあります。 L. =begin original BerkeleyDB (the library) normally installs into C, while L (the module) looks for it in C, so adding a symbolic link should make installation easy. =end original BerkeleyDB(ライブラリ)は通常、Cにインストールされます。 ですが、L(モジュール)は、Cを見ようとします。 ですので、シンボリックリンクを作っておけば、インストールが簡単になります。 =begin original Once you have L installed, L should install without problem and you can use it with L. =end original Lがインストールできれば、Lは問題なくインストールできるはずです。 Lと一緒に使うことができます。 =head2 Using L =begin original To use the BDB backend we must first create the storage. To do this the C flag must be passed: =end original BDBバックエンドを使うために、ストレージを作らなければいけません。 このために、Cフラグを渡さなければいけません。 my $backend = KiokuDB::Backend::BDB->new( manager => { home => Path::Class::Dir->new(qw(path to storage)), create => 1, }, ); =begin original The BDB backend uses L to do a lot of the L gruntwork. The L object will be instantiated using the arguments provided in the C attribute. =end original BDBバックエンドは、Lを使って、たくさんのLの下働きを行います。 LオブジェクトはC属性で提供される引数を使って、インスタンス化されます。 =begin original Now that the storage is created we can make use of this backend, much like before: =end original これで、ストレージがつくられました。このバックエンドを、以前と同様に使います。 my $dir = KiokuDB->new( backend => $backend ); =begin original Subsequent opens will not require the C argument to be true, but it doesn't hurt. =end original その後のオープンには、C属性が真である必要はありませんが、真であっても特に害はありません。 =begin original This C call is equivalent to the above: =end original このCは上記のものと同じです: my $dir = KiokuDB->connect( "bdb:dir=path/to/storage", create => 1 ); =head1 TRANSACTIONS (トランザクション) =begin original Some backends (ones which do the L role) can be used with transactions. =end original いくつかのバックエンド(Lロールをするもの)は、トランザクションが使えるものがあります。 =begin original If you are familiar with L this should be very familiar: =end original Lに慣れているなら、すぐわかるでしょう: $dir->txn_do(sub { $dir->store($obj); }); =begin original This will create a L level transaction, and all changes to the database are committed if the block was executed cleanly. =end original Lレベルのトランザクションを作ります。データベースへのすべての変更は ブロックが綺麗に実行されたら、コミットされます。 =begin original If any error occurred the transaction will be rolled back, and the changes will not be visible to subsequent reads. =end original 何らかのエラーが起きれば、トランザクションはロールバックされます。 変更は次の読み込みでは、見えません。 =begin original Note that L does B touch live instances, so if you do something like =end original L生きているインスタンスには触れません。ですので、次のようにすると $dir->txn_do(sub { my $scope = $dir->new_scope; $obj->name("Dancing Hippy"); $dir->store($obj); die "an error"; }); =begin original the C attribute is B rolled back, it is simply the C operation that gets reverted. =end original C属性はロールバックB<されません>。Cオペレーションだけが、元に戻ります。 =begin original Transactions will nest properly, and with most backends they generally increase write performance as well. =end original トランザクションは適切にネストできます。また、ほとんどのバックエンドで、一般的に 書き込みのパフォーマンスが良くなります。 =head1 QUERIES (クエリ) =begin original L is a subclass of L that provides L integration. =end original LはLのサブクラスで、 Lインテグレーションを提供しています。 =begin original L is a framework to index and query objects, inspired by Postgres' internal GIN api. GIN stands for Generalized Inverted Indexes. =end original Lはインデックスとクエリーオブジェクトのフレームワークです。 Postgresの内部GIN apiにインスパイアされました。 GINは、Generalized Inverted Indexes(訳注:汎用転置索引)の略です。 =begin original Using L arbitrary search keys can be indexed for your objects, and these objects can then be looked up using queries. =end original Lを使うと、任意の検索キーをオブジェクトにタイしてインデックスできます。 そして、それらのオブジェクトをクエリで検索できます。 =begin original For instance, one of the pre canned searches L supports out of the box is class indexing. Let's use L to do custom indexing of our objects: =end original 例えば、Lがサポートする、すぐに使える、予めある検索の一つに、クラスインデックスがあります。 L を使って、オブジェクトにカスタムのインデックスを作りましょう: my $dir = KiokuDB->new( backend => KiokuDB::Backend::BDB::GIN->new( extract => Search::GIN::Extract::Callback->new( extract => sub { my ( $obj, $extractor, @args ) = @_; if ( $obj->isa("Person") ) { return { type => "user", name => $obj->name, }; } return; }, ), ), ); $dir->store( @random_objects ); =begin original To look up the objects, we use the a manual key lookup query: =end original オブジェクトを検索するために、マニュアルキー検索クエリを使います: my $query = Search::GIN::Query::Manual->new( values => { type => "person", }, ); my $stream = $dir->search($query); =begin original The result is L object that represents the search results. It can be iterated as follows: =end original 結果として、検索結果を表すLオブジェクトが返ります。 次のようにイテレートできます。 while ( my $block = $stream->next ) { foreach my $person ( @$block ) { print "found a person: ", $person->name; } } =begin original Or even more simply, if you don't mind loading the whole resultset into memory: =end original また、より単純に、メモリに全結果をロードしてもかまわないなら: my @people = $stream->all; =begin original L is very much in its infancy, and is very under documented. However it does work for simple searches such as this and contains pre canned solutions like L. =end original Lはまだ未成熟です。ドキュメントも書いているところです。 ですが、このような単純な検索は動きますし、Lのような 予めある解決を含んでいます。 =begin original In short, it works today, but watch this space for new developments. =end original つまり、現在は動きますが、新しく開発をするときには、これに注意してください。 =head1 翻訳について 翻訳者：加藤敦 (ktat@cpan.org) Perlドキュメント日本語訳 Project にて、 Perlモジュール、ドキュメントの翻訳を行っております。 http://perldocjp.sourceforge.jp/ http://sourceforge.jp/projects/perldocjp/ http://www.freeml.com/ctrl/html/MLInfoForm/perldocjp@freeml.com http://www.perldoc.jp/ Small.pm100644001750000144 614412237006576 20156 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Test/Fixturepackage KiokuDB::Test::Fixture::Small; BEGIN { $KiokuDB::Test::Fixture::Small::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Fixture::Small::VERSION = '0.56'; } use Moose; use Test::More; use Test::Exception; use Scalar::Util qw(refaddr); use KiokuDB::Test::Person; use KiokuDB::Test::Employee; use KiokuDB::Test::Company; sub p; use namespace::clean -except => 'meta'; sub p { my @args = @_; unshift @args, "name" if @args % 2; KiokuDB::Test::Person->new(@args); } with qw(KiokuDB::Test::Fixture) => { -excludes => [qw/populate sort/] }; sub sort { -100 } has [qw(joe oscar)] => ( isa => "Str", is => "rw", ); sub create { return ( KiokuDB::Test::Employee->new( name => "joe", age => 52, parents => [ KiokuDB::Test::Person->new( name => "mum", age => 78, ) ], company => KiokuDB::Test::Company->new( name => "OHSOME SOFTWARE KTHX" ), ), KiokuDB::Test::Person->new( name => "oscar", age => 3, ), ); } sub populate { my $self = shift; { my $s = $self->new_scope; my ( $joe, $oscar ) = $self->create; isa_ok( $joe, "KiokuDB::Test::Person" ); isa_ok( $joe, "KiokuDB::Test::Employee" ); isa_ok( $oscar, "KiokuDB::Test::Person" ); my ( $joe_id, $oscar_id ) = $self->store_ok($joe, $oscar); $self->joe($joe_id); $self->oscar($oscar_id); $self->live_objects_are($joe, $joe->company, @{ $joe->parents }, $oscar); } $self->no_live_objects; } sub verify { my $self = shift; $self->txn_lives(sub { my ( $joe, $oscar ) = my @objs = $self->lookup_ok( $self->joe, $self->oscar ); isa_ok( $joe, "KiokuDB::Test::Person" ); isa_ok( $joe, "KiokuDB::Test::Employee" ); isa_ok( $oscar, "KiokuDB::Test::Person" ); my $entry = $self->directory->live_objects->object_to_entry($joe); ok( $entry->has_object, "entry is associated with object" ); is( refaddr($entry->object), refaddr($joe), "the right object" ); is( $joe->name, "joe", "name" ); ok( my $parents = $joe->parents, "parents" ); is( ref($parents), "ARRAY", "array ref" ); is( scalar(@$parents), 1, "one parent" ); isa_ok( $parents->[0], "KiokuDB::Test::Person" ); is( $parents->[0]->name, "mum", "parent name" ); ok( my $company = $joe->company, "company" ); isa_ok( $company, "KiokuDB::Test::Company" ); is( $oscar->name, "oscar", "name" ); lives_ok { $self->directory->lookup("no_such_id") } "lookup of nonexistent ID is nonfatal"; }); } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Fixture::Small =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Clear.pm100644001750000144 241112237006576 20125 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Test/Fixturepackage KiokuDB::Test::Fixture::Clear; BEGIN { $KiokuDB::Test::Fixture::Clear::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Fixture::Clear::VERSION = '0.56'; } use Moose; use Test::More; use Test::Moose; use KiokuDB::Test::Person; use namespace::clean -except => 'meta'; use constant required_backend_roles => qw(Clear); with qw(KiokuDB::Test::Fixture) => { -excludes => [qw/sort required_backend_roles/] }; sub sort { -10 } sub create { my $self = shift; return ( KiokuDB::Test::Person->new( name => "foo" ), KiokuDB::Test::Person->new( name => "bar" ), ); } sub verify { my $self = shift; $self->txn_lives(sub { $self->lookup_ok(@{ $self->populate_ids } ) }); $self->txn_lives(sub { $self->backend->clear }); $self->txn_lives(sub { $self->deleted_ok(@{ $self->populate_ids }) }); } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Fixture::Clear =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut UUIDs000755001750000144 012237006576 15670 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/RoleLibUUID.pm100644001750000144 132312237006576 17562 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Role/UUIDspackage KiokuDB::Role::UUIDs::LibUUID; BEGIN { $KiokuDB::Role::UUIDs::LibUUID::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Role::UUIDs::LibUUID::VERSION = '0.56'; } use Moose::Role; use Data::UUID::LibUUID 0.05; use namespace::clean -except => 'meta'; sub generate_uuid { Data::UUID::LibUUID::new_uuid_string() } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Role::UUIDs::LibUUID =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Query.pm100644001750000144 262412237006576 20075 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Rolepackage KiokuDB::Backend::Role::Query; BEGIN { $KiokuDB::Backend::Role::Query::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Role::Query::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Backend specific query API use namespace::clean -except => 'meta'; requires "search"; sub search_filter { my ( $self, $stream, @args ) = @_; return $stream; } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Role::Query - Backend specific query API =head1 VERSION version 0.56 =head1 SYNOPSIS with qw(KiokuDB::Backend::Role::Query); sub search { my ( $self, @args ) = @_; # return all entries in the root set matching @args (backend specific) return Data::Stream::Bulk::Foo->new(...); } =head1 DESCRIPTION This role is for backend specific searching. Anything that is not L is a backend specific search, be it a L, or something else. The backend is expected to interpret the search arguments which are passed through from L as is, and return a L of matching entries. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Clear.pm100644001750000144 232312237006576 20012 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Rolepackage KiokuDB::Backend::Role::Clear; BEGIN { $KiokuDB::Backend::Role::Clear::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Role::Clear::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Backend clearing api use namespace::clean -except => 'meta'; requires "clear"; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Role::Clear - Backend clearing api =head1 VERSION version 0.56 =head1 SYNOPSIS package KiokuDB::Backend::MySpecialBackend; use Moose; use namespace::clean -except => 'meta'; with qw( KiokuDB::Backend KiokuDB::Backend::Role::Clear ); sub clear { ... } =head1 DESCRIPTION This backend role provides an api for removing all entries from a backend. This is optionally used by the dump loader script, and parts of the test suite. =head1 REQUIRED METHODS =over 4 =item clear This method should clear all entries in the backend. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Storable.pm100644001750000144 134312237006576 20421 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Serializerpackage KiokuDB::Serializer::Storable; BEGIN { $KiokuDB::Serializer::Storable::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Serializer::Storable::VERSION = '0.56'; } use Moose; use namespace::clean -except => 'meta'; with qw( KiokuDB::Serializer KiokuDB::Backend::Serialize::Storable ); __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Serializer::Storable =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Naive.pm100644001750000144 443012237006576 20257 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMap/Entrypackage KiokuDB::TypeMap::Entry::Naive; BEGIN { $KiokuDB::TypeMap::Entry::Naive::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Entry::Naive::VERSION = '0.56'; } use Moose; # ABSTRACT: A typemap entry for "simple" objects no warnings 'recursion'; use namespace::clean -except => 'meta'; with qw(KiokuDB::TypeMap::Entry::Std); sub compile_collapse_body { my ( $self, $class ) = @_; return sub { my ( $self, %args ) = @_; my $object = $args{object}; return $self->make_entry( %args, data => $self->visit_ref_data($object), ); }; } sub compile_expand { my ( $self, $class ) = @_; return sub { my ( $self, $entry ) = @_; $self->inflate_data( $entry->data, \( my $obj ), $entry ); bless $obj, $class; }; } sub compile_refresh { return sub { die "TODO" } } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Entry::Naive - A typemap entry for "simple" objects =head1 VERSION version 0.56 =head1 SYNOPSIS KiokuDB::TypeMap->new( entires => { 'My::Class' => KiokuDB::TypeMap::Entry::Naive->new, }, ); =head1 DESCRIPTION This typemap entry is suitable for plain objects that can be stored by simply walking them recursively. Most objects fall into this category, but there are notable exceptions: =over 4 =item XS based objects, using a pointer as a number When being deserialized the pointer value will no longer be valid, causing segfaults. =item Inside out objects Since the referent is really a flyweight object with no data, the object will be missing its attributes and a suitable typemap entry is required instead. This applies to any object interacting with a global state of some sort. =item Objects with magic Perl SV level magic is not retained, apart from tied values. =back =head1 ATTRIBUTES =over 4 =item intrinsic If true the object will be collapsed without an ID as part of its parent. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Alias.pm100644001750000144 227312237006576 20251 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMap/Entrypackage KiokuDB::TypeMap::Entry::Alias; BEGIN { $KiokuDB::TypeMap::Entry::Alias::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Entry::Alias::VERSION = '0.56'; } use Moose; # ABSTRACT: An alias in the typemap to another entry use namespace::clean -except => 'meta'; has to => ( isa => "Str", is => "ro", required => 1, ); __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Entry::Alias - An alias in the typemap to another entry =head1 VERSION version 0.56 =head1 SYNOPSIS my $typemap = KiokuDB::TypeMap->new( entries => { 'Some::Class' => KiokuDB::TypeMap::Entry::Alias->new( to => "Some::Other::Class", ), 'Some::Other::Class' => ..., }, ); =head1 DESCRIPTION This pseudo-entry directs the typemap resolution to re-resolve with the key in the C field. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Binary.pm100644001750000144 364712237006576 20337 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Test/Fixtureuse utf8; package KiokuDB::Test::Fixture::Binary; BEGIN { $KiokuDB::Test::Fixture::Binary::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Fixture::Binary::VERSION = '0.56'; } use Moose; use Encode; use Test::More; use KiokuDB::Test::Person; use KiokuDB::Test::Employee; use KiokuDB::Test::Company; use namespace::clean -except => 'meta'; use constant required_backend_roles => qw(BinarySafe); with qw(KiokuDB::Test::Fixture) => { -excludes => 'required_backend_roles' }; my $utf8 = "חיים"; utf8::encode($utf8); my $bytes = pack("C*", 39, 233, 120, 20, 40, 150, 0, 0, 0, 0, 0, 210, 211, 222, 1 ); sub create { return ( KiokuDB::Test::Person->new( binary => $utf8, ), KiokuDB::Test::Person->new( binary => $bytes, ), ); } sub verify { my $self = shift; $self->txn_lives(sub { my ( $enc, $bin ) = $self->lookup_ok( @{ $self->populate_ids } ); isa_ok( $enc, "KiokuDB::Test::Person" ); isa_ok( $bin, "KiokuDB::Test::Person" ); ok( !Encode::is_utf8($enc->binary), "preserved utf8 bytes" ); my $enc_decoded = Encode::decode( utf8 => $enc->binary ); ok( Encode::is_utf8($enc_decoded), "decoded cleanly" ); is( $enc_decoded, "חיים", "decoded to correct value" ); ok( !Encode::is_utf8($bin->binary), "preserved arbitrary bytes" ); is( length($bin->binary), length($bytes), "bytes not truncated" ); is( unpack("H*", $bin->binary), unpack("H*", $bytes), "bytes equal" ); }); } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Fixture::Binary =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut LinkChecker000755001750000144 012237006576 16220 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBResults.pm100644001750000144 176612237006576 20371 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/LinkCheckerpackage KiokuDB::LinkChecker::Results; BEGIN { $KiokuDB::LinkChecker::Results::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::LinkChecker::Results::VERSION = '0.56'; } use Moose; use Set::Object; use namespace::clean -except => 'meta'; # Set::Object of 1 million IDs is roughly 100mb of memory == 100 bytes per ID # no need to scale anything more, if you have that many objects you should # probably write your own tool has [qw(seen root referenced unreferenced missing broken)] => ( isa => "Set::Object", is => "ro", default => sub { Set::Object->new }, ); __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::LinkChecker::Results =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DataUUID.pm100644001750000144 133712237006576 17732 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Role/UUIDspackage KiokuDB::Role::UUIDs::DataUUID; BEGIN { $KiokuDB::Role::UUIDs::DataUUID::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Role::UUIDs::DataUUID::VERSION = '0.56'; } use Moose::Role; use Data::UUID 1.203; use namespace::clean -except => 'meta'; my $uuid_gen = Data::UUID->new; sub generate_uuid { $uuid_gen->create_str } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Role::UUIDs::DataUUID =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Attribute000755001750000144 012237006576 16667 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/MetaLazy.pm100644001750000144 403412237006576 20305 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Meta/Attributepackage KiokuDB::Meta::Attribute::Lazy; BEGIN { $KiokuDB::Meta::Attribute::Lazy::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Meta::Attribute::Lazy::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Trait for lazy loaded attributes use Moose::Util qw(does_role); use namespace::clean -except => 'meta'; sub Moose::Meta::Attribute::Custom::Trait::KiokuDB::Lazy::register_implementation { __PACKAGE__ } before attach_to_class => sub { my ( $self, $class ) = @_; my $mi = $class->get_meta_instance; unless ( does_role( $mi, "KiokuDB::Meta::Instance" ) ) { $self->throw_error("Can't attach to a class whose meta instance doesn't do KiokuDB::Meta::Instance", data => $class ); } }; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Meta::Attribute::Lazy - Trait for lazy loaded attributes =head1 VERSION version 0.56 =head1 SYNOPSIS # in your class: package Foo; use KiokuDB::Class; has bar => ( traits => [qw(KiokuDB::Lazy)], isa => "Bar", is => "ro", ); # Later: my $foo = $dir->lookup($id); # bar is not yet loaded, it will be lazily fetched during this call: $foo->bar; =head1 DESCRIPTION This L trait provides lazy loading on a per field basis for objects stored in L. Instead of using proxy objects with AUTOLOAD, overloading, or similar hacks, you can declaratively specify which attributes you want to make lazy, and this will be done cleanly through the MOP. This is implemented by using a placeholder object, L which contains references to the ID and the linker, and L will know to replace the placeholder with the actual loaded object when it is fetched from the object by an accessor. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Broken.pm100644001750000144 206012237006576 20202 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Rolepackage KiokuDB::Backend::Role::Broken; BEGIN { $KiokuDB::Backend::Role::Broken::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Role::Broken::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Skip test fixtures use namespace::clean -except => 'meta'; requires "skip_fixtures"; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Role::Broken - Skip test fixtures =head1 VERSION version 0.56 =head1 SYNOPSIS with qw(KiokuDB::Backend::Role::Broken); # e.g. if your backend can't tell apart update from insert: use constant skip_fixtures => qw( Overwrite ); =head1 DESCRIPTION If your backend can't pass a test fixture you can ask to skip it using this role. Simply return the fixture's name from the C sub. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Error000755001750000144 012237006576 15127 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDBUnknownObjects.pm100644001750000144 207312237006576 20600 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Errorpackage KiokuDB::Error::UnknownObjects; BEGIN { $KiokuDB::Error::UnknownObjects::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Error::UnknownObjects::VERSION = '0.56'; } use Moose; use namespace::clean -except => "meta"; # autoclean kills overloads use overload '""' => "as_string"; with qw(KiokuDB::Error); has objects => ( isa => "ArrayRef[Ref]", reader => "_objects", required => 1, ); sub objects { @{ shift->_objects } } sub as_string { my $self = shift; local $, = ", "; return "Unregistered objects cannot be updated in database: @{ $self->_objects }"; # FIXME Devel::PartialDump? } __PACKAGE__->meta->make_immutable; # ex: set sw=4 et: __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Error::UnknownObjects =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut MissingObjects.pm100644001750000144 230212237006576 20545 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Errorpackage KiokuDB::Error::MissingObjects; BEGIN { $KiokuDB::Error::MissingObjects::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Error::MissingObjects::VERSION = '0.56'; } use Moose; use namespace::clean -except => "meta"; # autoclean kills overloads use overload '""' => "as_string"; with qw(KiokuDB::Error); has ids => ( isa => "ArrayRef[Str]", reader => "_ids", required => 1, ); sub ids { @{ shift->_ids } } sub as_string { my $self = shift; local $, = ", "; return "Objects missing in database: @{ $self->_ids }"; } sub missing_ids_are { my ( $self, @ids ) = @_; my %ids = map { $_ => 1 } $self->ids; foreach my $id ( @ids ) { return unless delete $ids{$id}; } return ( keys(%ids) == 0 ) } __PACKAGE__->meta->make_immutable; # ex: set sw=4 et: __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Error::MissingObjects =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Default000755001750000144 012237006576 17001 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMapJSON.pm100644001750000144 315612237006576 20255 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMap/Defaultpackage KiokuDB::TypeMap::Default::JSON; BEGIN { $KiokuDB::TypeMap::Default::JSON::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Default::JSON::VERSION = '0.56'; } use Moose; use namespace::clean -except => 'meta'; extends qw(KiokuDB::TypeMap); with 'KiokuDB::TypeMap::Default::Canonical' => { -excludes => [qw(reftype_entries)], }; has json_boolean_typemap => ( traits => [qw(KiokuDB::TypeMap)], does => "KiokuDB::Role::TypeMap", is => "ro", lazy_build => 1, ); sub reftype_entries { my $self = shift; return ( $self->KiokuDB::TypeMap::Default::Canonical::reftype_entries, SCALAR => "KiokuDB::TypeMap::Entry::JSON::Scalar", REF => "KiokuDB::TypeMap::Entry::JSON::Scalar", ); } sub _build_json_boolean_typemap { my $self = shift; $self->_create_typemap( isa_entries => { 'JSON::Boolean' => { type => "KiokuDB::TypeMap::Entry::Passthrough", intrinsic => 1, }, 'JSON::PP::Boolean' => { type => "KiokuDB::TypeMap::Entry::Passthrough", intrinsic => 1, }, }, ); } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Default::JSON =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Std000755001750000144 012237006576 17250 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMap/EntryID.pm100644001750000144 200412237006576 20236 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMap/Entry/Stdpackage KiokuDB::TypeMap::Entry::Std::ID; BEGIN { $KiokuDB::TypeMap::Entry::Std::ID::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Entry::Std::ID::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Provides a default compile_id method use namespace::clean -except => 'meta'; sub compile_id { my ( $self, $class, @args ) = @_; return "generate_uuid"; } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Entry::Std::ID - Provides a default compile_id method =head1 VERSION version 0.56 =head1 SYNOPSIS TODO =head1 DESCRIPTION This role provides a default compile_id method. It is designed to be used in conjunction with other roles to create a full L implementation. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut TXNScope.pm100644001750000144 423412237006576 20413 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/LiveObjectspackage KiokuDB::LiveObjects::TXNScope; BEGIN { $KiokuDB::LiveObjects::TXNScope::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::LiveObjects::TXNScope::VERSION = '0.56'; } use Moose; # ABSTRACT: Transaction scope. use Scalar::Util qw(weaken); use namespace::clean -except => 'meta'; has entries => ( isa => "ArrayRef", is => "ro", default => sub { [] }, ); has live_objects => ( isa => "KiokuDB::LiveObjects", is => "ro", required => 1, ); has parent => ( isa => __PACKAGE__, is => "ro", ); sub push { my ( $self, @entries ) = @_; my $e = $self->entries; foreach my $entry ( @entries ) { push @$e, $entry; weaken($e->[-1]); } } sub rollback { my $self = shift; $self->live_objects->rollback_entries(grep { defined } splice @{ $self->entries }); } sub DEMOLISH { my $self = shift; if ( my $l = $self->live_objects ) { if ( my $parent = $self->parent ) { $l->_set_txn_scope($parent); } else { $l->_clear_txn_scope(); } } } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::LiveObjects::TXNScope - Transaction scope. =head1 VERSION version 0.56 =head1 SYNOPSIS $txn_scope = $live_objects->new_txn; $txn_scope->update_entries(@updated); $txn_scope->rollback; =head1 DESCRIPTION This is an auxiliary class used by transaction scoping to roll back entries updated during a transaction when it is aborted. This is used internally in L and should not need to be used directly. =head1 ATTRIBUTES =over 4 =item entries An ordered log of updated entries. =back =head1 METHODS =over 4 =item update_entries Called by L. Adds entries to C. =item rollback Calls C with all the recorded entries. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Refresh.pm100644001750000144 372312237006576 20504 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Test/Fixturepackage KiokuDB::Test::Fixture::Refresh; BEGIN { $KiokuDB::Test::Fixture::Refresh::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Fixture::Refresh::VERSION = '0.56'; } use Moose; use Test::More; use Test::Exception; use KiokuDB::Test::Person; sub p { my @args = @_; unshift @args, "name" if @args % 2; KiokuDB::Test::Person->new(@args); } with qw(KiokuDB::Test::Fixture) => { -excludes => [qw/populate sort/] }; sub sort { -100 } sub create { return ( KiokuDB::Test::Person->new( name => "julie", age => 10, ), ); } sub populate { my $self = shift; { my $s = $self->new_scope; my $obj = $self->create; isa_ok( $obj, "KiokuDB::Test::Person" ); $self->store_ok( refresh_obj => $obj ); $self->live_objects_are($obj); } $self->no_live_objects; } sub verify { my $self = shift; $self->txn_lives(sub { my $obj = $self->lookup_ok("refresh_obj"); isa_ok( $obj, "KiokuDB::Test::Person" ); is( $obj->name, "julie", "name" ); my $dir = $self->directory; isa_ok( my $entry = $dir->live_objects->object_to_entry($obj), "KiokuDB::Entry" ); my $updated = $entry->clone( prev => $entry ); $updated->data->{age} = 1841; is( $obj->age, 10, "age attr" ); $dir->backend->insert( $updated ); is( $obj->age, 10, "age attr not updated even though it was written" ); lives_ok { $dir->refresh($obj) } "no error in refresh"; is( $obj->age, 1841, "age updated" ); }); } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Fixture::Refresh =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut RootSet.pm100644001750000144 520612237006576 20503 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Test/Fixturepackage KiokuDB::Test::Fixture::RootSet; BEGIN { $KiokuDB::Test::Fixture::RootSet::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Fixture::RootSet::VERSION = '0.56'; } use Moose; use Test::More; use Test::Exception; use KiokuDB::Test::Person; use KiokuDB::Test::Company; use namespace::clean -except => 'meta'; with qw(KiokuDB::Test::Fixture) => { -excludes => 'sort' }; sub sort { -50 } sub create { return ( root_person => KiokuDB::Test::Person->new( name => "blah", kids => [ KiokuDB::Test::Person->new( name => "flarp" ) ], ), ); } sub verify { my $self = shift; $self->txn_lives(sub { my $p = $self->lookup_ok("root_person"); isa_ok( $p, "KiokuDB::Test::Person" ); $self->root_ok($p); $self->not_root_ok($p->kids->[0]); }); $self->no_live_objects; $self->txn_lives(sub { my $p = $self->lookup_ok("root_person"); $self->root_ok($p); $self->not_root_ok($p->kids->[0]); $p->name("pubar"); $self->update_ok($p); $self->root_ok($p); $self->not_root_ok($p->kids->[0]); }); $self->no_live_objects; $self->txn_lives(sub { my $p = $self->lookup_ok("root_person"); $self->root_ok($p); $self->not_root_ok($p->kids->[0]); $self->unset_root($p); $self->not_root_ok($p, $p->kids->[0]); $self->update_ok($p); $self->not_root_ok($p, $p->kids->[0]); }); $self->no_live_objects; $self->txn_lives(sub { my $p = $self->lookup_ok("root_person"); $self->not_root_ok($p, $p->kids->[0]); $self->set_root($p); $self->root_ok($p); $self->not_root_ok($p->kids->[0]); }); $self->no_live_objects; $self->txn_lives(sub { my $p = $self->lookup_ok("root_person"); $self->not_root_ok($p, $p->kids->[0]); $self->set_root($p); $self->root_ok($p); $self->not_root_ok($p->kids->[0]); $self->update_ok($p); }); $self->no_live_objects; $self->txn_lives(sub { my $p = $self->lookup_ok("root_person"); $self->root_ok($p); $self->not_root_ok($p->kids->[0]); }); } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Fixture::RootSet =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Unicode.pm100644001750000144 247112237006576 20473 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Test/Fixtureuse utf8; package KiokuDB::Test::Fixture::Unicode; BEGIN { $KiokuDB::Test::Fixture::Unicode::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Fixture::Unicode::VERSION = '0.56'; } use Moose; use Encode; use Test::More; use KiokuDB::Test::Person; use KiokuDB::Test::Employee; use KiokuDB::Test::Company; use namespace::clean -except => 'meta'; use constant required_backend_roles => qw(UnicodeSafe); with qw(KiokuDB::Test::Fixture) => { -excludes => 'required_backend_roles' }; my $unicode = "משה"; sub create { return ( KiokuDB::Test::Person->new( name => $unicode, ), ); } sub verify { my $self = shift; $self->txn_lives(sub { my $dec = $self->lookup_ok( @{ $self->populate_ids } ); isa_ok( $dec, "KiokuDB::Test::Person" ); ok( Encode::is_utf8($dec->name), "preserved is_utf8" ); is( $dec->name, $unicode, "correct value" ); }); } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Fixture::Unicode =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut SerialIDs.pm100644001750000144 247412237006576 20214 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Role/UUIDspackage KiokuDB::Role::UUIDs::SerialIDs; BEGIN { $KiokuDB::Role::UUIDs::SerialIDs::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Role::UUIDs::SerialIDs::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Serial ID assignment based on a global counter. use namespace::clean -except => 'meta'; my $i = "0001"; # so that the first 10k objects sort lexically sub generate_uuid { $i++ } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Role::UUIDs::SerialIDs - Serial ID assignment based on a global counter. =head1 VERSION version 0.56 =head1 SYNOPSIS # set before loading: BEGIN { $KiokuDB::SERIAL_IDS = 1 } use KiokuDB; =head1 DESCRIPTION This role provides an alternate, development only ID generation role. The purpose of this role is to ease testing when the database is created from scratch on each run. Objects will typically be assigned the same IDs between runs, making things easier to follow. Do B use this role for storage of actual data, because ID clashes are almost guaranteed to cause data loss. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut ClassBuilders.pm100644001750000144 405112237006576 20652 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMappackage KiokuDB::TypeMap::ClassBuilders; BEGIN { $KiokuDB::TypeMap::ClassBuilders::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::ClassBuilders::VERSION = '0.56'; } use Moose; # ABSTRACT: A typemap for standard class builders use namespace::clean -except => 'meta'; extends qw(KiokuDB::TypeMap); with qw(KiokuDB::TypeMap::Composite); has [qw( class_accessor_typemap object_tiny_typemap object_inside_out_typemap )] => ( traits => [qw(KiokuDB::TypeMap)], does => "KiokuDB::Role::TypeMap", is => "ro", lazy_build => 1, ); # Class::Std, Mojo, Badger, Class::MethodMaker, Class::Meta, Class::InsideOut sub _build_class_accessor_typemap { my $self = shift; $self->_naive_isa_typemap("Class::Accessor"); } sub _build_object_tiny_typemap { my $self = shift; $self->_naive_isa_typemap("Object::Tiny"); } sub _build_object_inside_out_typemap { my $self = shift; $self->_create_typemap( isa_entries => { "Object::InsideOut" => { type => "KiokuDB::TypeMap::Entry::StorableHook", }, }, ); } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::ClassBuilders - A typemap for standard class builders =head1 VERSION version 0.56 =head1 SYNOPSIS use KiokuDB::TypeMap::ClassBuilders; my $t = KiokuDB::TypeMap::ClassBuilders->new( exclude => [qw(object_tiny)], ); =head1 DESCRIPTION This typemap provides entries for some standard class builders from the CPAN. This class does the L role and can have its sub maps excluded or overridden. =head1 SUPPORTED MODULES =over 4 =item L =item L =item L =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Closure.pm100644001750000144 1245212237006576 20654 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMap/Entrypackage KiokuDB::TypeMap::Entry::Closure; BEGIN { $KiokuDB::TypeMap::Entry::Closure::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Entry::Closure::VERSION = '0.56'; } use Moose; use Carp qw(croak); use Scalar::Util qw(refaddr); use PadWalker 1.9; no warnings 'recursion'; use namespace::clean -except => 'meta'; with qw(KiokuDB::TypeMap::Entry::Std); sub compile_collapse_body { my $self = shift; require B; require B::Deparse; return sub { my ( $collapser, %args ) = @_; my $sub = $args{object}; my ( $pkg, $name ) = Class::MOP::get_code_info($sub); my %data; # FIXME make this customizable on a per sub and per typemap level if ( $name eq '__ANON__' ) { my $pad = PadWalker::closed_over($sub); if ( keys %$pad ) { my $collapsed_pad = $collapser->visit($pad); $data{pad} = $collapsed_pad; my $buffer = $collapser->_buffer; my $pad_entry_data = blessed $collapsed_pad ? $buffer->id_to_entry( $collapsed_pad->id )->data : $collapsed_pad; $buffer->first_class->insert(map { $_->id } values %$pad_entry_data ); # maybe only if entry($_->id)->object's refcount is > 1 (only shared closure vars) ? } # FIXME find all GVs in the optree and insert refs to them? # i suppose they should be handled like named... $data{body} = $self->_deparse($sub); } else { ( my $pkg_file = "${pkg}.pm" ) =~ s{::}{/}g; my $file; if ( my $meta = Class::MOP::get_metaclass_by_name($pkg) ) { if ( my $method = $meta->get_method($name) ) { if ( refaddr($method->body) == refaddr($sub) and $method->isa("Class::MOP::Method::Generated") and $method->can("definition_context") ) { $file = $method->definition_context->{file}; } } } unless ( defined $file ) { my $cv = B::svref_2object($sub); $file = $cv->FILE unless $cv->XSUB; # Can't really tell who called newXS or even bootstrap, so we assume the package .pm did } my $inc_key; if ( defined $file ) { my %rev_inc = reverse %INC; $inc_key = $rev_inc{$file}; $inc_key = $file unless defined $inc_key; } if ( defined($inc_key) and $pkg_file ne $inc_key ) { $data{file} = $inc_key; } @data{qw(package name)} = ( $pkg, $name ); } return $collapser->make_entry( %args, object => $sub, data => \%data, ); }; } sub _deparse { my ( $self, $cv ) = @_; B::Deparse->new->coderef2text($cv); } sub compile_expand { my $self = shift; return sub { my ( $linker, $entry ) = @_; my $data = $entry->data; if ( exists $data->{body} ) { my ( $body, $pad ) = @{ $data }{qw(body pad)}; my $inflated_pad; $linker->inflate_data( $pad, \$inflated_pad ); my $sub = $self->_eval_body( $linker, $body, $inflated_pad ); $linker->register_object( $entry => $sub ); return $sub; } else { my $fq = join("::", @{ $data }{qw(package name)}); my $glob = do { no strict 'refs'; *$fq }; unless ( defined(*{$glob}{CODE}) ) { if ( defined(my $file = $data->{file}) ) { require $file unless exists $INC{$file}; } else { Class::MOP::load_class($data->{package}); } unless ( defined(*{$glob}{CODE}) ) { croak "The subroutine &$data->{name} is no longer defined, but is referred to in the database"; } } my $sub = *{$glob}{CODE}; $linker->register_object( $entry => $sub ); return $sub; } }; } sub compile_refresh { my $self = shift; return sub { croak "refreshing of closures is not yet supported"; }; } sub _eval_body { my ( $self, $linker, $body, $pad ) = @_; my ( $sub, $e ) = do { local $@; if ( my @vars = keys %$pad ) { my $vars = join ", ", @vars; # FIXME Parse::Perl my $sub = eval " my ( $vars ); sub $body; "; my $e = $@; $linker->queue_finalizer(sub { PadWalker::set_closed_over($sub, $pad); }) if $sub; ( $sub, $e ); } else { eval "sub $body", $@; } }; die $e unless $sub; return $sub; } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Entry::Closure =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut TXN000755001750000144 012237006576 17054 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Test/FixtureScan.pm100644001750000144 1535312237006576 20465 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Test/Fixture/TXNpackage KiokuDB::Test::Fixture::TXN::Scan; BEGIN { $KiokuDB::Test::Fixture::TXN::Scan::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Fixture::TXN::Scan::VERSION = '0.56'; } use Moose; use Test::More; use Test::Exception; use Test::Moose; use KiokuDB::Test::Person; use namespace::clean -except => 'meta'; extends qw(KiokuDB::Test::Fixture::Scan); override required_backend_roles => sub { return (qw(TXN), super()); }; sub sort { 151 } around populate => sub { my ( $next, $self, @args ) = @_; $self->txn_do(sub { $self->$next(@args) }); }; sub verify { my $self = shift; $self->txn_lives(sub { my $root = $self->root_set; does_ok( $root, "Data::Stream::Bulk" ); my @objs = $root->all; my @ids = $self->objects_to_ids(@objs); is_deeply( [ sort map { $_->name } @objs ], [ sort qw(foo bar gorch) ], "root set", ); is_deeply( [ sort $self->backend->root_entry_ids->all ], [ sort @ids ], "root set IDs", ); }); throws_ok { $self->txn_do(scope => 1, body => sub { $self->insert_ok( KiokuDB::Test::Person->new( name => "another" ) ); my $root = $self->root_set; does_ok( $root, "Data::Stream::Bulk" ); my @objs = $root->all; my @ids = $self->objects_to_ids(@objs); is_deeply( [ sort map { $_->name } @objs ], [ sort qw(foo bar gorch another) ], "root set reflects insertion", ); is_deeply( [ sort $self->backend->root_entry_ids->all ], [ sort @ids ], "root set IDs are the same", ); die "rollback"; }); } qr/rollback/; $self->txn_lives(sub { my $root = $self->root_set; my @objs = $root->all; my @ids = $self->objects_to_ids(@objs); is_deeply( [ sort map { $_->name } @objs ], [ sort qw(foo bar gorch) ], "root set rolled back", ); is_deeply( [ sort $self->backend->root_entry_ids->all ], [ sort @ids ], "ids are the same", ); }); my $foo_id; $self->txn_lives(sub { my %objs = map { $_->name => $_ } $self->root_set->all; $foo_id = $self->object_to_id($objs{foo}); }); ok( defined($foo_id), "got an ID for foo" ); throws_ok { $self->txn_do(scope => 1, body => sub { $self->delete_ok($foo_id); { my $root = $self->root_set; my @objs = $root->all; my @ids = $self->objects_to_ids(@objs); is_deeply( [ sort map { $_->name } @objs ], [ sort qw(bar gorch) ], "root set reflects deletion", ); is_deeply( [ sort $self->backend->root_entry_ids->all ], [ sort @ids ], "root set IDs are the same", ); } { $self->insert_ok( KiokuDB::Test::Person->new( name => "blah" ) ); my $root = $self->root_set; does_ok( $root, "Data::Stream::Bulk" ); my @objs = $root->all; my @ids = $self->objects_to_ids(@objs); is_deeply( [ sort map { $_->name } @objs ], [ sort qw(blah bar gorch) ], "root set reflects deletion and insertion", ); is_deeply( [ sort $self->backend->root_entry_ids->all ], [ sort @ids ], "root set IDs are the same", ); } die "rollback"; }); } qr/rollback/; $self->txn_lives(sub { my $root = $self->root_set; my @objs = $root->all; my @ids = $self->objects_to_ids(@objs); is_deeply( [ sort map { $_->name } @objs ], [ sort qw(foo bar gorch) ], "root set", ); is_deeply( [ sort $self->backend->root_entry_ids->all ], [ sort @ids ], "ids are the same", ); }); $self->txn_lives(sub { my @objs = $self->all_objects->all; my @ids = $self->objects_to_ids(@objs); is_deeply( [ sort map { $_->name } @objs ], [ sort qw(foo bar gorch quxx) ], "all entries", ); is_deeply( [ sort $self->backend->all_entry_ids->all ], [ sort @ids ], "all IDs", ); }); throws_ok { $self->txn_do(scope => 1, body => sub { $self->backend->clear; is_deeply( [ $self->all_objects->all ], [ ], "no entries (db cleared)", ); $self->insert_ok( KiokuDB::Test::Person->new( name => "very new" ) ); is_deeply( [ map { $_->name } $self->all_objects->all ], [ "very new" ], "one entry", ); $self->txn_lives(sub { $self->backend->clear; is_deeply( [ $self->all_objects->all ], [ ], "no entries (db cleared)", ); }); is_deeply( [ $self->all_objects->all ], [ ], "no entries (db cleared)", ); die "rollback"; }); } qr/rollback/, "rolled back"; $self->txn_lives(sub { my @objs = $self->all_objects->all; my @ids = $self->objects_to_ids(@objs); is_deeply( [ sort map { $_->name } @objs ], [ sort qw(foo bar gorch quxx) ], "all entries restored", ); is_deeply( [ sort $self->backend->all_entry_ids->all ], [ sort @ids ], "all IDs", ); }); $self->txn_lives(sub { $self->backend->clear; }); $self->txn_lives(sub { is_deeply( [ $self->all_objects->all ], [ ], "no entries (db cleared)", ); }); } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Fixture::TXN::Scan =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Handlers.pm100644001750000144 125112237006576 20563 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Role/Upgradepackage KiokuDB::Role::Upgrade::Handlers; BEGIN { $KiokuDB::Role::Upgrade::Handlers::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Role::Upgrade::Handlers::VERSION = '0.56'; } use Moose::Role; use namespace::clean; requires "kiokudb_upgrade_handler"; # ex: set sw=4 et: __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Role::Upgrade::Handlers =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Prefetch.pm100644001750000144 123012237006576 20520 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Rolepackage KiokuDB::Backend::Role::Prefetch; BEGIN { $KiokuDB::Backend::Role::Prefetch::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Role::Prefetch::VERSION = '0.56'; } use Moose::Role; use namespace::clean -except => 'meta'; requires 'prefetch'; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Role::Prefetch =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Callback.pm100644001750000144 1144012237006576 20730 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMap/Entrypackage KiokuDB::TypeMap::Entry::Callback; BEGIN { $KiokuDB::TypeMap::Entry::Callback::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Entry::Callback::VERSION = '0.56'; } use Moose; # ABSTRACT: Callback based inflation/deflation of objects no warnings 'recursion'; use Carp qw(croak); use namespace::clean -except => 'meta'; with qw(KiokuDB::TypeMap::Entry::Std); has [qw(collapse expand)] => ( is => "ro", isa => "Str|CodeRef", required => 1, ); has [qw(id refresh)] => ( is => "ro", isa => "Str|CodeRef", ); sub compile_collapse_body { my ( $self, $class, @args ) = @_; my $collapse_object = $self->collapse; return sub { my ( $self, %args ) = @_; my @data = $args{object}->$collapse_object; my $data; if ( @data == 1 and not ref $data[0] ) { $data = $data[0]; } else { $data = [ map { $self->visit($_) } @data ]; } return $self->make_entry( %args, data => $data, ); }; } sub _entry_data_to_args { my ( $self, $linker, $entry ) = @_; my $data = $entry->data; if ( ref $data ) { my @args; my $refs = 0; foreach my $value ( @$data ) { if ( ref $value ) { push @args, undef; $linker->inflate_data($value, \$args[-1]); $refs++; } else { push @args, $value; } } $linker->load_queue if $refs; # force @args to be fully vivified return @args; } else { return $data; } } sub compile_expand { my ( $self, $class, @args ) =@_; my $expand_object = $self->expand; return sub { my ( $linker, $entry ) = @_; my @args = $self->_entry_data_to_args($linker, $entry); # does *NOT* support circular refs my $object = $entry->class->$expand_object(@args); $linker->register_object( $entry => $object ); return $object; }; } sub compile_refresh { my ( $self, $class, @args ) = @_; if ( my $refresh_object = $self->refresh ) { return sub { my ( $linker, $object, $entry ) = @_; my @args = $self->_entry_data_to_args($linker, $entry); $object->$refresh_object(@args); return $object; }; } else { return sub { croak "No refresh method provided for $class by typemap entry $self"; }; } } sub compile_id { my ( $self, $class, @args ) = @_; if ( my $get_id = $self->id ) { return sub { my ( $self, $object ) = @_; $object->$get_id; }; } else { return "generate_uuid"; } } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Entry::Callback - Callback based inflation/deflation of objects =head1 VERSION version 0.56 =head1 SYNOPSIS KiokuDB::TypeMap->new( entries => { 'My::Class' => KiokuDB::TypeMap::Entry::Callback->new( expand => "new", # My::Class->new(%$self) collapse => sub { my $self = shift; return %$self; # provide args to 'new' in this example }, id => sub { "foo" }, # 'id' callback is optional ), }, ); =head1 DESCRIPTION This L entry provides callback based inflation/deflation. The major limitation of this method is that it cannot be used for self referential structures. This is because the object being inflated is only constructed after all of its arguments are. For the overwhelming majority of the use cases this is good enough though. =head1 ATTRIBUTES =over 4 =item collapse A method name or code reference invoked on the object during collapsing. This is evaluated in list context, and the list of values it returns will be collapsed by the L and then stored. =item expand A method name or code reference invoked on the class of the object during loading. The arguments are as returned by the C callback. =item id An optional method name or code reference invoked to get an ID for the object. If one is not provided the default (UUID based) generation is used. =item intrinsic A boolean denoting whether or not the object should be collapsed with no ID, and serialized as part of its parent object. This is useful for value like objects, for whom the reference address makes no difference (such as L objects). =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Compiled.pm100644001750000144 461412237006576 20755 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMap/Entrypackage KiokuDB::TypeMap::Entry::Compiled; BEGIN { $KiokuDB::TypeMap::Entry::Compiled::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Entry::Compiled::VERSION = '0.56'; } use Moose; no warnings 'recursion'; use namespace::clean -except => 'meta'; has [qw(expand_method collapse_method id_method refresh_method)] => ( isa => "CodeRef|Str", is => "ro", required => 1, ); has class => ( isa => "Str", is => "ro", required => 1, ); has entry => ( does => "KiokuDB::TypeMap::Entry", is => "ro", required => 1, ); __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Entry::Compiled =head1 VERSION version 0.56 =head1 SYNOPSIS TODO =head1 DESCRIPTION Objects of this class should be returned by L. You probably shouldn't be using this directly; you may just want to consume L or something. =head1 NAME KiokuDB::TypeMap::Entry::Compiled - Object for storing collapse/expand methods =head1 ATTRIBUTES =over 4 =item expand_method Contains a subroutine reference (or a string, denoting a method name). It is called as method on the L. Takes a L as an argument, and should return the expanded object. =item collapse_method Contains a subroutine reference (or a string, denoting a method name). It is called as method on the L. Takes the object to be collapsed as an argument, and should return a L. =item id_method Contains a subroutine reference (or a string, denoting a method name). It is called as method on the L. Takes the object to be collapsed as an argument, and should return an ID for it . =item refresh_method Contains a subroutine reference (or a string, denoting a method name). It is called as method on the L. Takes the object to be refreshed and its corresponding L as arguments. =item class The class for which the methods are being compiled. =item entry The L that created this object. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Overwrite.pm100644001750000144 706012237006576 21072 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Test/Fixturepackage KiokuDB::Test::Fixture::Overwrite; BEGIN { $KiokuDB::Test::Fixture::Overwrite::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Fixture::Overwrite::VERSION = '0.56'; } use Moose; use Test::More; use Test::Exception; use Scalar::Util qw(refaddr); use KiokuDB::Test::Person; use KiokuDB::Test::Employee; use KiokuDB::Test::Company; { package KiokuDB::Test::BLOB; BEGIN { $KiokuDB::Test::BLOB::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::BLOB::VERSION = '0.56'; } use Moose; with qw(KiokuDB::Role::ID::Content); sub kiokudb_object_id { my $self = shift; $self->data; } has data => ( isa => "Str", is => "ro", required => 1, ); } sub p { my @args = @_; unshift @args, "name" if @args % 2; KiokuDB::Test::Person->new(@args); } with qw(KiokuDB::Test::Fixture) => { -excludes => [qw/populate sort/] }; sub sort { -100 } sub create { return ( KiokuDB::Test::Person->new( name => "blah", ), KiokuDB::Test::BLOB->new( data => "lalala", ), ); } sub populate { my $self = shift; { my $s = $self->new_scope; my ( $p, $b ) = $self->create; isa_ok( $p, "KiokuDB::Test::Person" ); isa_ok( $b, "KiokuDB::Test::BLOB" ); $self->store_ok( person => $p, $b ); $self->live_objects_are($p, $b); } $self->no_live_objects; } sub verify { my $self = shift; { my $s = $self->new_scope; my $p = $self->lookup_ok("person"); isa_ok( $p, "KiokuDB::Test::Person" ); is( $p->name, "blah", "name attr" ); $p->name("new name"); lives_ok { $self->directory->store($p); } "update"; } $self->no_live_objects; { my $s = $self->new_scope; my $b = $self->lookup_ok("lalala"); isa_ok( $b, "KiokuDB::Test::BLOB" ); is( $b->data, "lalala", "data attr" ); my $entry = $self->directory->live_objects->object_to_entry($b); lives_ok { $self->directory->store($b); } "update (noop)"; my $new_entry = $self->directory->live_objects->object_to_entry($b); is( refaddr($new_entry), refaddr($entry), "entry refaddr unchanged" ); } $self->no_live_objects; dies_ok { my $s = $self->new_scope; $self->txn_do(sub { $self->directory->store( person => KiokuDB::Test::Person->new( name => "duplicate" ) ); }); } "can't insert duplicate"; $self->no_live_objects; lives_ok { my $s = $self->new_scope; $self->txn_do(sub { my $id = $self->directory->store( KiokuDB::Test::BLOB->new( data => "lalala" ) ); }); } "not an error to insert a duplicate of a content addressed object"; $self->no_live_objects; lives_ok { my $s = $self->new_scope; my $b = $self->lookup_ok("lalala"); $self->txn_do(sub { my $id = $self->directory->store( KiokuDB::Test::BLOB->new( data => "lalala" ) ); }); } "not an error to insert a duplicate of a live content addressed object"; $self->no_live_objects; } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Fixture::Overwrite =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut GIN000755001750000144 012237006576 17020 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Test/FixtureClass.pm100644001750000144 444112237006576 20566 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Test/Fixture/GINpackage KiokuDB::Test::Fixture::GIN::Class; BEGIN { $KiokuDB::Test::Fixture::GIN::Class::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Fixture::GIN::Class::VERSION = '0.56'; } use Moose; use Test::More; use Test::Moose; use Scalar::Util qw(refaddr); use Search::GIN::Query::Class 0.03; use namespace::clean -except => 'meta'; extends qw(KiokuDB::Test::Fixture::Small); use constant required_backend_roles => qw(Clear Scan Query::GIN); before populate => sub { my $self = shift; $self->backend->clear; }; sub verify { my $self = shift; my $q_person = Search::GIN::Query::Class->new( class => "KiokuDB::Test::Person" ); my $q_employee = Search::GIN::Query::Class->new( class => "KiokuDB::Test::Employee" ); $self->txn_lives(sub { my @objs = $self->root_set->all; my $people = $self->search($q_person); my $employees = $self->search($q_employee); does_ok($_, "Data::Stream::Bulk") for ( $people, $employees ); my @people = $people->all; my @employees = $employees->all; is_deeply( [ sort map { refaddr($_) } @employees ], [ refaddr($self->lookup_ok($self->joe)) ], "employees", ); is_deeply( [ sort map { refaddr($_) } @people ], [ sort map { refaddr($_) } @objs, @{ $self->lookup_ok($self->joe)->parents } ], "set of all people", ); }); $self->no_live_objects; $self->txn_lives(sub { my ( $joe, $mum, $oscar ) = sort { $a->name cmp $b->name } $self->search($q_person)->all; is( $joe->name, "joe", "loaded first object" ); is( $mum->name, "mum", "loaded second object" ); is( $oscar->name, "oscar", "loaded third object" ); is( $joe->parents->[0], $mum, "interrelated objects loaded in one graph" ); }); $self->no_live_objects; } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Fixture::GIN::Class =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Serialize000755001750000144 012237006576 17314 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/BackendYAML.pm100644001750000144 466112237006576 20563 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Serializepackage KiokuDB::Backend::Serialize::YAML; BEGIN { $KiokuDB::Backend::Serialize::YAML::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Serialize::YAML::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: YAML::XS based serialization of KiokuDB::Entry objects. use IO::Handle; use YAML::XS 0.30 qw(Load Dump); use namespace::clean -except => 'meta'; with qw( KiokuDB::Backend::Serialize KiokuDB::Backend::Role::UnicodeSafe KiokuDB::Backend::TypeMap::Default::Storable ); sub serialize { my ( $self, $entry ) = @_; my $clone = $entry->clone; $clone->clear_prev; $clone->root( $entry->root ); Dump($clone); } sub deserialize { my ( $self, $blob ) = @_; return Load($blob); } sub serialize_to_stream { my ( $self, $fh, $entry ) = @_; $fh->print( $self->serialize($entry) ); } has _deserialize_buffer => ( isa => "ScalarRef", is => "ro", default => sub { my $x = ''; \$x }, ); sub deserialize_from_stream { my ( $self, $fh ) = @_; local $_; local $/ = "\n"; my $buf = $self->_deserialize_buffer; while ( <$fh> ) { if ( /^---/ and length($$buf) ) { my @data = $self->deserialize($$buf); $$buf = $_; return @data; } else { $$buf .= $_; } } if ( length $$buf ) { my @data = $self->deserialize($$buf); $$buf = ''; return @data; } else { return; } } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Serialize::YAML - YAML::XS based serialization of KiokuDB::Entry objects. =head1 VERSION version 0.56 =head1 SYNOPSIS package MyBackend; use Moose; with qw(KiokuDB::Backend::Serialize::YAML); =head1 DESCRIPTION L is preferred to using this directly. =head1 METHODS =over 4 =item serialize $entry Calls L =item deserialize $str Calls L =item serialize_to_stream $fh, $entry Serializes the entry and prints to the file handle. =item deserialize_from_stream $fh Reads until a YAML document boundry is reached, and then deserializes the current buffer. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Null.pm100644001750000144 162212237006576 20725 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Serializepackage KiokuDB::Backend::Serialize::Null; BEGIN { $KiokuDB::Backend::Serialize::Null::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Serialize::Null::VERSION = '0.56'; } use Moose::Role; use namespace::clean -except => 'meta'; with qw( KiokuDB::Backend::Serialize KiokuDB::Backend::Role::UnicodeSafe KiokuDB::Backend::Role::BinarySafe ); sub serialize { my ( $self, $entry ) = @_; return $entry;; } sub deserialize { my ( $self, $entry ) = @_; return $entry; } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Serialize::Null =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut JSON.pm100644001750000144 560512237006576 20571 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Serializepackage KiokuDB::Backend::Serialize::JSON; BEGIN { $KiokuDB::Backend::Serialize::JSON::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Serialize::JSON::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Role to serialize entries to JSON strings with KiokuDB::Backend::Serialize::JSPON semantics use IO::Handle; use namespace::clean -except => 'meta'; with qw( KiokuDB::Backend::Serialize KiokuDB::Backend::Role::UnicodeSafe KiokuDB::Backend::Serialize::JSPON ); has pretty => ( isa => "Bool", is => "rw", default => 0, ); has [qw(utf8 canonical)] => ( isa => "Bool", is => "rw", default => 1, ); has json => ( isa => "Object", is => "rw", lazy_build => 1, handles => [qw(encode decode)], ); sub _build_json { my $self = shift; my $json = JSON->new; foreach my $flag (qw(utf8 pretty canonical)) { $json->$flag if $self->$flag; } return $json; } sub serialize { my ( $self, @args ) = @_; $self->encode( $self->collapse_jspon(@args) ); } sub deserialize { my ( $self, $json, @args ) = @_; $self->expand_jspon( $self->decode($json), @args ); } sub serialize_to_stream { my ( $self, $fh, $entry ) = @_; $fh->print( $self->serialize($entry) ); } sub deserialize_from_stream { my ( $self, $fh ) = @_; local $_; local $/ = \4096; my $json = $self->json; while ( <$fh> ) { if ( my @docs = $json->incr_parse($_) ) { my @entries = map { $self->expand_jspon($_) } @docs; return @entries; } else { return if $fh->eof; } } return; } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Serialize::JSON - Role to serialize entries to JSON strings with KiokuDB::Backend::Serialize::JSPON semantics =head1 VERSION version 0.56 =head1 SYNOPSIS with qw(KiokuDB::Backend::Serialize::JSON); sub foo { my ( $self, $entry ) = @_; my $json_string = $self->serialize($entry); } =head1 DESCRIPTION This role provides additional convenience attributes and methods for backends that encode entries to JSON strings, on top of L which only restructures the data. L is preferred to using this directly. =head1 METHODS =over 4 =item serialize $entry Returns a JSON string =item deserialize $json_str Returns a L =back =head1 ATTRIBUTES =over 4 =item json The L instance used to encode/decode the JSON. =item pretty Whether or not to pass the C flag to the L object after construction. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Query000755001750000144 012237006576 17373 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/RoleGIN.pm100644001750000144 242412237006576 20510 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Role/Querypackage KiokuDB::Backend::Role::Query::GIN; BEGIN { $KiokuDB::Backend::Role::Query::GIN::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Role::Query::GIN::VERSION = '0.56'; } use Moose::Role; use namespace::clean -except => 'meta'; with qw( Search::GIN::Extract Search::GIN::Driver ); has distinct => ( isa => "Bool", is => "rw", default => 0, # FIXME what should the default be? ); sub search { my ( $self, $query, @args ) = @_; my %args = ( distinct => $self->distinct, @args, ); my @spec = $query->extract_values($self); my $ids = $self->fetch_entries(@spec); $ids = unique($ids) if $args{distinct}; return $ids->filter(sub {[ $self->get(@$_) ]}); } sub search_filter { my ( $self, $objects, $query, @args ) = @_; return $objects->filter(sub { [ grep { $query->consistent($self, $_) } @$_ ] }); } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Role::Query::GIN =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut MassInsert.pm100644001750000144 254212237006576 21174 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Test/Fixturepackage KiokuDB::Test::Fixture::MassInsert; BEGIN { $KiokuDB::Test::Fixture::MassInsert::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Fixture::MassInsert::VERSION = '0.56'; } use Moose; use Test::More; use Test::Exception; use Scalar::Util qw(refaddr); use KiokuDB::Test::Person; sub p { my @args = @_; unshift @args, "name" if @args % 2; KiokuDB::Test::Person->new(@args); } with qw(KiokuDB::Test::Fixture) => { -excludes => [qw/populate sort/] }; sub sort { 100 } sub create { return map { p("person$_") } (1 .. 1024); } sub populate { my $self = shift; $self->txn_do(sub { my $s = $self->new_scope; my %people; @people{1 .. 1024} = $self->create; $self->store_ok(%people); }); } sub verify { my $self = shift; $self->no_live_objects; $self->txn_do(sub { my $s = $self->new_scope; my $p = $self->lookup_ok(1 .. 1024); }); $self->no_live_objects; } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Fixture::MassInsert =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Nested.pm100644001750000144 605012237006576 20775 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Test/Fixture/TXNpackage KiokuDB::Test::Fixture::TXN::Nested; BEGIN { $KiokuDB::Test::Fixture::TXN::Nested::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Fixture::TXN::Nested::VERSION = '0.56'; } use Moose; use Test::More; use Test::Exception; use Try::Tiny; use namespace::clean -except => 'meta'; extends qw(KiokuDB::Test::Fixture::TXN); use constant required_backend_roles => qw(TXN TXN::Nested); sub sort { 151 } # after TXN sub verify { my $self = shift; my $l = $self->directory->live_objects; { { my $s = $self->new_scope; my $joe = $self->lookup_ok( $self->joe ); is( $joe->name, "joe", "name attr" ); my $entry = $l->objects_to_entries($joe); isa_ok( $entry, "KiokuDB::Entry" ); throws_ok { $self->txn_do(sub { $joe->name("lalalala"); $self->update_ok($joe); my ( $db_entry ) = $self->backend->get( $self->joe ); is( $db_entry->data->{name}, "lalalala", "entry written to DB" ); my $err; try { $self->txn_do(sub { $joe->name("oi"); $self->update_ok($joe); my ( $inner_db_entry ) = $self->backend->get( $self->joe ); is( $inner_db_entry->data->{name}, "oi", "entry written to DB" ); my $updated_entry = $l->objects_to_entries($joe); isnt( $updated_entry, $entry, "entry updated" ); is( $updated_entry->prev->prev, $entry, "parent of parent of updated is orig" ); die "foo"; }); } catch { $err = $_; }; my ( $db_entry_rolled_back ) = $self->backend->get( $self->joe ); is( $db_entry_rolled_back->data->{name}, "lalalala", "rolled back nested txn" ); die $err; }); } qr/foo/, "failed transaction"; my $updated_entry = $l->objects_to_entries($joe); is( $updated_entry, $entry, "entry rolled back" ); is( $joe->name, "oi", "name attr of object" ); undef $joe; } $self->no_live_objects; { my $s = $self->new_scope; my $joe = $self->lookup_ok( $self->joe ); is( $joe->name, "joe", "name rolled back in DB" ); undef $joe; } $self->no_live_objects; } } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Fixture::TXN::Nested =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut JSPON.pm100644001750000144 366412237006576 20714 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Serializepackage KiokuDB::Backend::Serialize::JSPON; BEGIN { $KiokuDB::Backend::Serialize::JSPON::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Serialize::JSPON::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: JSPON serialization helper use KiokuDB::Backend::Serialize::JSPON::Expander; use KiokuDB::Backend::Serialize::JSPON::Collapser; use namespace::clean -except => 'meta'; with qw( KiokuDB::Backend::TypeMap::Default::JSON KiokuDB::Backend::Serialize::JSPON::Converter ); has expander => ( isa => "KiokuDB::Backend::Serialize::JSPON::Expander", is => "rw", lazy_build => 1, handles => [qw(expand_jspon)], ); sub _build_expander { my $self = shift; KiokuDB::Backend::Serialize::JSPON::Expander->new($self->_jspon_params); } has collapser => ( isa => "KiokuDB::Backend::Serialize::JSPON::Collapser", is => "rw", lazy_build => 1, handles => [qw(collapse_jspon)], ); sub _build_collapser { my $self = shift; KiokuDB::Backend::Serialize::JSPON::Collapser->new($self->_jspon_params); } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Serialize::JSPON - JSPON serialization helper =head1 VERSION version 0.56 =head1 SYNOPSIS with qw(KiokuDB::Backend::Serialize::JSPON); =head1 DESCRIPTION This serialization role provides JSPON semantics for L and L objects. For serialization to JSON strings see L. =head1 METHODS =over 4 =item expand_jspon See L =item collapse_jspon See L =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut TypeMap000755001750000144 012237006576 16744 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/BackendDefault.pm100644001750000144 240012237006576 21022 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/TypeMappackage KiokuDB::Backend::TypeMap::Default; BEGIN { $KiokuDB::Backend::TypeMap::Default::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::TypeMap::Default::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: A role for backends with a default typemap use namespace::clean -except => 'meta'; has default_typemap => ( does => "KiokuDB::Role::TypeMap", is => "ro", required => 1, lazy_build => 1, ); requires "_build_default_typemap"; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::TypeMap::Default - A role for backends with a default typemap =head1 VERSION version 0.56 =head1 SYNOPSIS package MyBackend; with qw( ... KiokuDB::Backend::TypeMap::Default ); sub _build_default_typemap { ... } =head1 DESCRIPTION This role requires that you implement a single method, C<_build_default_typemap> that will return a L instance. See L for details. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut BinarySafe.pm100644001750000144 247712237006576 21021 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Rolepackage KiokuDB::Backend::Role::BinarySafe; BEGIN { $KiokuDB::Backend::Role::BinarySafe::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Role::BinarySafe::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: An informational role for binary data safe backends. use namespace::clean -except => 'meta'; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Role::BinarySafe - An informational role for binary data safe backends. =head1 VERSION version 0.56 =head1 SYNOPSIS package KiokuDB::Backend::MySpecialBackend; use Moose; use namespace::clean -except => 'meta'; with qw(KiokuDB::Backend::Role::BinarySafe); =head1 DESCRIPTION This backend is an informational role for backends which can store arbitrary binary strings, especially utf8 data as bytes (without reinterpreting it as unicode strings when inflating). This mostly has to do with L variants (for example L is binary safe, while L is not). =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut TXN000755001750000144 012237006576 16737 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/RoleMemory.pm100644001750000144 1525512237006576 20735 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Role/TXNpackage KiokuDB::Backend::Role::TXN::Memory; BEGIN { $KiokuDB::Backend::Role::TXN::Memory::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Role::TXN::Memory::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: In memory transactions. use Carp qw(croak); use KiokuDB::Util qw(deprecate); with qw(KiokuDB::Backend::Role::TXN); use namespace::clean -except => 'meta'; requires qw(commit_entries get_from_storage); # extremely slow/shitty fallback method, will be deprecated eventually sub exists_in_storage { my ( $self, @uuids ) = @_; deprecate('0.37', 'exists_in_storage should be implemented in TXN::Memory using backends'); map { $self->get_from_storage($_) ? 1 : '' } @uuids; } has _txn_stack => ( isa => "ArrayRef", is => "ro", default => sub { [] }, ); sub _new_frame { return { 'live' => {}, 'log' => [], 'cleared' => !1, }; } sub txn_begin { my $self = shift; push @{ $self->_txn_stack }, $self->_new_frame; } sub txn_rollback { my $self = shift; pop @{ $self->_txn_stack } || croak "no open transaction"; } sub txn_commit { my $self = shift; my $stack = $self->_txn_stack; my $txn = pop @$stack || croak "no open transaction"; if ( @{ $self->_txn_stack } ) { $stack->[-1] = $self->_collapse_txn_frames($txn, $stack->[-1]); } else { $self->clear_storage if $txn->{cleared}; $self->commit_entries(@{ $txn->{log} }); } } sub _collapsed_txn_stack { my $self = shift; $self->_collapse_txn_frames(reverse @{ $self->_txn_stack }); } sub _collapse_txn_frames { my ( $self, $head, @tail ) = @_; return $self->_new_frame unless $head; return $head unless @tail; my $next = shift @tail; if ( $head->{cleared} ) { return $head; } else { my $merged = { cleared => $next->{cleared}, log => [ @{ $next->{log} }, @{ $head->{log} }, ], live => { %{ $next->{live} }, %{ $head->{live} }, }, }; return $self->_collapse_txn_frames( $merged, @tail ); } } # FIXME remove duplication between get/exists sub get { my ( $self, @uuids ) = @_; my %entries; my %remaining = map { $_ => undef } @uuids; my $stack = $self->_txn_stack; foreach my $frame ( @$stack ) { # try to find a modified entry for every remaining key foreach my $id ( keys %remaining ) { if ( my $entry = $frame->{live}{$id} ) { if ( $entry->deleted ) { return (); } $entries{$id} = $entry; delete $remaining{$id}; } } # if there are no more remaining keys, we can stop examining the # transaction frames last unless keys %remaining; # if the current frame has cleared the DB and there are still remaining # keys, they are supposed to fail the lookup return () if $frame->{cleared}; } if ( keys %remaining ) { my @remaining = $self->get_from_storage(keys %remaining); if ( @remaining ) { @entries{keys %remaining} = @remaining; @{ $stack->[-1]{live} }{keys %remaining} = @remaining if @$stack; } else { return (); } } return @entries{@uuids}; } # FIXME remove duplication between get/exists sub exists { my ( $self, @uuids ) = @_; my %exists; my %remaining = map { $_ => undef } @uuids; foreach my $frame ( @{ $self->_txn_stack } ) { foreach my $id ( keys %remaining ) { if ( my $entry = $frame->{live}{$id} ) { $exists{$id} = not $entry->deleted; delete $remaining{$id}; } } last unless keys %remaining; if ( $frame->{cleared} ) { @exists{keys %remaining} = ('') x keys %remaining; return @exists{@uuids}; } } if ( keys %remaining ) { @exists{keys %remaining} = $self->exists_in_storage(keys %remaining); } return @exists{@uuids}; } sub delete { my ( $self, @ids_or_entries ) = @_; my @entries = grep { ref } @ids_or_entries; my @ids = grep { not ref } @ids_or_entries; my @new_entries = map { $_->deletion_entry } $self->get(@ids); $self->insert(@entries, @new_entries); return @new_entries; } sub insert { my ( $self, @entries ) = @_; if ( @{ $self->_txn_stack } ) { my $head = $self->_txn_stack->[-1]; push @{ $head->{log} }, @entries; @{$head->{live}}{map { $_->id } @entries} = @entries; } else { $self->commit_entries(@entries); } } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Role::TXN::Memory - In memory transactions. =head1 VERSION version 0.56 =head1 SYNOPSIS with qw(KiokuDB::Backend::Role::TXN::Memory); sub commit_entries { my ( $self, @entries ) = @_; # atomically apply @entries # deleted entries have the deleted flag set # if an entry has no 'prev' entry it's an insert # otherwise it's an update } =head1 DESCRIPTION This backend provides in memory transactions for backends which support atomic modification of data, but not full commit/rollback support. This backend works by buffering all operations in memory. Entries are kept alive allowing read operations go to the live entry even for objects that are out of scope. This implementation provides repeatable read level isolation. Durability, concurrency and atomicity are still the responsibility of the backend. =head1 REQUIRED METHODS =over 4 =item commit_entries Insert, update or delete entries as specified. This operation should either fail or succeed atomically. Entries with C should be removed from the database, entries with a C entry should be inserted, and all other entries should be updated. Multiple entries may be given for a single object, for instance an object that was first inserted and then modified will have an insert entry and an update entry. =item get_from_storage Should be the same as L. When no memory buffered entries are available for the object one is fetched from the backend. =item exists_in_storage Required as of L version 0.37. A fallback implementation is provided, but should not be used and will issue a deprecation warning. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Nested.pm100644001750000144 172112237006576 20660 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Role/TXNpackage KiokuDB::Backend::Role::TXN::Nested; BEGIN { $KiokuDB::Backend::Role::TXN::Nested::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Role::TXN::Nested::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Informational role for backends supporting rollback of nested transactions. use namespace::clean -except => 'meta'; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Role::TXN::Nested - Informational role for backends supporting rollback of nested transactions. =head1 VERSION version 0.56 =head1 DESCRIPTION This role is used during testing to run fixtures testing that a rollback of a nested transaction doesn't affect its parent transaction. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Storable.pm100644001750000144 137512237006576 21260 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMap/Defaultpackage KiokuDB::TypeMap::Default::Storable; BEGIN { $KiokuDB::TypeMap::Default::Storable::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Default::Storable::VERSION = '0.56'; } use Moose; use namespace::clean -except => 'meta'; extends qw(KiokuDB::TypeMap); with qw(KiokuDB::TypeMap::Default::Passthrough); __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Default::Storable =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Expand.pm100644001750000144 325612237006576 21173 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMap/Entry/Stdpackage KiokuDB::TypeMap::Entry::Std::Expand; BEGIN { $KiokuDB::TypeMap::Entry::Std::Expand::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Entry::Std::Expand::VERSION = '0.56'; } use Moose::Role; no warnings 'recursion'; use namespace::clean -except => 'meta'; requires qw( compile_create compile_clear compile_expand_data ); sub compile_expand { my ( $self, $class, @args ) = @_; my $create = $self->compile_create($class, @args); my $expand_data = $self->compile_expand_data($class, @args); return sub { my ( $linker, $entry, @args ) = @_; my ( $instance, @register_args ) = $linker->$create($entry, @args); # this is registered *before* any other value expansion, to allow circular refs $linker->register_object( $entry => $instance, @register_args ); $linker->$expand_data($instance, $entry, @args); return $instance; }; } sub compile_refresh { my ( $self, $class, @args ) = @_; my $clear = $self->compile_clear($class, @args); my $expand_data = $self->compile_expand_data($class, @args); return sub { my ( $linker, $instance, $entry, @args ) = @_; $linker->$clear($instance, $entry, @args); $linker->$expand_data($instance, $entry, @args); }; } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Entry::Std::Expand =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Concurrency.pm100644001750000144 1332712237006576 21421 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Test/Fixturepackage KiokuDB::Test::Fixture::Concurrency; BEGIN { $KiokuDB::Test::Fixture::Concurrency::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Fixture::Concurrency::VERSION = '0.56'; } use Moose; use Test::More; use Test::Exception; use Try::Tiny; use List::Util qw(sum); use Scope::Guard; use POSIX qw(_exit :sys_wait_h); use namespace::clean -except => 'meta'; with qw(KiokuDB::Test::Fixture) => { -excludes => [qw/run required_backend_roles/] }; use constant required_backend_roles => qw(Clear TXN Concurrency::POSIX); use constant FORKS => 20; use constant COUNTERS => 250; use constant ACCOUNTS => 250; use constant ITER => 10; my @ids = qw(foo bar gorch baz); { package # hide from PAUSE Foo; use Moose; has bar => ( is => 'rw' ); } has exit => ( isa => "Int", is => "rw", default => 0, ); before precheck => sub { my $self = shift; }; sub create { return ( counter => { value => 0 }, (map { ( "counter_$_" => { value => 0 } ) } 1 .. COUNTERS ), (map { ( "${_}_account" => { value => 0 } ) } 1 .. ACCOUNTS), ); } sub run { my $self = shift; SKIP: { local $Test::Builder::Level = $Test::Builder::Level + 1; skip "Set KIOKUDB_STRESS_TEST to run this fixture", 1 unless $ENV{KIOKUDB_STRESS_TEST}; $self->precheck; lives_ok { local $Test::Builder::Level = $Test::Builder::Level - 1; $self->txn_do(sub { my $s = $self->new_scope; $self->backend->clear; $self->populate; }); } "populated OK"; $self->clear_directory; $self->verify; is_deeply( [ $self->live_objects ], [ ], "no live objects at end of " . $self->name . " fixture" ); $self->clear_live_objects; } } sub verify { my $self = shift; ok( !$self->has_directory, "no directory object" ); # force re-instantiation of directory $self->clear_directory; foreach my $num ( 1 .. FORKS ) { defined(my $pid = fork) or die $!; next if $pid; my $guard = Scope::Guard->new(sub { # avoid cleanups on errors use POSIX qw(_exit); _exit($self->exit); }); # make sure each child gets a different random seed srand($$ ^ time); $self->run_child($num); } my $skip = 0; while ( wait > 0 ) { do { $skip++ if $? } while waitpid(-1, WNOHANG) > 0; $self->check_consistency; } $self->check_counters($skip); } sub check_consistency { my $self = shift; my $ok; my ( $counter, @accounts ); attempt: foreach my $attempt ( 1 .. FORKS ) { last attempt if try { $self->txn_do(sub { my $s = $self->new_scope; $counter = $self->lookup("counter")->{value}; @accounts = map { $_->{value} } $self->lookup(map { "${_}_account" } 1 .. ACCOUNTS); }); ++$ok; }; } SKIP: { skip "lock contention", 3 unless $ok; cmp_ok( $counter, '>=', 0, "counter not 0" ); cmp_ok( $counter, '<=', FORKS, "counter <= counters" ); is( sum(@accounts), 0, "account sum is 0 (state is consistent)" ); }; } sub check_counters { my ( $self, $skip ) = @_; $self->txn_do(sub { my $s = $self->new_scope; my $counter = $self->lookup_ok("counter"); is( $counter->{value}, FORKS-$skip, "total counter value" ); my @counters = $self->lookup_ok(map { "counter_$_" } 1 .. COUNTERS); is( sum(map { $_->{value} } @counters), FORKS-$skip, "counters sum" ); }); } sub run_child { my ( $self, $child ) = @_; for ( 1 .. ITER ) { try { $self->txn_do(sub { my $s = $self->new_scope; my $id = @ids[int rand @ids]; if ( my $foo = $self->lookup($id) ) { if ( rand > 0.5 ) { $foo->bar("foo"); $self->update($foo); } else { $self->delete($foo); } } else { $self->insert( foo => Foo->new( bar => "bar" ) ); } my ( $one, $two ) = $self->lookup( map { int(rand ACCOUNTS) . "_account" } 1 .. 2 ); my $amount = int(rand 10000); $one->{value} += $amount; $two->{value} -= $amount; select(undef,undef,undef,0.01) if rand > 0.5; $self->update($one, $two); }); }; select(undef,undef,undef, 0.01); } my $ok; attempt: foreach my $attempt ( 1 .. FORKS*2 ) { last attempt if try { $self->txn_do(sub { my $s = $self->new_scope; my $counter = $self->lookup("counter"); my $counter_two = $self->lookup("counter_" . int rand COUNTERS); select(undef,undef,undef,0.02 * rand) if rand > 0.5; $counter_two->{value}++; $self->update($counter_two); $counter->{value}++; $self->update($counter); }); ++$ok; }; select(undef,undef,undef, 0.05); } $self->exit(1) unless $ok; } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Fixture::Concurrency =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut ObjectGraph.pm100644001750000144 1577712237006576 21332 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Test/Fixturepackage KiokuDB::Test::Fixture::ObjectGraph; BEGIN { $KiokuDB::Test::Fixture::ObjectGraph::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Fixture::ObjectGraph::VERSION = '0.56'; } use Moose; use Test::More; use Scalar::Util qw(weaken); use KiokuDB::Test::Person; sub p { my @args = @_; unshift @args, "name" if @args % 2; KiokuDB::Test::Person->new(@args); } sub married { my ( $a, $b, @kids ) = @_; $a->so($b); $b->so($a); foreach my $parent ( $a, $b ) { my @kids_copy = @kids; weaken($_) for @kids_copy; $parent->kids(\@kids_copy); } foreach my $child ( @kids ) { my @parents = ( $a, $b ); weaken($_) for @parents; $child->parents(\@parents); } } sub clique { my ( @buddies ) = @_; foreach my $member ( @buddies ) { my @rest = grep { $_ != $member } @buddies; $member->friends(\@rest); weaken($_) for @rest; } } use namespace::clean -except => 'meta'; with qw(KiokuDB::Test::Fixture) => { -excludes => [qw/populate sort/] }; has [qw(homer dubya putin)] => ( isa => "Str", is => "rw", ); sub sort { 100 } sub create { my $self = shift; my @r; push @r, my $bart = p("Bart Simpson"); push @r, my $lisa = p("Lisa Simpson"); push @r, my $maggie = p("Maggie Simpson"); push @r, my $marge = p("Marge Simpson"); push @r, my $homer = p("Homer Simpson"); push @r, my $grandpa = p("Abe Simpson"); push @r, my $mona = p("Mona Simpson"); push @r, my $milhouse = p("Milhouse"); push @r, my $patty = p("Patty Bouvier"); push @r, my $selma = p("Selma Bouvier"); push @r, my $jaquelin = p("Jacqueline Bouvier"); push @r, my $clancy = p("Clancy Bouvier"); married($marge, $homer, $bart, $lisa, $maggie); married($grandpa, $mona, $homer); married($jaquelin, $clancy, $marge, $selma, $patty); clique($bart, $milhouse); push @r, my $junior = p("Geroge W. Bush"); push @r, my $laura = p("Laura Bush"); push @r, my $the_drunk = p("Jenna Bush"); push @r, my $other_one = p("Barbara Pierce Bush"); push @r, my $daddy = p("George H. W. Bush"); push @r, my $barb = p("Barbara Bush"); push @r, my $jeb = p("Jeb Bush"); push @r, my $dick = p("Dick Cheney"); push @r, my $condie = p("Condoleezza Rice"); push @r, my $putin = p("Vladimir Putin"); married( $junior, $laura, $the_drunk, $other_one ); married( $daddy, $barb, $junior, $jeb ); clique( $junior, $condie, $dick ); push @{ $junior->friends }, $putin; return ( \@r, $junior, $putin, $homer ); } sub populate { my $self = shift; my $s = $self->new_scope; my ( $r, $junior, $putin, $homer, $retain ) = $self->create; my @roots = $self->store_ok( $junior, $putin, $homer ); $self->dubya($roots[0]); $self->putin($roots[1]); $self->homer($roots[2]); } sub verify { my $self = shift; $self->no_live_objects; $self->txn_lives(sub { my $junior = $self->lookup_obj_ok( $self->dubya, "KiokuDB::Test::Person" ); is( $junior->so->name, "Laura Bush", "ref to other object" ); is( $junior->so->so, $junior, "mututal ref" ); is_deeply( [ map { $_->name } @{ $junior->parents } ], [ "George H. W. Bush", "Barbara Bush" ], "ref in auxillary structure", ); is_deeply( [ grep { $_ == $junior } @{ $junior->parents->[0]->kids } ], [ $junior ], "mutual ref in auxillary structure" ); is( $junior->parents->[0]->so, $junior->parents->[1], "mutual refs in nested structure" ); is_deeply( $junior->kids->[0]->parents, [ $junior, $junior->so ], "mutual refs in nested and non nested structure", ); is_deeply( [ map { $_->name } @{ $junior->friends } ], [ "Condoleezza Rice", "Dick Cheney", "Vladimir Putin" ], "mutual refs in nested and non nested structure", ); is_deeply( $junior->friends->[-1]->friends, [], "Putin is paranoid", ); pop @{ $junior->friends }; $self->update_ok($junior); }); $self->no_live_objects(); $self->txn_lives(sub { my $junior = $self->lookup_obj_ok( $self->dubya, "KiokuDB::Test::Person" ); is_deeply( [ map { $_->name } @{ $junior->friends } ], [ "Condoleezza Rice", "Dick Cheney" ], "Georgia got plastered", ); $self->live_objects_are( $junior, $junior->so, @{ $junior->friends }, @{ $junior->kids }, @{ $junior->parents }, $junior->parents->[0]->kids->[-1], # jeb ); is( scalar(grep { /Putin/ } map { $_->name } $self->live_objects), 0, "Putin is a dead object", ); $junior->job("Warlord"); $junior->parents->[0]->job("Puppet Master"); $junior->friends->[0]->job("Secretary of State"); $junior->so->job("Prima Donna, Author, Teacher, Librarian"); $self->update_live_objects; }); $self->no_live_objects; $self->txn_lives(sub { my $homer = $self->lookup_obj_ok( $self->homer, "KiokuDB::Test::Person" ); { my $marge = $homer->so; $homer->name("Homer J. Simpson"); is( $marge->so->name, "Homer J. Simpson", "inter object rels" ); } $homer->job("Safety Inspector, Sector 7-G"); $self->update_ok($homer); }); $self->no_live_objects; $self->txn_lives(sub { my $s = $self->new_scope; my $homer = $self->lookup_obj_ok( $self->homer, "KiokuDB::Test::Person" ); is( $homer->name, "Homer J. Simpson", "name" ); }); $self->no_live_objects; $self->txn_lives(sub { my $s = $self->new_scope; my $putin = $self->lookup_obj_ok($self->putin); $self->live_objects_are( $putin ); foreach my $job ("President", "Prime Minister", "BDFL", "DFL") { $putin->job($job); $self->update_ok($putin); } }); $self->no_live_objects; $self->txn_lives(sub { my $putin = $self->lookup_obj_ok($self->putin); is( $putin->job, "DFL", "updated in storage" ); $self->delete_ok($putin); $self->deleted_ok($self->putin); is( $self->lookup($self->putin), undef, "lookup no longer returns object" ); }); $self->no_live_objects; $self->deleted_ok( $self->putin ); } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Fixture::ObjectGraph =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Memory.pm100644001750000144 200312237006576 21255 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Serializepackage KiokuDB::Backend::Serialize::Memory; BEGIN { $KiokuDB::Backend::Serialize::Memory::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Serialize::Memory::VERSION = '0.56'; } use Moose::Role; use Storable qw(dclone); use namespace::clean -except => 'meta'; with qw( KiokuDB::Backend::Serialize KiokuDB::Backend::Role::UnicodeSafe KiokuDB::Backend::Role::BinarySafe KiokuDB::Backend::TypeMap::Default::Storable ); sub serialize { my ( $self, $entry ) = @_; return dclone($entry); } sub deserialize { my ( $self, $blob ) = @_; return defined($blob) && dclone($blob); } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Serialize::Memory =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut UnicodeSafe.pm100644001750000144 240312237006576 21150 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Rolepackage KiokuDB::Backend::Role::UnicodeSafe; BEGIN { $KiokuDB::Backend::Role::UnicodeSafe::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Role::UnicodeSafe::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: An informational role for binary data safe backends. use namespace::clean -except => 'meta'; # informative __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Role::UnicodeSafe - An informational role for binary data safe backends. =head1 VERSION version 0.56 =head1 SYNOPSIS package KiokuDB::Backend::MySpecialBackend; use Moose; use namespace::clean -except => 'meta'; with qw(KiokuDB::Backend::Role::UnicodeSafe); =head1 DESCRIPTION This backend role is an informational role for backends which can store unicode perl strings safely. This means that B strings inserted to the database will not be retreived as B strings upon deserialization. This mostly has to do with L variants. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Canonical.pm100644001750000144 560512237006576 21374 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMap/Defaultpackage KiokuDB::TypeMap::Default::Canonical; BEGIN { $KiokuDB::TypeMap::Default::Canonical::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Default::Canonical::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: A KiokuDB::TypeMap::Default implementation that canonicalizes the standard types to simplified versions. use namespace::clean -except => 'meta'; with qw(KiokuDB::TypeMap::Default); sub _build_path_class_typemap { my $self = shift; $self->_create_typemap( isa_entries => { 'Path::Class::Entity' => { type => "KiokuDB::TypeMap::Entry::Callback", intrinsic => 1, collapse => "stringify", expand => "new", }, }, ); } sub _build_uri_typemap { my $self = shift; $self->_create_typemap( isa_entries => { 'URI' => { type => "KiokuDB::TypeMap::Entry::Callback", intrinsic => 1, collapse => 'as_string', expand => "new", }, }, entries => { 'URI::WithBase' => { type => "KiokuDB::TypeMap::Entry::Naive", intrinsic => 1, }, }, ); } sub _build_datetime_typemap { my $self = shift; $self->_create_typemap( isa_entries => { 'DateTime' => => { type => 'KiokuDB::TypeMap::Entry::Callback', collapse => "epoch", expand => sub { my ( $class, $epoch ) = @_; $class->from_epoch( epoch => $epoch ); }, intrinsic => 1, }, 'DateTime::Duration' => => { type => 'KiokuDB::TypeMap::Entry::Naive', intrinsic => 1, }, }, ); } sub _build_authen_passphrase_typemap { my $self = shift; $self->_create_typemap( isa_entries => { 'Authen::Passphrase' => { type => "KiokuDB::TypeMap::Entry::Callback", intrinsic => 1, collapse => "as_rfc2307", expand => "from_rfc2307", }, }, ); } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Default::Canonical - A KiokuDB::TypeMap::Default implementation that canonicalizes the standard types to simplified versions. =head1 VERSION version 0.56 =head1 DESCRIPTION This typemap is suitable for serialization using L. It stringifies or otherwise converts data structures into primitive representations. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Passthrough.pm100644001750000144 645312237006576 21533 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMap/Entrypackage KiokuDB::TypeMap::Entry::Passthrough; BEGIN { $KiokuDB::TypeMap::Entry::Passthrough::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Entry::Passthrough::VERSION = '0.56'; } use Moose; # ABSTRACT: A typemap entry of objects that will be serialized by the backend. use Carp qw(croak); use KiokuDB::TypeMap::Entry::Compiled; no warnings 'recursion'; use namespace::clean -except => 'meta'; with qw(KiokuDB::TypeMap::Entry); has intrinsic => ( isa => "Bool", is => "ro", default => 0, ); sub compile { my ( $self, $class ) = @_; if ( $self->intrinsic ) { return KiokuDB::TypeMap::Entry::Compiled->new( collapse_method => sub { $_[1] }, expand_method => sub { $_[1]->data }, # only called on an Entry, if the object is just an object, this won't be called id_method => "generate_uuid", refresh_method => sub { croak "Refreshing Passthrough typemap entries is not supported ($class)"; }, entry => $self, class => $class, ); } else { return KiokuDB::TypeMap::Entry::Compiled->new( collapse_method => sub { my ( $collapser, @args ) = @_; $collapser->collapse_first_class( sub { my ( $collapser, %args ) = @_; return $collapser->make_entry( %args, data => $args{object}, ); }, @args, ); }, expand_method => sub { my ( $linker, $entry ) = @_; my $obj = $entry->data; $linker->register_object( $entry => $obj ); return $obj; }, id_method => "generate_uuid", refresh_method => sub { croak "Refreshing Passthrough typemap entries is not supported ($class)"; }, entry => $self, class => $class, ); } } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Entry::Passthrough - A typemap entry of objects that will be serialized by the backend. =head1 VERSION version 0.56 =head1 SYNOPSIS KiokuDB::TypeMap->new( entires => { 'Value::Object' => KiokuDB::TypeMap::Entry::Naive->new, }, ); =head1 DESCRIPTION This typemap entry delegates the handling of certain objects to the backend. A prime example is L being handled by L. L has efficient L hooks, and does not refer to any domain objects, so it is safe to assume that it can just be passed through for serialization. =head1 ATTRIBUTES =over 4 =item intrinsic If true the object will be just left in place. If false, the object will get its own ID and entry, and the object will be in the C field of that entry. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut JSON000755001750000144 012237006576 17267 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMap/EntryScalar.pm100644001750000144 276112237006576 21200 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMap/Entry/JSONpackage KiokuDB::TypeMap::Entry::JSON::Scalar; BEGIN { $KiokuDB::TypeMap::Entry::JSON::Scalar::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Entry::JSON::Scalar::VERSION = '0.56'; } use Moose; no warnings 'recursion'; use namespace::clean -except => 'meta'; with qw(KiokuDB::TypeMap::Entry::Std); sub compile_collapse_body { my ( $self, $class ) = @_; return sub { my ( $collapser, %args ) = @_; my $scalar = $args{object}; my $data = $collapser->visit($$scalar); $collapser->make_entry( %args, class => "SCALAR", data => $data, ); }; } sub compile_expand { my ( $self, $reftype ) = @_; sub { my ( $linker, $entry ) = @_; my $scalar; $linker->inflate_data($entry->data, \$scalar); return \$scalar; } } sub compile_refresh { my ( $self, $class, @args ) = @_; return sub { my ( $linker, $scalar, $entry ) = @_; $linker->inflate_data($entry->data, $scalar ); return $scalar; }; } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Entry::JSON::Scalar =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Compile.pm100644001750000144 454012237006576 21341 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMap/Entry/Stdpackage KiokuDB::TypeMap::Entry::Std::Compile; BEGIN { $KiokuDB::TypeMap::Entry::Std::Compile::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Entry::Std::Compile::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Provides a compile implementation use KiokuDB::TypeMap::Entry::Compiled; use namespace::clean -except => 'meta'; requires qw( compile_collapse compile_expand compile_id compile_refresh ); sub compile { my ( $self, $class, @args ) = @_; $self->new_compiled( collapse_method => $self->compile_collapse($class, @args), expand_method => $self->compile_expand($class, @args), id_method => $self->compile_id($class, @args), refresh_method => $self->compile_refresh($class, @args), class => $class, ); } sub new_compiled { my ( $self, @args ) = @_; KiokuDB::TypeMap::Entry::Compiled->new( entry => $self, @args, ); } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Entry::Std::Compile - Provides a compile implementation =head1 VERSION version 0.56 =head1 SYNOPSIS TODO =head1 DESCRIPTION This role provides an implementation for L by breaking down its requirements into four separated methods. =head1 REQUIRED METHODS =over 4 =item compile_collapse Must return a code reference or method name. The calling conventions for this method are described in L. =item compile_expand Must return a code reference or method name. The calling conventions for this method are described in L. =item compile_id Must return a code reference or method name. The calling conventions for this method are described in L. =item compile_refresh Must return a code reference or method name. The calling conventions for this method are described in L. =back =head1 SEE ALSO L =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut SimpleSearch.pm100644001750000144 364212237006576 21465 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Test/Fixturepackage KiokuDB::Test::Fixture::SimpleSearch; BEGIN { $KiokuDB::Test::Fixture::SimpleSearch::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Fixture::SimpleSearch::VERSION = '0.56'; } use Moose; use Test::More; use Test::Moose; use KiokuDB::Test::Person; use namespace::clean -except => 'meta'; with qw(KiokuDB::Test::Fixture) => { -excludes => 'required_backend_roles' }; use constant required_backend_roles => qw(Clear Query::Simple); sub create { my $self = shift; ( map { KiokuDB::Test::Person->new(%$_) } { name => "foo", age => 3 }, { name => "bar", age => 3 }, { name => "gorch", age => 5, friends => [ KiokuDB::Test::Person->new( name => "quxx", age => 6 ) ] }, ); } before populate => sub { my $self = shift; $self->backend->clear; }; sub verify { my $self = shift; { my $s = $self->new_scope; my $res = $self->search({ name => "foo" }); does_ok( $res, "Data::Stream::Bulk" ); my @objs = $res->all; is( @objs, 1, "one object" ); is( $objs[0]->name, "foo", "name attr" ); } $self->no_live_objects; { my $s = $self->new_scope; my $res = $self->search({ age => 3 }); does_ok( $res, "Data::Stream::Bulk" ); my @objs = $res->all; is( @objs, 2, "two objects" ); @objs = sort { $a->name cmp $b->name } @objs; is( $objs[0]->name, "bar", "name attr" ); is( $objs[1]->name, "foo", "name attr" ); } } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Fixture::SimpleSearch =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Immutable000755001750000144 012237006576 16656 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/RoleTransitive.pm100644001750000144 232512237006576 21506 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Role/Immutablepackage KiokuDB::Role::Immutable::Transitive; BEGIN { $KiokuDB::Role::Immutable::Transitive::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Role::Immutable::Transitive::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: A role for immutable objects that only point at other such objects. use namespace::clean -except => 'meta'; with qw( KiokuDB::Role::Immutable KiokuDB::Role::Cacheable ); # ex: set sw=4 et: __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Role::Immutable::Transitive - A role for immutable objects that only point at other such objects. =head1 VERSION version 0.56 =head1 SYNOPSIS with qw(KiokuDB::Role::Immutable::Transitive); =head1 DESCRIPTION This role makes a stronger promise than L, namely that this object and all objects it points to are immutable. These objects can be freely cached as live instances, since none of the data they keep live is ever updated. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Simple.pm100644001750000144 364412237006576 21331 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Role/Querypackage KiokuDB::Backend::Role::Query::Simple; BEGIN { $KiokuDB::Backend::Role::Query::Simple::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Role::Query::Simple::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Simple query api use namespace::clean -except => 'meta'; requires "simple_search"; sub simple_search_filter { my ( $self, $stream, $proto ) = @_; return $stream; } # FIXME unify with Attribute, and put this in the default simple_search_filter # implementation # that way *really* lazy backends can just alias simple_search to scan and # still be feature complete even if they are retardedly slow sub compare_naive { my ( $self, $got, $exp ) = @_; foreach my $key ( keys %$exp ) { return unless overload::StrVal($got->{$key}) eq overload::StrVal($exp->{$key}); } return 1; } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Role::Query::Simple - Simple query api =head1 VERSION version 0.56 =head1 SYNOPSIS with qw(KiokuDB::Backend::Role::Query::Simple); sub simple_search { my ( $self, $proto ) = @_; # return all candidate entries in the root set matching fields in $proto return Data::Stream::Bulk::Foo->new(...); } =head1 DESCRIPTION This role requires a C method to be implemented. The method accepts one argument, the hash of the proto to search for. This is still loosely defined, but the basic functionality is based on attribute matching: $kiokudb->search({ name => "Mia" }); will search for objects whose C attribute contains the string C. More complex operations will be defined in the future. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut StorableHook.pm100644001750000144 1374312237006576 21640 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMap/Entrypackage KiokuDB::TypeMap::Entry::StorableHook; BEGIN { $KiokuDB::TypeMap::Entry::StorableHook::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Entry::StorableHook::VERSION = '0.56'; } use Moose; # ABSTRACT: Reuse existing Storable hooks for KiokuDB storage. use Scalar::Util qw(reftype); use Carp qw(croak); no warnings 'recursion'; # predeclare for namespace::clean; sub _type ($); sub _new ($;$); sub _clear ($); use namespace::clean -except => 'meta'; with qw( KiokuDB::TypeMap::Entry::Std KiokuDB::TypeMap::Entry::Std::Expand ); sub compile_collapse_body { my ( $self, $class, @args ) = @_; my $attach = $class->can("STORABLE_attach") ? 1 : 0; return sub { my ( $self, %args ) = @_; my $object = $args{object}; my @type = _type($object); my ( $str, @refs ) = $object->STORABLE_freeze(0); my $data; if ( @refs ) { croak sprintf "Freeze cannot return references if %s class is using STORABLE_attach", $class if $attach; if ( my @non_refs = grep { not ref } @refs ) { croak blessed($object) . "::STORABLE_freeze returned non reference values: @non_refs"; } my @collapsed = $self->visit(@refs); foreach my $ref ( @collapsed ) { next unless ref($ref) eq 'KiokuDB::Reference'; next if $self->may_compact($ref); $ref = $ref->id; # don't save a bunch of Reference objects when all we need is the ID } $data = [ @type, $str, @collapsed ], } else { unless ( $attach ) { if ( @type == 1 ) { $data = ( $type[0] . $str ); } else { $data = [ @type, $str ]; } } else { $data = $str; } } return $self->make_entry( %args, data => $data, ); }; } sub compile_create { my ( $self, $class, @args ) = @_; unless ( $class->can("STORABLE_attach") ) { # normal form, STORABLE_freeze return sub { my ( $self, $entry ) = @_; my $data = $entry->data; my ( $reftype, @args ) = ref $data ? @$data : ( substr($data, 0, 1), substr($data, 1) ); my $instance; if ( ref $args[0] ) { my $tied; $self->queue_ref(shift(@args), \$tied); $instance = _new( $reftype, $tied ); } else { $instance = _new( $reftype ); } bless $instance, $entry->class; }; } else { # esotheric STORABLE_attach form return sub { my ( $self, $entry ) = @_; $entry->class->STORABLE_attach( 0, $entry->data ); # FIXME support non ref }; } } sub compile_clear { my ( $self, $class, @args ) = @_; return sub { my ( $linker, $instance ) = @_; _clear($instance); }; } sub compile_expand_data { my ( $self, $class, @args ) = @_; unless ( $class->can("STORABLE_attach") ) { # normal form, STORABLE_freeze return sub { my ( $self, $instance, $entry ) = @_; my $data = $entry->data; my ( $reftype, @args ) = ref $data ? @$data : ( substr($data, 0, 1), substr($data, 1) ); shift @args if ref $args[0]; # tied my ( $str, @refs ) = @args; my @inflated; foreach my $ref ( @refs ) { push @inflated, undef; if ( ref $ref ) { $self->inflate_data($ref, \$inflated[-1]); } else { $self->queue_ref($ref, \$inflated[-1]); } } $self->queue_finalizer(sub { $instance->STORABLE_thaw( 0, $str, @inflated ); }); }; } else { # esotheric STORABLE_attach form return sub { }; } } sub _type ($) { my $obj = shift; my $type = reftype($obj); if ( $type eq 'SCALAR' or $type eq 'REF' ) { if ( my $tied = tied $$obj ) { return ( S => $tied ); } else { return 'S'; } } elsif ( $type eq 'HASH' ) { if ( my $tied = tied %$obj ) { return ( H => $tied ); } else { return 'H'; } } elsif ( $type eq 'ARRAY' ) { if ( my $tied = tied @$obj ) { return ( A => $tied ); } else { return 'A'; } } else { croak sprintf "Unexpected object type (%s)", reftype($obj); } } sub _new ($;$) { my ( $type, $tied ) = @_; if ( $type eq 'S' ) { my $ref = \( my $x ); tie $x, "To::Object", $tied if ref $tied; return $ref; } elsif ( $type eq 'H' ) { my $ref = {}; tie %$ref, "To::Object", $tied if ref $tied; return $ref; } elsif ( $type eq 'A' ) { my $ref = []; tie @$ref, "To::Object", $tied if ref $tied; return $ref; } else { croak sprintf "Unexpected object type (%d)", $type; } } sub _clear ($) { my $obj = shift; my $type = reftype($obj); if ( $type eq 'SCALAR' or $type eq 'REF' ) { undef $$obj; } elsif ( $type eq 'HASH' ) { %$obj = (); } elsif ( $type eq 'ARRAY' ) { @$obj = (); } else { croak sprintf "Unexpected object type (%s)", reftype($obj); } } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Entry::StorableHook - Reuse existing Storable hooks for KiokuDB storage. =head1 VERSION version 0.56 =head1 SYNOPSIS use KiokuDB::TypeMap::Entry::StorableHook; =head1 DESCRIPTION =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Delegate.pm100644001750000144 271512237006576 21531 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Serializepackage KiokuDB::Backend::Serialize::Delegate; BEGIN { $KiokuDB::Backend::Serialize::Delegate::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Serialize::Delegate::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Use a KiokuDB::Serializer object instead of a role to handle serialization in a backend. use KiokuDB::Serializer; use namespace::clean -except => 'meta'; #with qw(KiokuDB::Backend::Serialize); has serializer => ( does => "KiokuDB::Backend::Serialize", is => "ro", coerce => 1, default => "storable", handles => [qw(serialize deserialize)], ); __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Serialize::Delegate - Use a KiokuDB::Serializer object instead of a role to handle serialization in a backend. =head1 VERSION version 0.56 =head1 SYNOPSIS package MyBackend; use Moose; with qw( ... KiokuDB::Backend::Serialize::Delegate ); MyBackend->new( serializer => "yaml", ); =head1 DESCRIPTION This role provides a C attribute (by default L) with coercions from a moniker string for easy serialization format selection. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Storable.pm100644001750000144 371312237006576 21571 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Serializepackage KiokuDB::Backend::Serialize::Storable; BEGIN { $KiokuDB::Backend::Serialize::Storable::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Serialize::Storable::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Storable based serialization of KiokuDB::Entry objects. use Storable qw(nfreeze thaw nstore_fd fd_retrieve); use namespace::clean -except => 'meta'; with qw( KiokuDB::Backend::Serialize KiokuDB::Backend::Role::UnicodeSafe KiokuDB::Backend::Role::BinarySafe KiokuDB::Backend::TypeMap::Default::Storable ); sub serialize { my ( $self, $entry ) = @_; return nfreeze($entry); } sub deserialize { my ( $self, $blob ) = @_; return thaw($blob); } sub serialize_to_stream { my ( $self, $fh, $entry ) = @_; nstore_fd($entry, $fh); } sub deserialize_from_stream { my ( $self, $fh ) = @_; if ( $fh->eof ) { return; } else { return fd_retrieve($fh); } } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Serialize::Storable - Storable based serialization of KiokuDB::Entry objects. =head1 VERSION version 0.56 =head1 SYNOPSIS package MyBackend; with qw(KiokuDB::Backend::Serialize::Storable; =head1 DESCRIPTION This role provides L based serialization of L objects for a backend, with streaming capabilities. L is preferred to using this directly. =head1 METHODS =over 4 =item serialize $entry Uses L =item deserialize $blob Uses L =item serialize_to_stream $fh, $entry Uses L. =item deserialize_from_stream $fh Uses L. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Passthrough.pm100644001750000144 560112237006576 22010 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMap/Defaultpackage KiokuDB::TypeMap::Default::Passthrough; BEGIN { $KiokuDB::TypeMap::Default::Passthrough::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Default::Passthrough::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: A KiokuDB::TypeMap::Default instance suitable for Storable. use namespace::clean -except => 'meta'; with qw(KiokuDB::TypeMap::Default); sub _build_datetime_typemap { my $self = shift; $self->_create_typemap( isa_entries => { 'DateTime' => => { type => 'KiokuDB::TypeMap::Entry::Passthrough', intrinsic => 1, }, 'DateTime::Duration' => => { type => 'KiokuDB::TypeMap::Entry::Passthrough', intrinsic => 1, }, }, ); } sub _build_path_class_typemap { my $self = shift; $self->_create_typemap( isa_entries => { 'Path::Class::Entity' => { type => "KiokuDB::TypeMap::Entry::Passthrough", intrinsic => 1, }, }, ); } sub _build_uri_typemap { my $self = shift; $self->_create_typemap( isa_entries => { 'URI' => { type => "KiokuDB::TypeMap::Entry::Passthrough", intrinsic => 1, }, }, entries => { 'URI::WithBase' => { type => "KiokuDB::TypeMap::Entry::Passthrough", intrinsic => 1, }, }, ); } sub _build_authen_passphrase_typemap { my $self = shift; $self->_create_typemap( isa_entries => { # since Authen::Passphrase dynamically loads subcomponents based on # type, passthrough causes issues with the class not being defined # at load time unless explicitly loaded by the user. # this works around this issue #'Authen::Passphrase' => { # type => "KiokuDB::TypeMap::Entry::Passthrough", # intrinsic => 1, #}, 'Authen::Passphrase' => { type => "KiokuDB::TypeMap::Entry::Callback", intrinsic => 1, collapse => "as_rfc2307", expand => "from_rfc2307", }, }, ); } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Default::Passthrough - A KiokuDB::TypeMap::Default instance suitable for Storable. =head1 VERSION version 0.56 =head1 DESCRIPTION This typemap lets most of the default data types be passed through untouched, so that their own L hooks may be invoked. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Intrinsic.pm100644001750000144 467312237006576 21722 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/TypeMap/Entry/Stdpackage KiokuDB::TypeMap::Entry::Std::Intrinsic; BEGIN { $KiokuDB::TypeMap::Entry::Std::Intrinsic::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::TypeMap::Entry::Std::Intrinsic::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Provides a compile_collapse implementation. no warnings 'recursion'; use namespace::clean -except => 'meta'; requires qw(compile_collapse_body); has intrinsic => ( isa => "Bool", is => "ro", predicate => "has_intrinsic", ); sub should_compile_intrinsic { my ( $self, $class, @args ) = @_; return $self->intrinsic; } sub compile_collapse { my ( $self, @args ) = @_; if ( $self->should_compile_intrinsic(@args) ) { return $self->compile_intrinsic_collapse(@args); } else { return $self->compile_first_class_collapse(@args); } } sub compile_intrinsic_collapse { my ( $self, @args ) = @_; $self->compile_collapse_wrapper( collapse_intrinsic => @args ); } sub compile_first_class_collapse { my ( $self, @args ) = @_; $self->compile_collapse_wrapper( collapse_first_class => @args ); } sub compile_collapse_wrapper { my ( $self, $method, $class, @args ) = @_; my ( $body, @extra ) = $self->compile_collapse_body($class, @args); return sub { my ( $collapser, $obj, @args ) = @_; $collapser->$method( $body, $obj, @extra, @args ); } } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::TypeMap::Entry::Std::Intrinsic - Provides a compile_collapse implementation. =head1 VERSION version 0.56 =head1 SYNOPSIS TODO =head1 DESCRIPTION This role provides a compile_collapse implementation by breaking it down and requiring the implementation of a 'compile_collapse_body' method. =head1 REQUIRED METHODS =over 4 =item compile_collapse_body Must return a code reference or a method name. The method is called on the L, with a hash of parameters. The parameters can include (but are not limited to) the following: =over 8 =item object The object to collapse. =item id The id under which the object is to be stored. =item class The type of C. =back The method should return a L object. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Handlers000755001750000144 012237006576 20066 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Role/UpgradeTable.pm100644001750000144 305012237006576 21611 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Role/Upgrade/Handlerspackage KiokuDB::Role::Upgrade::Handlers::Table; BEGIN { $KiokuDB::Role::Upgrade::Handlers::Table::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Role::Upgrade::Handlers::Table::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: A role for classes use namespace::clean; with qw(KiokuDB::Role::Upgrade::Handlers); requires "kiokudb_upgrade_handlers_table"; no warnings 'uninitialized'; sub kiokudb_upgrade_handler { my ( $class, $version ) = @_; my $table = $class->kiokudb_upgrade_handlers_table; return grep { defined } $table->{$version}; } # ex: set sw=4 et: __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Role::Upgrade::Handlers::Table - A role for classes =head1 VERSION version 0.56 =head1 SYNOPSIS with qw(KiokuDB::Role::Upgrade::Handlers::Table); use constant kiokudb_upgrade_handlers_table => { # like the individual entries in class_version_table "0.01" => "0.02", "0.02" => sub { ... }, }; =head1 DESCRIPTION This class lets you provide the version handling table as part of the class definition, instead of as arguments to the L handle constructor. See L more details and L for a lower level alternative. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut TypeMap000755001750000144 012237006576 17762 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Test/FixtureDefault.pm100644001750000144 2262612237006576 22074 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Test/Fixture/TypeMapuse utf8; package KiokuDB::Test::Fixture::TypeMap::Default; BEGIN { $KiokuDB::Test::Fixture::TypeMap::Default::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Test::Fixture::TypeMap::Default::VERSION = '0.56'; } use Moose; use Encode; use Test::More; use Test::Moose; use Try::Tiny; use KiokuDB::Test::Person; use KiokuDB::Test::Employee; use KiokuDB::Test::Company; use namespace::clean -except => 'meta'; use constant required_backend_roles => qw(TypeMap::Default); use Tie::RefHash; use constant HAVE_DATETIME => try { require DateTime }; use constant HAVE_DATETIME_FMT => try { require DateTime::Format::Strptime }; use constant HAVE_URI => try { require URI }; use constant HAVE_URI_WITH_BASE => try { require URI::WithBase }; use constant HAVE_AUTHEN_PASSPHRASE => try { require Authen::Passphrase::SaltedDigest }; use constant HAVE_PATH_CLASS => try { require Path::Class }; use constant HAVE_IXHASH => try { require Tie::IxHash }; use constant HAVE_MX_TRAITS => try { require MooseX::Traits }; use constant HAVE_MX_OP => try { require MooseX::Object::Pluggable }; { package Some::Role; use Moose::Role; has role_attr => ( is => "rw" ); package Some::Other::Role; use Moose::Role; has other_role_attr => ( is => "rw" ); package Some::Third::Role; use Moose::Role; sub a_role_method { "hello" } package Some::Class; use Moose; if ( KiokuDB::Test::Fixture::TypeMap::Default::HAVE_MX_TRAITS ) { with qw(MooseX::Traits); } if ( KiokuDB::Test::Fixture::TypeMap::Default::HAVE_MX_OP ) { with qw(MooseX::Object::Pluggable); } has name => ( is => "rw" ); } with qw(KiokuDB::Test::Fixture) => { -excludes => 'required_backend_roles' }; sub create { tie my %refhash, 'Tie::RefHash'; $refhash{["foo"]} = "bar"; $refhash{"blah"} = "oink"; my %ixhash; tie %ixhash, 'Tie::IxHash' if HAVE_IXHASH; %ixhash = ( first => 1, second => "yes", third => "maybe", fourth => "a charm" ); my $homer = KiokuDB::Test::Employee->new( name => "Homer Simpson", company => KiokuDB::Test::Company->new( name => "Springfield Power Plant", ), ); Some::Role->meta->apply($homer); $homer->role_attr("foo"); my $foo = "blah"; my @x = ( 1 ); return ( scalar => \$foo, refhash => \%refhash, coderef => sub { $x[0]++; }, HAVE_IXHASH ? ( ixhash => \%ixhash ) : (), HAVE_DATETIME ? ( datetime => { obj => DateTime->now } ) : (), HAVE_DATETIME_FMT ? ( datetime_fmt => { obj => DateTime->now(formatter => DateTime::Format::Strptime->new( pattern => '%F' ) ) } ) : (), HAVE_PATH_CLASS ? ( path_class => { obj => Path::Class::file('bar', 'foo.txt') } ) : (), HAVE_URI ? ( uri => { obj => URI->new('http://www.google.com/') } ) : (), HAVE_URI_WITH_BASE ? ( with_base => { obj => URI::WithBase->new( URI->new('foo'), URI->new('http://www.google.com/') ), }, ) : (), HAVE_AUTHEN_PASSPHRASE ? ( passphrase => { obj => Authen::Passphrase::SaltedDigest->new( algorithm => "SHA-1", salt_random => 20, passphrase => "passphrase" ), }, ) : (), HAVE_MX_TRAITS ? ( traits => { obj => Some::Class->new_with_traits( traits => [qw(Some::Other::Role Some::Third::Role)], name => "blah", other_role_attr => "foo", ), }, ) : (), HAVE_MX_OP ? ( op_one => do { my $obj = Some::Class->new( name => "first" ); $obj->load_plugin("+Some::Other::Role"); $obj->other_role_attr("after"); $obj; }, op_two => do { my $obj = Some::Class->new( name => "second" ); $obj->load_plugin("+Some::Other::Role"); $obj->other_role_attr("after"); $obj->load_plugin("+Some::Third::Role"); $obj; }, ) : (), homer => $homer, ); } sub verify { my $self = shift; { my $s = $self->new_scope; my $scalar = $self->lookup_ok("scalar"); is( ref($scalar), "SCALAR", "reftype for scalar" ); is( $$scalar, "blah", "value" ); } $self->no_live_objects; { my $s = $self->new_scope; my $rh = $self->lookup_ok("refhash"); is( ref($rh), "HASH", "plain hash" ); isa_ok( tied(%$rh), "Tie::RefHash", "tied" ); is_deeply( [ sort { ref($a) ? -1 : ( ref($b) ? 1 : ( $a cmp $b ) ) } keys %$rh ], [ ["foo"], "blah" ], "keys" ); } $self->no_live_objects; { my $s = $self->new_scope; my $c = $self->lookup_ok("coderef"); is( ref($c), "CODE", "coderef" ); is( $c->(), 1, "invoke closure" ); is( $c->(), 2, "invoke closure" ); } $self->no_live_objects; { my $s = $self->new_scope; my $c = $self->lookup_ok("coderef"); is( ref($c), "CODE", "coderef" ); is( $c->(), 1, "invoke closure" ); is( $c->(), 2, "invoke closure" ); $self->store_ok($c); } $self->no_live_objects; { my $s = $self->new_scope; my $c = $self->lookup_ok("coderef"); is( ref($c), "CODE", "coderef" ); is( $c->(), 3, "closure updated" ); } $self->no_live_objects; { my $s = $self->new_scope; my $homer = $self->lookup_ok("homer"); isa_ok( $homer, "KiokuDB::Test::Person" ); is( $homer->name, "Homer Simpson", "class attr" ); does_ok( $homer, "Some::Role", "does runtime role" ); is( $homer->role_attr, "foo", "role attr" ); ok( $homer->meta->is_anon_class, "anon class" ); isa_ok( $homer->company, "KiokuDB::Test::Company" ); undef $homer; } if ( HAVE_IXHASH ) { $self->no_live_objects; my $s = $self->new_scope; my $ix = $self->lookup_ok("ixhash"); is( ref($ix), "HASH", "plain hash" ); isa_ok( tied(%$ix), "Tie::IxHash", "tied" ); is_deeply( [ keys %$ix ], [ qw(first second third fourth) ], "key order preserved" ); } if ( HAVE_DATETIME ) { $self->no_live_objects; my $s = $self->new_scope; my $date = $self->lookup_ok("datetime")->{obj}; isa_ok( $date, "DateTime" ); } if ( HAVE_DATETIME_FMT ) { $self->no_live_objects; my $s = $self->new_scope; my $date = $self->lookup_ok("datetime_fmt")->{obj}; isa_ok( $date, "DateTime" ); SKIP: { skip "Not possible with JSON atm", 1 if ( ( $self->directory->backend->can("serializer") and $self->directory->backend->serializer->isa('KiokuDB::Serializer::JSON') ) or $self->directory->backend->does("KiokuDB::Backend::Serialize::JSON") or $self->directory->backend->does("KiokuDB::Backend::Serialize::JSPON") ); isa_ok( $date->formatter, "DateTime::Format::Strptime" ); } } if ( HAVE_URI ) { $self->no_live_objects; my $s = $self->new_scope; my $uri = $self->lookup_ok("uri")->{obj}; isa_ok( $uri, "URI" ); is( "$uri", "http://www.google.com/", "uri" ); } if ( HAVE_URI_WITH_BASE ) { $self->no_live_objects; my $s = $self->new_scope; my $uri = $self->lookup_ok("with_base")->{obj}; isa_ok( $uri, "URI::WithBase" ); isa_ok( $uri->base, "URI" ); } if ( HAVE_PATH_CLASS ) { $self->no_live_objects; my $s = $self->new_scope; my $file = $self->lookup_ok("path_class")->{obj}; isa_ok( $file, "Path::Class::Entity" ); isa_ok( $file, "Path::Class::File" ); is( $file->basename, "foo.txt", "basename" ); } if ( HAVE_MX_TRAITS ) { $self->no_live_objects; my $s = $self->new_scope; my $obj = $self->lookup_ok("traits")->{obj}; does_ok( $obj, "Some::Other::Role" ); does_ok( $obj, "Some::Third::Role" ); is( $obj->other_role_attr, "foo", "trait attr" ); is( $obj->name, "blah", "normal attr" ); } if ( HAVE_MX_OP ) { $self->no_live_objects; my $s = $self->new_scope; my $one = $self->lookup_ok("op_one"); does_ok( $one, "Some::Other::Role" ); is( $one->other_role_attr, "after", "role attr" ); my $two = $self->lookup_ok("op_two"); does_ok( $two, "Some::Other::Role" ); does_ok( $two, "Some::Third::Role" ); is( eval { $two->other_role_attr }, "after", "role attr" ); } } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Test::Fixture::TypeMap::Default =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Default000755001750000144 012237006576 20330 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/TypeMapJSON.pm100644001750000144 152312237006576 21600 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/TypeMap/Defaultpackage KiokuDB::Backend::TypeMap::Default::JSON; BEGIN { $KiokuDB::Backend::TypeMap::Default::JSON::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::TypeMap::Default::JSON::VERSION = '0.56'; } use Moose::Role; use KiokuDB::TypeMap::Default::JSON; use namespace::clean -except => 'meta'; with qw(KiokuDB::Backend::TypeMap::Default); sub _build_default_typemap { # FIXME options KiokuDB::TypeMap::Default::JSON->new } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::TypeMap::Default::JSON =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Memory000755001750000144 012237006576 20207 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Role/TXNScan.pm100644001750000144 425212237006576 21574 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Role/TXN/Memorypackage KiokuDB::Backend::Role::TXN::Memory::Scan; BEGIN { $KiokuDB::Backend::Role::TXN::Memory::Scan::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Role::TXN::Memory::Scan::VERSION = '0.56'; } use Moose::Role; use Data::Stream::Bulk::Util qw(bulk); use namespace::clean -except => 'meta'; with qw( KiokuDB::Backend::Role::TXN::Memory KiokuDB::Backend::Role::Clear KiokuDB::Backend::Role::Scan ); requires qw( all_storage_entries clear_storage ); sub clear { my $self = shift; if ( @{ $self->_txn_stack } ) { %{ $self->_txn_stack->[-1] } = ( %{ $self->_new_frame }, cleared => 1 ); } else { $self->clear_storage; } } sub all_entries { my $self = shift; my $stack = $self->_txn_stack; if ( @$stack ) { my $frame = $stack->[-1]; my $flat = $self->_collapsed_txn_stack; my $live = bulk(grep { not $_->deleted } values %{ $flat->{live} }); if ( $flat->{cleared} ) { # return all the inserted entries since the clear return $live; } else { my $all = $self->all_storage_entries; # create a filter for all the IDs that have been either deleted or superseded in the transaction frame my %mask; @mask{ keys %{ $flat->{live} } } = (); my $shadowed = keys %mask ? $all->filter(sub {[ grep { not exists $mask{$_->id} } @$_ ]}) : $all; # make note of all read entries in the transaction frame my $noted_shadowed = $shadowed->filter(sub { @{ $frame->{live} }{ map { $_->id } @$_ } = @$_; return $_; }); return $live->cat($noted_shadowed); } } else { return $self->all_storage_entries; } } # ex: set sw=4 et: __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Role::TXN::Memory::Scan =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DoNotSerialize.pm100644001750000144 254512237006576 22266 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Meta/Attributepackage KiokuDB::Meta::Attribute::DoNotSerialize; BEGIN { $KiokuDB::Meta::Attribute::DoNotSerialize::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Meta::Attribute::DoNotSerialize::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Trait for skipped attributes use Moose::Util qw(does_role); use namespace::clean -except => 'meta'; sub Moose::Meta::Attribute::Custom::Trait::KiokuDB::DoNotSerialize::register_implementation { __PACKAGE__ } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Meta::Attribute::DoNotSerialize - Trait for skipped attributes =head1 VERSION version 0.56 =head1 SYNOPSIS # in your class: package Foo; use Moose; has bar => ( traits => [qw(KiokuDB::DoNotSerialize)], isa => "Bar", is => "ro", lazy_build => 1, ); =head1 DESCRIPTION This L trait provides tells L to skip an attribute when serializing. L also recognizes L, but if you don't want to install L you can use this instead. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Concurrency000755001750000144 012237006576 20560 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/RolePOSIX.pm100644001750000144 125512237006576 22163 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Role/Concurrencypackage KiokuDB::Backend::Role::Concurrency::POSIX; BEGIN { $KiokuDB::Backend::Role::Concurrency::POSIX::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Role::Concurrency::POSIX::VERSION = '0.56'; } use Moose::Role; use namespace::clean -except => 'meta'; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Role::Concurrency::POSIX =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut JSPON000755001750000144 012237006576 20205 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/SerializeExpander.pm100644001750000144 1604612237006576 22500 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Serialize/JSPONpackage KiokuDB::Backend::Serialize::JSPON::Expander; BEGIN { $KiokuDB::Backend::Serialize::JSPON::Expander::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Serialize::JSPON::Expander::VERSION = '0.56'; } use Moose; # ABSTRACT: Inflate JSPON to entry data. use Carp qw(croak); use Scalar::Util qw(weaken); use KiokuDB::Entry; use KiokuDB::Reference; use namespace::clean -except => 'meta'; with qw(KiokuDB::Backend::Serialize::JSPON::Converter); sub expand_jspon { my ( $self, $data, @attrs ) = @_; return $self->_expander->($data, @attrs); } has _expander => ( isa => "CodeRef", is => "ro", lazy_build => 1, ); sub _build__expander { my $self = shift; my $expander; my ( $ref_field, $id_field, $data_field, $class_field, $tied_field, $root_field, $deleted_field, $class_meta_field, $class_version_field, $backend_data_field ) = map { my $m = $_ . "_field"; $self->$m() } qw(ref id data class tied root deleted class_meta class_version backend_data); unless ( $self->inline_data ) { my $data_field_re = qr/\. \Q$data_field\E $/x; $expander = sub { my ( $data, @attrs ) = @_; if ( my $ref = ref($data) ) { if ( $ref eq 'HASH' ) { if ( my $id = $data->{$ref_field} ) { $id =~ s/$data_field_re//; return KiokuDB::Reference->new( id => $id, ( $data->{weak} ? ( is_weak => 1 ) : () ) ); } elsif ( exists $data->{$class_field} or exists $data->{$id_field} or exists $data->{$tied_field} ) { if ( exists $data->{$class_field} ) { # check the class more thoroughly here ... my ($class, $version, $authority) = (split '-' => $data->{$class_field}); push @attrs, class => $class; push @attrs, class_meta => $data->{$class_meta_field} if exists $data->{$class_meta_field}; push @attrs, class_version => $data->{$class_version_field} if exists $data->{$class_version_field}; } push @attrs, id => $data->{$id_field} if exists $data->{$id_field}; push @attrs, tied => substr($data->{$tied_field}, 0, 1) if exists $data->{$tied_field}; push @attrs, root => $data->{$root_field} ? 1 : 0 if exists $data->{$root_field}; push @attrs, deleted => $data->{$deleted_field} ? 1 : 0 if exists $data->{$deleted_field}; push @attrs, backend_data => $data->{$backend_data_field} if exists $data->{$backend_data_field}; push @attrs, data => $expander->( $data->{$data_field} ); return KiokuDB::Entry->new( @attrs ); } else { my %hash; foreach my $key ( keys %$data ) { my $unescaped = $key; $unescaped =~ s/^public:://; my $value = $data->{$key}; $hash{$unescaped} = ref($value) ? $expander->($value) : $value; } return \%hash; } } elsif ( ref $data eq 'ARRAY' ) { return [ map { ref($_) ? $expander->($_) : $_ } @$data ]; } } return $data; } } else { $expander = sub { my ( $data, @attrs ) = @_; if ( my $ref = ref($data) ) { if ( $ref eq 'HASH' ) { if ( my $id = $data->{$ref_field} ) { return KiokuDB::Reference->new( id => $id, ( $data->{weak} ? ( is_weak => 1 ) : () ) ); } elsif ( exists $data->{$class_field} or exists $data->{$id_field} or exists $data->{$tied_field} ) { my %copy = %$data; if ( exists $copy{$class_field} ) { # check the class more thoroughly here ... my ($class, $version, $authority) = (split '-' => delete $copy{$class_field}); push @attrs, class => $class; push @attrs, class_meta => delete $copy{$class_meta_field} if exists $copy{$class_meta_field}; } push @attrs, id => delete $copy{$id_field} if exists $copy{$id_field}; push @attrs, tied => delete $copy{$tied_field} if exists $copy{$tied_field}; push @attrs, root => delete $copy{$root_field} ? 1 : 0 if exists $copy{$root_field}; push @attrs, deleted => delete $copy{$deleted_field} ? 1 : 0 if exists $copy{$deleted_field}; push @attrs, data => $expander->( \%copy ); return KiokuDB::Entry->new( @attrs ); } else { my %hash; foreach my $key ( keys %$data ) { my $unescaped = $key; $unescaped =~ s/^public:://; my $value = $data->{$key}; $hash{$unescaped} = ref($value) ? $expander->($value) : $value; } return \%hash; } } elsif ( ref $data eq 'ARRAY' ) { return [ map { ref($_) ? $expander->($_) : $_ } @$data ]; } } return $data; } } my $copy = $expander; weaken($expander); return $copy; } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Serialize::JSPON::Expander - Inflate JSPON to entry data. =head1 VERSION version 0.56 =head1 SYNOPSIS my $c = KiokuDB::Backend::Serialize::JSPON::Expander->new( id_field => "_id", ); my $entry = $c->collapse_jspon($hashref); =head1 DESCRIPTION This object is used by L to expand JSPON compliant hash references to L objects. =head1 ATTRIBUTES See L for attributes shared by L and L. =head1 METHODS =over 4 =item expand_jspon $hashref Recursively inflates the hash reference, returning a L object. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Storable.pm100644001750000144 155312237006576 22605 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/TypeMap/Defaultpackage KiokuDB::Backend::TypeMap::Default::Storable; BEGIN { $KiokuDB::Backend::TypeMap::Default::Storable::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::TypeMap::Default::Storable::VERSION = '0.56'; } use Moose::Role; use KiokuDB::TypeMap::Default::Storable; use namespace::clean -except => 'meta'; with qw(KiokuDB::Backend::TypeMap::Default); sub _build_default_typemap { # FIXME options KiokuDB::TypeMap::Default::Storable->new } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::TypeMap::Default::Storable =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Simple000755001750000144 012237006576 20624 5ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Role/QueryLinear.pm100644001750000144 321012237006576 22530 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Role/Query/Simplepackage KiokuDB::Backend::Role::Query::Simple::Linear; BEGIN { $KiokuDB::Backend::Role::Query::Simple::Linear::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Role::Query::Simple::Linear::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Query::Simple implemented with a linear scan of all entries. use namespace::clean -except => 'meta'; with qw(KiokuDB::Backend::Role::Query::Simple); requires "root_entries"; sub simple_search { my ( $self, $proto ) = @_; # FIXME $proto is sql::abstract 2? or...? my $root_set = $self->root_entries; return $root_set->filter(sub { return [ grep { my $entry = $_; $self->compare_naive($entry->data, $proto); } @$_ ] }); } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Role::Query::Simple::Linear - Query::Simple implemented with a linear scan of all entries. =head1 VERSION version 0.56 =head1 SYNOPSIS package MyBackend; use Moose; with qw( KiokuDB::Backend::Role::Scan KiokuDB::Backend::Role::Query::Simple::Linear ); =head1 DESCRIPTION This role can provide a primitive C facility (the API described in L) using the api provided by L. While very inefficient for large data sets, of your databases are small this can be useful. =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Collapser.pm100644001750000144 761412237006576 22637 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Serialize/JSPONpackage KiokuDB::Backend::Serialize::JSPON::Collapser; BEGIN { $KiokuDB::Backend::Serialize::JSPON::Collapser::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Serialize::JSPON::Collapser::VERSION = '0.56'; } use Moose; # ABSTRACT: Collapse entry data to JSPON compliant structures use KiokuDB::Entry; use KiokuDB::Reference; use JSON::XS 2.231 (); use JSON 2.12; use namespace::clean -except => 'meta'; with qw(KiokuDB::Backend::Serialize::JSPON::Converter); has reserved_key => ( isa => "RegexpRef", is => "ro", lazy_build => 1, ); sub _build_reserved_key { my $self = shift; my $reserved = '^(?:' . join("|", map { quotemeta($self->$_) } map { $_ . "_field" } $self->_jspon_fields) . ')$'; qr/(?: $reserved | ^public:: )/x } sub collapse_jspon { my ( $self, $data ) = @_; if ( my $ref = ref $data ) { if ( $ref eq 'KiokuDB::Reference' ) { return { $self->ref_field => $data->id . ( $self->inline_data ? "" : "." . $self->data_field ), ( $data->is_weak ? ( weak => 1 ) : () ), }; } elsif ( $ref eq 'KiokuDB::Entry' ) { my $id = $data->id; return { ( $data->has_class ? ( $self->class_field => $data->class ) : () ), ( $data->has_class_meta ? ( $self->class_meta_field => $data->class_meta ) : () ), ( defined $data->class_version ? ( $self->class_version_field => $data->class_version ) : () ), ( $id ? ( $self->id_field => $id ) : () ), ( $data->root ? ( $self->root_field => JSON::true() ) : () ), ( $data->deleted ? ( $self->deleted_field => JSON::true() ) : () ), ( $data->has_tied ? ( $self->tied_field => $data->tied ) : () ), ( defined $data->backend_data ? ( $self->backend_data_field => $data->backend_data ) : () ), ( $self->inline_data ? %{ $self->collapse_jspon($data->data) } : ( $self->data_field => $self->collapse_jspon($data->data) ) ), }; } elsif ( $ref eq 'HASH' ) { my %hash; my $res = $self->reserved_key; foreach my $key ( keys %$data ) { my $value = $data->{$key}; my $collapsed = ref($value) ? $self->collapse_jspon($value) : $value; if ( $key =~ $res ) { $hash{"public::$key"} = $collapsed; } else { $hash{$key} = $collapsed; } } return \%hash; } elsif ( $ref eq 'ARRAY' ) { return [ map { ref($_) ? $self->collapse_jspon($_) : $_ } @$data ]; } } return $data; } __PACKAGE__->meta->make_immutable; __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Serialize::JSPON::Collapser - Collapse entry data to JSPON compliant structures =head1 VERSION version 0.56 =head1 SYNOPSIS my $c = KiokuDB::Backend::Serialize::JSPON::Collapser->new( id_field => "_id", ); my $hashref = $c->collapse_jspon($entry); =head1 DESCRIPTION This object is used by L to convert L objects to JSPON compliant structures. =head1 ATTRIBUTES See L for attributes shared by L and L. =head1 METHODS =over 4 =item collapse_jspon $entry Collapses the entry recursively, returning a JSPON compliant data structure suitable for serialization as a JSON string. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Converter.pm100644001750000144 651112237006576 22655 0ustar00doyusers000000000000KiokuDB-0.56/lib/KiokuDB/Backend/Serialize/JSPONpackage KiokuDB::Backend::Serialize::JSPON::Converter; BEGIN { $KiokuDB::Backend::Serialize::JSPON::Converter::AUTHORITY = 'cpan:NUFFIN'; } { $KiokuDB::Backend::Serialize::JSPON::Converter::VERSION = '0.56'; } use Moose::Role; # ABSTRACT: Common functionality for JSPON expansion/collapsing use namespace::clean -except => 'meta'; sub _jspon_fields { return qw( id class class_meta class_version root deleted tied ref data backend_data ); } has id_field => ( isa => "Str", is => "ro", default => "id", ); has class_field => ( isa => "Str", is => "ro", default => "__CLASS__", ); has class_meta_field => ( isa => "Str", is => "ro", default => "__META__", ); has class_version_field => ( isa => "Str", is => "ro", default => "__VERSION__", ); has root_field => ( isa => "Str", is => "ro", default => "root", ); has deleted_field => ( isa => "Str", is => "ro", default => "deleted", ); has tied_field => ( isa => "Str", is => "ro", default => "tied", ); has ref_field => ( isa => "Str", is => "ro", default => '$ref', ); has data_field => ( isa => "Str", is => "ro", default => "data", ); has backend_data_field => ( isa => "Str", is => "ro", default => "backend_data", ); has inline_data => ( isa => "Bool", is => "ro", default => 0, ); # kinda ugly, used to pass options down to expander/collapser from backend has _jspon_params => ( isa => "HashRef", is => "ro", lazy_build => 1, ); sub _build__jspon_params { my $self = shift; return { ( map { my $name = "${_}_field"; $name => $self->$name } $self->_jspon_fields, ), ( inline_data => $self->inline_data ? 1 : 0 ), }; } __PACKAGE__ __END__ =pod =head1 NAME KiokuDB::Backend::Serialize::JSPON::Converter - Common functionality for JSPON expansion/collapsing =head1 VERSION version 0.56 =head1 SYNOPSIS # internal =head1 DESCRIPTION These attributes are shared by both L and L. These attributes are also available in L and passed to the constructors of the expander and the collapser. =head1 ATTRIBUTES =over 4 =item id_field =item class_field =item class_meta_field =item root_field =item deleted_field =item tied_field =item data_field =item ref_field The various field name mappings for the L attributes. Everything defaults to the attribute name, except C and C which default to C<__CLASS__> and C<__META__> for compatibility with L when C is set, and C which is set to C<$ref> according to the JSPON spec. =item inline_data Determines whether or not the entry data keys are escaped and the data is stored in the same top level mapping, or inside the C key. =back =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut KiokuDB000755001750000144 012237006576 22306 5ustar00doyusers000000000000KiokuDB-0.56/lib/Moose/Meta/Attribute/Custom/TraitLazy.pm100644001750000144 127512237006576 23730 0ustar00doyusers000000000000KiokuDB-0.56/lib/Moose/Meta/Attribute/Custom/Trait/KiokuDBpackage Moose::Meta::Attribute::Custom::Trait::KiokuDB::Lazy; BEGIN { $Moose::Meta::Attribute::Custom::Trait::KiokuDB::Lazy::AUTHORITY = 'cpan:NUFFIN'; } { $Moose::Meta::Attribute::Custom::Trait::KiokuDB::Lazy::VERSION = '0.56'; } use KiokuDB::Meta::Attribute::Lazy; __PACKAGE__ __END__ =pod =head1 NAME Moose::Meta::Attribute::Custom::Trait::KiokuDB::Lazy =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DoNotSerialize.pm100644001750000144 135712237006576 25705 0ustar00doyusers000000000000KiokuDB-0.56/lib/Moose/Meta/Attribute/Custom/Trait/KiokuDBpackage Moose::Meta::Attribute::Custom::Trait::KiokuDB::DoNotSerialize; BEGIN { $Moose::Meta::Attribute::Custom::Trait::KiokuDB::DoNotSerialize::AUTHORITY = 'cpan:NUFFIN'; } { $Moose::Meta::Attribute::Custom::Trait::KiokuDB::DoNotSerialize::VERSION = '0.56'; } use KiokuDB::Meta::Attribute::DoNotSerialize; __PACKAGE__ __END__ =pod =head1 NAME Moose::Meta::Attribute::Custom::Trait::KiokuDB::DoNotSerialize =head1 VERSION version 0.56 =head1 AUTHOR Yuval Kogman =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Yuval Kogman, Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut