Metabase-Fact-0.025/000755 000765 000024 00000000000 12664742761 014365 5ustar00davidstaff000000 000000 Metabase-Fact-0.025/bin/000755 000765 000024 00000000000 12664742761 015135 5ustar00davidstaff000000 000000 Metabase-Fact-0.025/Changes000644 000765 000024 00000007555 12664742761 015674 0ustar00davidstaff000000 000000 Revision history for Metabase-Fact 0.025 2016-02-28 23:15:39-05:00 America/New_York [PREREQS] - Changed from JSON to JSON::MaybeXS to insulate this module from upstream volatility. 0.024 2014-02-13 14:30:03-05:00 America/New_York [CHANGED] - Dropped use of Test::Exceptions in favor of Test::Fatal (Karen Etheridge) 0.023 2013-09-25 13:53:13 America/New_York [FIXED] - Compile test could hang on Windows [PREREQS] - Dropped configure_requires for ExtUtils::MakeMaker to 6.17 0.022 2013-09-11 09:30:13 America/New_York [FIXED] - metabase-profile now prompts with IO::Prompt::Tiny to fix some hanging bug on Win32 0.021 2012-02-14 14:47:54 EST5EDT - Fixed generated NAME Pod section for metabase-profile [rt.cpan.org #62436; patch by Randy Stauner] - Fixed various spelling errors in Pod 0.020 2011-07-14 22:53:39 America/New_York - Document limitations on content and resource metadata field names 0.019 2010-10-11 00:02:19 EST5EDT - Fix failing t/profile.t for CPAN build paths with spaces (RT#59580) [Reini Urban] 0.018 2010-09-01 18:22:44 EST5EDT - Improve diagnostics when JSON decoding fails 0.017 2010-08-14 16:08:05 EST5EDT - Refactor save() and load() to use new as_json() and to_json() method. Persistence is now possible to/from file, string, or unblessed data structure. - Loads any necessary class during as_struct() for improved flexibility 0.016 2010-07-07 22:03:14 EST5EDT - Removing 'use base' throughout to attempt to squash some heisenbugs 0.015 2010-07-07 11:49:30 EST5EDT - Identical to 0.014 (which was intentionally not released to CPAN to test a Dist::Zilla upgrade) 0.014 2010-07-07 11:45:42 EST5EDT - Ensure metabase-profile gets installed (it was lost due to a stale dist.ini) - Make use of utf8::encode/decode conditional on 5.008 0.013 2010-04-19 20:49:18 EST5EDT - Weaken validation of keys in Metabase::Fact::Hash. They must exist, but may be undefined or zero length (suggested by H.Merijn Brand) - Added documentation of the full_url() method for Metabase::Resource::perl::commit 0.012 2010-04-11 13:41:15 America/New_York - Added Metabase::Resource::perl (contributed by H.Merijn Brand) 0.011 2010-03-29 08:04:26 EST5EDT - Whoops. Fix broken tests. 0.010 2010-03-29 07:59:34 EST5EDT - Whoops. Fix serialization of JSON in bin/metabase-profile, too - Add a wide character to profile test 0.009 2010-03-29 07:49:11 EST5EDT - Fix serialization to ensure ASCII JSON 0.008 2010-03-23 18:54:21 EST5EDT - Fixed failing tests on 5.6.1 due to problems in overloaded stringification of Metabase::Resource [Ricardo Signes, Apocalypse] - Converted to Dist::Zilla for release management - Changed to the Apache License, version 2.0; (it's clearer, relicensable, and is explicit about contributions) 0.007 Fri Mar 19 07:51:07 EDT 2010 - Remove dependency on Time::Piece 0.006 Mon Mar 15 02:25:46 EDT 2010 - Fix bug in Metabase::Resource::cpan::distfile that prevents compatibility on Perl before 5.10 0.005 Sun Mar 14 19:20:05 EDT 2010 - Remove Encode as a dependency and use utf8::encode/decode instead [suggested by Ricardo Signes] 0.004 Sun Mar 14 09:44:02 EDT 2010 - Downgrade numerous prereqs 0.003002 Thu Mar 11 18:47:54 EST 2010 - Worked around testing bug on bleadperl involving Test::Exception and throws_ok - Fixed docs for Metabase::Resource methods 0.003001 - fixed bug in guid creation and testing 0.003 - heavily revised for CPAN Testers 2.0 effort - Added Metabase::Resouce classes and subclasses - Revised Metabase::User::Profile and Secret 0.002 (never released) - private development version, never released to CPAN 0.001 2009-06-24 - "YAPC::NA::2009, Pittsburgh" Release # vim: ts=2 sts=2 sw=2 et: Metabase-Fact-0.025/CONTRIBUTING.mkdn000644 000765 000024 00000006604 12664742761 017155 0ustar00davidstaff000000 000000 ## HOW TO CONTRIBUTE Thank you for considering contributing to this distribution. This file contains instructions that will help you work with the source code. The distribution is managed with Dist::Zilla. This means that many of the usual files you might expect are not in the repository, but are generated at release time, as is much of the documentation. Some generated files are kept in the repository as a convenience (e.g. Makefile.PL or cpanfile). Generally, **you do not need Dist::Zilla to contribute patches**. You do need Dist::Zilla to create a tarball. See below for guidance. ### Getting dependencies If you have App::cpanminus 1.6 or later installed, you can use `cpanm` to satisfy dependencies like this: $ cpanm --installdeps . Otherwise, look for either a `Makefile.PL` or `cpanfile` file for a list of dependencies to satisfy. ### Running tests You can run tests directly using the `prove` tool: $ prove -l $ prove -lv t/some_test_file.t For most of my distributions, `prove` is entirely sufficient for you to test any patches you have. I use `prove` for 99% of my testing during development. ### Code style and tidying Please try to match any existing coding style. If there is a `.perltidyrc` file, please install Perl::Tidy and use perltidy before submitting patches. If there is a `tidyall.ini` file, you can also install Code::TidyAll and run `tidyall` on a file or `tidyall -a` to tidy all files. ### Patching documentation Much of the documentation Pod is generated at release time. Some is generated boilerplate; other documentation is built from pseudo-POD directives in the source like C<=method> or C<=func>. If you would like to submit a documentation edit, please limit yourself to the documentation you see. If you see typos or documentation issues in the generated docs, please email or open a bug ticket instead of patching. ### Where to send patches and pull requests If you found this distribution on Github, sending a pull-request is the best way to contribute. If a pull-request isn't possible, a bug ticket with a patch file is the next best option. As a last resort, an email to the author(s) is acceptable. ## Installing and using Dist::Zilla Dist::Zilla is not required for contributing, but if you'd like to learn more, this section will get you up to speed. Dist::Zilla is a very powerful authoring tool, optimized for maintaining a large number of distributions with a high degree of automation, but it has a large dependency chain, a bit of a learning curve and requires a number of author-specific plugins. To install it from CPAN, I recommend one of the following approaches for the quickest installation: # using CPAN.pm, but bypassing non-functional pod tests $ cpan TAP::Harness::Restricted $ PERL_MM_USE_DEFAULT=1 HARNESS_CLASS=TAP::Harness::Restricted cpan Dist::Zilla # using cpanm, bypassing *all* tests $ cpanm -n Dist::Zilla In either case, it's probably going to take about 10 minutes. Go for a walk, go get a cup of your favorite beverage, take a bathroom break, or whatever. When you get back, Dist::Zilla should be ready for you. Then you need to install any plugins specific to this distribution: $ cpan `dzil authordeps` $ dzil authordeps | cpanm Once installed, here are some dzil commands you might try: $ dzil build $ dzil test $ dzil xtest You can learn more about Dist::Zilla at http://dzil.org/ Metabase-Fact-0.025/cpanfile000644 000765 000024 00000002635 12664742761 016077 0ustar00davidstaff000000 000000 requires "CPAN::DistnameInfo" => "0"; requires "Carp" => "0"; requires "Data::GUID" => "0"; requires "Getopt::Long" => "0"; requires "IO::Prompt::Tiny" => "0"; requires "JSON::MaybeXS" => "0"; requires "Pod::Usage" => "0"; requires "overload" => "0"; requires "perl" => "5.006"; requires "strict" => "0"; requires "warnings" => "0"; on 'test' => sub { requires "Cwd" => "0"; requires "ExtUtils::MakeMaker" => "0"; requires "File::Spec" => "0"; requires "File::Temp" => "0.20"; requires "Test::Fatal" => "0"; requires "Test::More" => "0.88"; requires "lib" => "0"; requires "perl" => "5.006"; }; on 'test' => sub { recommends "CPAN::Meta" => "2.120900"; }; on 'configure' => sub { requires "ExtUtils::MakeMaker" => "6.17"; requires "perl" => "5.006"; }; on 'develop' => sub { requires "Dist::Zilla" => "5"; requires "Dist::Zilla::PluginBundle::DAGOLDEN" => "0.072"; requires "English" => "0"; requires "File::Spec" => "0"; requires "File::Temp" => "0"; requires "IO::Handle" => "0"; requires "IPC::Open3" => "0"; requires "Pod::Coverage::TrustPod" => "0"; requires "Pod::Wordlist" => "0"; requires "Software::License::Apache_2_0" => "0"; requires "Test::CPAN::Meta" => "0"; requires "Test::More" => "0"; requires "Test::Pod" => "1.41"; requires "Test::Pod::Coverage" => "1.08"; requires "Test::Spelling" => "0.12"; requires "Test::Version" => "1"; requires "blib" => "1.01"; }; Metabase-Fact-0.025/dist.ini000644 000765 000024 00000000436 12664742761 016034 0ustar00davidstaff000000 000000 name = Metabase-Fact author = David Golden author = Ricardo Signes author = H.Merijn Brand license = Apache_2_0 copyright_holder = David Golden [@DAGOLDEN] :version = 0.072 Metabase-Fact-0.025/lib/000755 000765 000024 00000000000 12664742761 015133 5ustar00davidstaff000000 000000 Metabase-Fact-0.025/LICENSE000644 000765 000024 00000026354 12664742761 015404 0ustar00davidstaff000000 000000 This software is Copyright (c) 2016 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 Apache License Version 2.0, January 2004 http://www.apache.org/licenses/ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 1. Definitions. "License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. "Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. "Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. "You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. "Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. "Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. "Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). "Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. "Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." "Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. 2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. 3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. 4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: (a) You must give any other recipients of the Work or Derivative Works a copy of this License; and (b) You must cause any modified files to carry prominent notices stating that You changed the files; and (c) You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and (d) If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. 5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. 6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. 7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. 8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. 9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. END OF TERMS AND CONDITIONS APPENDIX: How to apply the Apache License to your work. To apply the Apache License to your work, attach the following boilerplate notice, with the fields enclosed by brackets "[]" replaced with your own identifying information. (Don't include the brackets!) The text should be enclosed in the appropriate comment syntax for the file format. We also recommend that a file or class name and description of purpose be included on the same "printed page" as the copyright notice for easier identification within third-party archives. Copyright [yyyy] [name of copyright owner] Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. Metabase-Fact-0.025/Makefile.PL000644 000765 000024 00000003551 12664742761 016343 0ustar00davidstaff000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.043. use strict; use warnings; use 5.006; use ExtUtils::MakeMaker 6.17; my %WriteMakefileArgs = ( "ABSTRACT" => "base class for Metabase Facts", "AUTHOR" => "David Golden , Ricardo Signes , H.Merijn Brand ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => "6.17" }, "DISTNAME" => "Metabase-Fact", "EXE_FILES" => [ "bin/metabase-profile" ], "LICENSE" => "apache", "MIN_PERL_VERSION" => "5.006", "NAME" => "Metabase::Fact", "PREREQ_PM" => { "CPAN::DistnameInfo" => 0, "Carp" => 0, "Data::GUID" => 0, "Getopt::Long" => 0, "IO::Prompt::Tiny" => 0, "JSON::MaybeXS" => 0, "Pod::Usage" => 0, "overload" => 0, "strict" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "Cwd" => 0, "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "File::Temp" => "0.20", "Test::Fatal" => 0, "Test::More" => "0.88", "lib" => 0 }, "VERSION" => "0.025", "test" => { "TESTS" => "t/*.t t/fact/*.t t/report/*.t t/resource/*.t t/user/*.t" } ); my %FallbackPrereqs = ( "CPAN::DistnameInfo" => 0, "Carp" => 0, "Cwd" => 0, "Data::GUID" => 0, "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "File::Temp" => "0.20", "Getopt::Long" => 0, "IO::Prompt::Tiny" => 0, "JSON::MaybeXS" => 0, "Pod::Usage" => 0, "Test::Fatal" => 0, "Test::More" => "0.88", "lib" => 0, "overload" => 0, "strict" => 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) }; WriteMakefile(%WriteMakefileArgs); Metabase-Fact-0.025/MANIFEST000644 000765 000024 00000002370 12664742761 015520 0ustar00davidstaff000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.043. CONTRIBUTING.mkdn Changes LICENSE MANIFEST META.json META.yml Makefile.PL README README.hacking bin/metabase-profile cpanfile dist.ini lib/Metabase/Fact.pm lib/Metabase/Fact/Hash.pm lib/Metabase/Fact/String.pm lib/Metabase/Report.pm lib/Metabase/Resource.pm lib/Metabase/Resource/cpan.pm lib/Metabase/Resource/cpan/distfile.pm lib/Metabase/Resource/metabase.pm lib/Metabase/Resource/metabase/fact.pm lib/Metabase/Resource/metabase/user.pm lib/Metabase/Resource/perl.pm lib/Metabase/Resource/perl/commit.pm lib/Metabase/User/EmailAddress.pm lib/Metabase/User/FullName.pm lib/Metabase/User/Profile.pm lib/Metabase/User/Secret.pm perlcritic.rc t/00-report-prereqs.dd t/00-report-prereqs.t t/base.t t/fact/hash.t t/fact/string.t t/lib/FactSubclasses.pm t/lib/ReportSubclasses.pm t/lib/Test/Metabase/StringFact.pm t/report/report-as-string.t t/report/report-check-spec.t t/report/report-open-close.t t/resource/base.t t/resource/cpan.t t/resource/perl.t t/user/profile.t tidyall.ini xt/author/00-compile.t xt/author/critic.t xt/author/pod-coverage.t xt/author/pod-spell.t xt/author/pod-syntax.t xt/author/test-version.t xt/release/distmeta.t xt/release/minimum-version.t xt/release/portability.t Metabase-Fact-0.025/META.json000644 000765 000024 00000011714 12664742761 016012 0ustar00davidstaff000000 000000 { "abstract" : "base class for Metabase Facts", "author" : [ "David Golden ", "Ricardo Signes ", "H.Merijn Brand " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 5.043, CPAN::Meta::Converter version 2.150001", "license" : [ "apache_2_0" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Metabase-Fact", "no_index" : { "directory" : [ "corpus", "examples", "t", "xt" ], "package" : [ "DB" ] }, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.17", "perl" : "5.006" } }, "develop" : { "requires" : { "Dist::Zilla" : "5", "Dist::Zilla::PluginBundle::DAGOLDEN" : "0.072", "English" : "0", "File::Spec" : "0", "File::Temp" : "0", "IO::Handle" : "0", "IPC::Open3" : "0", "Pod::Coverage::TrustPod" : "0", "Pod::Wordlist" : "0", "Software::License::Apache_2_0" : "0", "Test::CPAN::Meta" : "0", "Test::More" : "0", "Test::Pod" : "1.41", "Test::Pod::Coverage" : "1.08", "Test::Spelling" : "0.12", "Test::Version" : "1", "blib" : "1.01" } }, "runtime" : { "requires" : { "CPAN::DistnameInfo" : "0", "Carp" : "0", "Data::GUID" : "0", "Getopt::Long" : "0", "IO::Prompt::Tiny" : "0", "JSON::MaybeXS" : "0", "Pod::Usage" : "0", "overload" : "0", "perl" : "5.006", "strict" : "0", "warnings" : "0" } }, "test" : { "recommends" : { "CPAN::Meta" : "2.120900" }, "requires" : { "Cwd" : "0", "ExtUtils::MakeMaker" : "0", "File::Spec" : "0", "File::Temp" : "0.20", "Test::Fatal" : "0", "Test::More" : "0.88", "lib" : "0", "perl" : "5.006" } } }, "provides" : { "Metabase::Fact" : { "file" : "lib/Metabase/Fact.pm", "version" : "0.025" }, "Metabase::Fact::Hash" : { "file" : "lib/Metabase/Fact/Hash.pm", "version" : "0.025" }, "Metabase::Fact::String" : { "file" : "lib/Metabase/Fact/String.pm", "version" : "0.025" }, "Metabase::Report" : { "file" : "lib/Metabase/Report.pm", "version" : "0.025" }, "Metabase::Resource" : { "file" : "lib/Metabase/Resource.pm", "version" : "0.025" }, "Metabase::Resource::cpan" : { "file" : "lib/Metabase/Resource/cpan.pm", "version" : "0.025" }, "Metabase::Resource::cpan::distfile" : { "file" : "lib/Metabase/Resource/cpan/distfile.pm", "version" : "0.025" }, "Metabase::Resource::metabase" : { "file" : "lib/Metabase/Resource/metabase.pm", "version" : "0.025" }, "Metabase::Resource::metabase::fact" : { "file" : "lib/Metabase/Resource/metabase/fact.pm", "version" : "0.025" }, "Metabase::Resource::metabase::user" : { "file" : "lib/Metabase/Resource/metabase/user.pm", "version" : "0.025" }, "Metabase::Resource::perl" : { "file" : "lib/Metabase/Resource/perl.pm", "version" : "0.025" }, "Metabase::Resource::perl::commit" : { "file" : "lib/Metabase/Resource/perl/commit.pm", "version" : "0.025" }, "Metabase::User::EmailAddress" : { "file" : "lib/Metabase/User/EmailAddress.pm", "version" : "0.025" }, "Metabase::User::FullName" : { "file" : "lib/Metabase/User/FullName.pm", "version" : "0.025" }, "Metabase::User::Profile" : { "file" : "lib/Metabase/User/Profile.pm", "version" : "0.025" }, "Metabase::User::Secret" : { "file" : "lib/Metabase/User/Secret.pm", "version" : "0.025" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/dagolden/Metabase-Fact/issues" }, "homepage" : "https://github.com/dagolden/Metabase-Fact", "repository" : { "type" : "git", "url" : "https://github.com/dagolden/Metabase-Fact.git", "web" : "https://github.com/dagolden/Metabase-Fact" } }, "version" : "0.025", "x_authority" : "cpan:DAGOLDEN", "x_contributors" : [ "David Steinbrunner ", "Karen Etheridge ", "Nathan Gary Glenn ", "Randy Stauner " ] } Metabase-Fact-0.025/META.yml000644 000765 000024 00000005362 12664742761 015644 0ustar00davidstaff000000 000000 --- abstract: 'base class for Metabase Facts' author: - 'David Golden ' - 'Ricardo Signes ' - 'H.Merijn Brand ' build_requires: Cwd: '0' ExtUtils::MakeMaker: '0' File::Spec: '0' File::Temp: '0.20' Test::Fatal: '0' Test::More: '0.88' lib: '0' perl: '5.006' configure_requires: ExtUtils::MakeMaker: '6.17' perl: '5.006' dynamic_config: 0 generated_by: 'Dist::Zilla version 5.043, CPAN::Meta::Converter version 2.150001' license: apache meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Metabase-Fact no_index: directory: - corpus - examples - t - xt package: - DB provides: Metabase::Fact: file: lib/Metabase/Fact.pm version: '0.025' Metabase::Fact::Hash: file: lib/Metabase/Fact/Hash.pm version: '0.025' Metabase::Fact::String: file: lib/Metabase/Fact/String.pm version: '0.025' Metabase::Report: file: lib/Metabase/Report.pm version: '0.025' Metabase::Resource: file: lib/Metabase/Resource.pm version: '0.025' Metabase::Resource::cpan: file: lib/Metabase/Resource/cpan.pm version: '0.025' Metabase::Resource::cpan::distfile: file: lib/Metabase/Resource/cpan/distfile.pm version: '0.025' Metabase::Resource::metabase: file: lib/Metabase/Resource/metabase.pm version: '0.025' Metabase::Resource::metabase::fact: file: lib/Metabase/Resource/metabase/fact.pm version: '0.025' Metabase::Resource::metabase::user: file: lib/Metabase/Resource/metabase/user.pm version: '0.025' Metabase::Resource::perl: file: lib/Metabase/Resource/perl.pm version: '0.025' Metabase::Resource::perl::commit: file: lib/Metabase/Resource/perl/commit.pm version: '0.025' Metabase::User::EmailAddress: file: lib/Metabase/User/EmailAddress.pm version: '0.025' Metabase::User::FullName: file: lib/Metabase/User/FullName.pm version: '0.025' Metabase::User::Profile: file: lib/Metabase/User/Profile.pm version: '0.025' Metabase::User::Secret: file: lib/Metabase/User/Secret.pm version: '0.025' requires: CPAN::DistnameInfo: '0' Carp: '0' Data::GUID: '0' Getopt::Long: '0' IO::Prompt::Tiny: '0' JSON::MaybeXS: '0' Pod::Usage: '0' overload: '0' perl: '5.006' strict: '0' warnings: '0' resources: bugtracker: https://github.com/dagolden/Metabase-Fact/issues homepage: https://github.com/dagolden/Metabase-Fact repository: https://github.com/dagolden/Metabase-Fact.git version: '0.025' x_authority: cpan:DAGOLDEN x_contributors: - 'David Steinbrunner ' - 'Karen Etheridge ' - 'Nathan Gary Glenn ' - 'Randy Stauner ' Metabase-Fact-0.025/perlcritic.rc000644 000765 000024 00000001166 12664742761 017057 0ustar00davidstaff000000 000000 severity = 5 verbose = 8 [Variables::ProhibitPunctuationVars] allow = $@ $! [TestingAndDebugging::ProhibitNoStrict] allow = refs [Variables::ProhibitEvilVariables] variables = $DB::single # Turn these off [-BuiltinFunctions::ProhibitStringyEval] [-ControlStructures::ProhibitPostfixControls] [-ControlStructures::ProhibitUnlessBlocks] [-Documentation::RequirePodSections] [-InputOutput::ProhibitInteractiveTest] [-References::ProhibitDoubleSigils] [-RegularExpressions::RequireExtendedFormatting] [-InputOutput::ProhibitTwoArgOpen] [-Modules::ProhibitEvilModules] # Turn this on [Lax::ProhibitStringyEval::ExceptForRequire] Metabase-Fact-0.025/README000644 000765 000024 00000036337 12664742761 015261 0ustar00davidstaff000000 000000 NAME Metabase::Fact - base class for Metabase Facts VERSION version 0.025 SYNOPSIS # defining the fact class package MyFact; use Metabase::Fact::Hash; our @ISA = qw/Metabase::Fact::Hash/; # using the fact class my $fact = TestReport->new( resource => 'RJBS/Metabase-Fact-0.001.tar.gz', content => { status => 'FAIL', time => 3029, }, ); $client->send_fact($fact); DESCRIPTION Metabase is a framework for associating content and metadata with arbitrary resources. A Metabase can be used to store test reports, reviews, coverage analysis reports, reports on static analysis of coding style, or anything else for which datatypes are constructed. Metabase::Fact is a base class for Facts (really opinions or analyses) that can be sent to or retrieved from a Metabase repository. Structure of a Fact object A Fact object associates a "content" attribute with a "resource" attribute and a "creator" attribute. The "resource" attribute must be in a URI format that can be validated via a Metabase::Resource subclass. The "content" attribute is an opaque scalar with subclass-specific meaning. The "creator" attribute is a URI with a "metabase:user" scheme and type (see Metabase::Resource::metabase). Facts have three sets of metadata associate with them. Metadata are generally for use in indexing, searching and managing Facts. * "core metadata" describe universal properties of all Facts and are used to submit, store, manage and retrieve Facts within the Metabase framework. * "resource metadata" describe index properties derived from the "resource" attribute. (As these can be regenerated from the "resource" -- which is part of "core metadata" -- they are not stored with a serialized Fact.) * "content metadata" describe index properties derived from the "content" attribute. (As these can be regenerated from the "content" -- which is part of "core metadata" -- they are not stored with a serialized Fact.) Each of the three metadata sets has an associated accessor: "core_metadata", "resource_metadata" and "content_metadata". Each of the three sets also has an accessor that returns a hashref with a data type for each possible element in the set: "core_metadata_types", "resource_metadata_types" and "content_metadata_types". Data types are loosely based on Data::RX. For example: '//str' -- indicates a value that should be compared stringwise '//num' -- indicates a value that should be compared numerically '//bool' -- indicates a valut that is true or false When searching on metadata, you must join the set name to the metadata element name with a period character. For example: core.guid core.creator core.resource resource.scheme content.size content.score ATTRIBUTES Unless otherwise noted, all attributes are read-only and are either provided as arguments to the constructor or are generated during construction. All attributes (except "content") are also part of "core metadata". Arguments provided to new content (required) A reference to the actual information associated with the fact. The exact form of the content is up to each Fact class to determine. resource (required) The canonical resource (URI) the Fact relates to. For CPAN distributions, this would be a "cpan:///distfile/..." URI. (See URI::cpan.) The associated accessor returns a Metabase::Resource subclass. creator (optional) A Metabase::User::Profile URI that indicates the creator of the Fact. If not set during Fact creation, it will be set by the Metabase when a Fact is submitted based on the submitter Profile. The "set_creator" mutator may be called to set "creator", but only if it is not previously set. The associated accessor returns a Metabase::Resource subclass or "undef" if the creator has not been set. guid (optional) The Fact object's Globally Unique IDentifier. This is generated automatically if not provided. Generally, users should not provide a "guid" argument, but it is permitted for use in special cases where a non-random "guid" is necessary. Generated during construction These attributes are generated automatically during the call to "new". type The class name, with double-colons converted to dashes to be more URI-friendly. e.g. "Metabase::Fact" would be "Metabase-Fact". schema_version The "schema_version" of the Fact subclass that created the object. This may or may not be the same as the current "schema_version" of the class if newer versions of the class have been released since the object was created. creation_time Fact creation time in UTC expressed in extended ISO 8601 format with a "Z" (Zulu) suffix. For example: 2010-01-10T12:34:56Z update_time When the fact was created, stored or otherwise updated, expressed an ISO 8601 UTC format as with "creation_time". The "touch" method may be called at any time to update the value to the current time. This attribute generally only has local significance within a particular Metabase repository. For example, it may be used to sort Facts by when they were stored or changed in a Metabase. valid A boolean value indicating whether the fact is considered valid. It defaults to true. The "set_valid" method may be called to change the "valid" property, for example, to mark a fact invalid rather than deleting it. The value of "valid" is always normalized to return "1" for true and "0" for false. CONSTRUCTOR new $fact = MyFact->new( resource => 'AUTHORID/Foo-Bar-1.23.tar.gz', content => $content_structure, ); Constructs a new Fact. The "resource" and "content" attributes are required. No other attributes should be provided to "new" except "creator". CLASS METHODS type $type = MyFact->type; The "type" accessor may also be called as a class method. class_from_type $class = MyFact->class_from_type( $type ); A utility function to invert the operation of the "type" method. upgrade_fact MyFact->upgrade_fact( $struct ); This method will be called when initializing a fact from a data structure that claims to be of a schema version other than the schema version reported by the loaded class's "default_schema_version" method. It will be passed the hashref of args being used to initialized the fact object (generally the output of "as_struct" from an older version), and should alter that hash in place. default_schema_version $version = MyFact->default_schema_version; Defaults to 1. Subclasses should override this method if they make a backwards-incompatible change to the internals of the content attribute. Schema version numbers should be monotonically-increasing integers. The default schema version is used to set an objects schema_version attribution on creation. PERSISTENCE METHODS The following methods are implemented by Metabase::Fact and subclasses generally should not need to override them. save $fact->save($filename); This method writes out the fact to a file in JSON format. If the file cannot be written, an exception is raised. If the save is successful, a true value is returned. Internally, it calls "as_json". load my $fact = Metabase::Fact->load($filename); This method loads a fact from a JSON format file and returns it. If the file cannot be read or is not valid JSON, and exception is thrown. Internally, it calls "from_json". as_json This returns a JSON string containing the serialized object. Internally, it calls "as_struct". from_json This method regenerates a fact from a JSON string generated by "as_json". Internally, it calls "from_struct". as_struct This returns a simple data structure that represents the fact and can be used for transmission over the wire. It serializes the content and core metadata, but not other metadata, which should be recomputed by the receiving end. from_struct my $fact = Metabase::Fact->from_struct( $struct ); This takes the output of the "as_struct" method and reconstitutes a Fact object. If the class the struct represents is not loaded, "from_struct" will attempt to load the class or will throw an error. OBJECT METHODS The following methods are implemented by Metabase::Fact and subclasses generally should not need to override them. core_metadata This returns a hashref containing the fact's core metadata. This includes things like the guid, creation time, described resource, and so on. core_metadata_types This returns a hashref of types for each core metadata element resource_metadata This method returns metadata describing the resource. resource_metadata_types This returns a hashref of types for each resource metadata element set_creator $fact->set_creator($profile_uri); This method sets the "creator" core metadata for the core metadata for the fact. If the fact's "creator" is already set, an exception will be thrown. set_valid $fact->set_valid(0); This method sets the "valid" core metadata to a boolean value. touch $fact->touch This method sets the "update_time" core metadata for the core metadata for the fact to the current time in ISO 8601 UTC format with a trailing "Z" (Zulu) suffice. ABSTRACT METHODS Methods marked as required must be implemented by a Fact subclass. (The version in Metabase::Fact will die with an error if called.) In the documentation below, the terms must, must not, should, etc. have their usual RFC 2119 meanings. These methods MUST throw an exception if an error occurs. content_as_bytes required $string = $fact->content_as_bytes; This method MUST serialize a Fact's content as bytes in a scalar and return it. The method for serialization is up to the individual fact class to determine. Some common subclasses are available to handle serialization for common data types. See Metabase::Fact::Hash and Metabase::Fact::String. content_from_bytes required $content = $fact->content_from_bytes( $string ); $content = $fact->content_from_bytes( \$string ); Given a scalar, this method MUST regenerate and return the original content data structure. It MUST accept either a string or string reference as an argument. It MUST NOT overwrite the Fact's content attribute directly. content_metadata optional $content_meta = $fact->content_metadata; If provided, this method MUST return a hash reference with content-specific indexing metadata. The key MUST be the name of the field for indexing and SHOULD provide dimensions to differentiate one set of content from another. Values MUST be simple scalars, not references. Here is a hypothetical example of "content_metadata" for an image fact: sub content_metadata { my $self = shift; return { width => _compute_width ( $self->content ), height => _compute_height ( $self->content ), caption => _extract_caption( $self->content ), } } Field names should be valid perl identifiers, consisting of alphanumeric characters or underscores. Hyphens and periods are allowed, but are not recommended. content_metadata_types optional my $typemap = $fact->content_metadata_types; This method is used to identify the datatypes of keys in the data structure provided by "content_metadata". If provided, it MUST return a hash reference. It SHOULD contain a key for every key that could appear in the data structure generated by "content_metadata" and provide a value corresponding to a datatype for each key. It MAY contain keys that do not always appear in the result of "content_metadata". Data types are loosely based on Data::RX. Type SHOULD be one of the following: '//str' -- indicates a value that should be compared stringwise '//num' -- indicates a value that should be compared numerically '//bool' -- indicates a boolean value where "1" is true and "0" is false Here is a hypothetical example of "content_metadata_types" for an image fact: sub content_metadata_types { return { width => '//num', height => '//num', caption => '//str', } } Consumers of "content_metadata_types" SHOULD assume that any "content_metadata" key not found in the result of "content_metadata_types" is a '//str' resource. validate_content required eval { $fact->validate_content }; This method SHOULD check for the validity of content within the Fact. It MUST throw an exception if the fact content is invalid. (The return value is ignored.) validate_resource optional eval { $fact->validate_resource }; This method SHOULD check whether the resource type is relevant for the Fact subclass. It SHOULD use Metabase::Resource to create a resource object and evaluate the resource object scheme and type. It MUST throw an exception if the resource type is invalid. Otherwise, it MUST return a valid Metabase::Resource subclass. For example: sub validate_resource { my ($self) = @_; # Metabase::Resource->new dies if invalid my $obj = Metabase::Resource->new($self->resource); if ($obj->scheme eq 'cpan' && $obj->type eq 'distfile') { return $obj; } else { my $fact_type = $self->type; Carp::confess("'$resource' does not apply to '$fact_type'"); } } The default "validate_resource" accepts any resource that can initialize a "Metabase::Resource" object. BUGS Please report any bugs or feature using the CPAN Request Tracker. Bugs can be submitted through the web interface at When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. SUPPORT Bugs / Feature Requests Please report any bugs or feature requests through the issue tracker at . You will be notified automatically of any progress on your issue. Source Code This is open source software. The code repository is available for public review and contribution under the terms of the license. git clone https://github.com/dagolden/Metabase-Fact.git AUTHORS * David Golden * Ricardo Signes * H.Merijn Brand CONTRIBUTORS * David Steinbrunner * Karen Etheridge * Nathan Gary Glenn * Randy Stauner COPYRIGHT AND LICENSE This software is Copyright (c) 2016 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 Metabase-Fact-0.025/README.hacking000644 000765 000024 00000001670 12664742761 016654 0ustar00davidstaff000000 000000 README.hacking -- notes for contributors ---------------------------------------- CODING STYLE Not all old code has been cleaned up, but going forward, please follow these conventions: * 2-space indentation with spaces, not tabs DEPENDENCIES DURING DEVELOPMENT (AKA USING MYLIB) It can be annoying to manage dependencies during development when testing metabase distributions as they often depend on other metabase distributions also under development. There are a few options (1) set PERL5LIB to include all metabase project files (2) continually install all metabase project files while developing (3) use "-Mylib" and the .mylib file For (3), install the "ylib" module from CPAN. Then, when you invoke "perl -Mylib", all directories listed in the .mylib file will be added to @INC. For Makefile.PL, you'll need to make sure that -Mylib is used by perl as invoked in the Makefile: $ perl -Mylib Makefile.PL PERL="`which perl` -Mylib" Metabase-Fact-0.025/t/000755 000765 000024 00000000000 12664742761 014630 5ustar00davidstaff000000 000000 Metabase-Fact-0.025/tidyall.ini000644 000765 000024 00000000240 12664742761 016524 0ustar00davidstaff000000 000000 ; Install Code::TidyAll ; run "tidyall -a" to tidy all files ; run "tidyall -g" to tidy only files modified from git [PerlTidy] select = {lib,t}/**/*.{pl,pm,t} Metabase-Fact-0.025/xt/000755 000765 000024 00000000000 12664742761 015020 5ustar00davidstaff000000 000000 Metabase-Fact-0.025/xt/author/000755 000765 000024 00000000000 12664742761 016322 5ustar00davidstaff000000 000000 Metabase-Fact-0.025/xt/release/000755 000765 000024 00000000000 12664742761 016440 5ustar00davidstaff000000 000000 Metabase-Fact-0.025/xt/release/distmeta.t000644 000765 000024 00000000172 12664742761 020437 0ustar00davidstaff000000 000000 #!perl # This file was automatically generated by Dist::Zilla::Plugin::MetaTests. use Test::CPAN::Meta; meta_yaml_ok(); Metabase-Fact-0.025/xt/release/minimum-version.t000644 000765 000024 00000000266 12664742761 021767 0ustar00davidstaff000000 000000 #!perl use Test::More; eval "use Test::MinimumVersion"; plan skip_all => "Test::MinimumVersion required for testing minimum versions" if $@; all_minimum_version_ok( qq{5.010} ); Metabase-Fact-0.025/xt/release/portability.t000644 000765 000024 00000000332 12664742761 021165 0ustar00davidstaff000000 000000 #!perl use strict; use warnings; use Test::More; eval 'use Test::Portability::Files'; plan skip_all => 'Test::Portability::Files required for testing portability' if $@; options(test_one_dot => 0); run_tests(); Metabase-Fact-0.025/xt/author/00-compile.t000644 000765 000024 00000005354 12664742761 020363 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::Compile 2.054 use Test::More; plan tests => 18; my @module_files = ( 'Metabase/Fact.pm', 'Metabase/Fact/Hash.pm', 'Metabase/Fact/String.pm', 'Metabase/Report.pm', 'Metabase/Resource.pm', 'Metabase/Resource/cpan.pm', 'Metabase/Resource/cpan/distfile.pm', 'Metabase/Resource/metabase.pm', 'Metabase/Resource/metabase/fact.pm', 'Metabase/Resource/metabase/user.pm', 'Metabase/Resource/perl.pm', 'Metabase/Resource/perl/commit.pm', 'Metabase/User/EmailAddress.pm', 'Metabase/User/FullName.pm', 'Metabase/User/Profile.pm', 'Metabase/User/Secret.pm' ); my @scripts = ( 'bin/metabase-profile' ); # fake home for cpan-testers use File::Temp; local $ENV{HOME} = File::Temp::tempdir( CLEANUP => 1 ); my $inc_switch = -d 'blib' ? '-Mblib' : '-Ilib'; use File::Spec; use IPC::Open3; use IO::Handle; open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; my @warnings; for my $lib (@module_files) { # see L 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"); shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/ and not eval { require blib; blib->VERSION('1.01') }; 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 =~ /^#!\s*(?:\S*perl\S*)((?:\s+-\w*)*)(?:\s*#.*)?$/; my @flags = $1 ? split(' ', $1) : (); 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"); shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/ and not eval { require blib; blib->VERSION('1.01') }; # 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') or diag 'got warnings: ', ( Test::More->can('explain') ? Test::More::explain(\@warnings) : join("\n", '', @warnings) ); Metabase-Fact-0.025/xt/author/critic.t000644 000765 000024 00000000435 12664742761 017766 0ustar00davidstaff000000 000000 #!perl use strict; use warnings; use Test::More; use English qw(-no_match_vars); eval "use Test::Perl::Critic"; plan skip_all => 'Test::Perl::Critic required to criticise code' if $@; Test::Perl::Critic->import( -profile => "perlcritic.rc" ) if -e "perlcritic.rc"; all_critic_ok(); Metabase-Fact-0.025/xt/author/pod-coverage.t000644 000765 000024 00000000334 12664742761 021062 0ustar00davidstaff000000 000000 #!perl # This file was automatically generated by Dist::Zilla::Plugin::PodCoverageTests. use Test::Pod::Coverage 1.08; use Pod::Coverage::TrustPod; all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); Metabase-Fact-0.025/xt/author/pod-spell.t000644 000765 000024 00000001013 12664742761 020401 0ustar00davidstaff000000 000000 use strict; use warnings; use Test::More; # generated by Dist::Zilla::Plugin::Test::PodSpelling 2.007000 use Test::Spelling 0.12; use Pod::Wordlist; add_stopwords(); all_pod_files_spelling_ok( qw( bin lib ) ); __DATA__ David Golden dagolden Ricardo Signes rjbs Merijn Brand hmbrand Steinbrunner dsteinbrunner Karen Etheridge ether Nathan Gary Glenn nglenn Randy Stauner rwstauner lib Metabase Fact Hash String Report Resource cpan distfile metabase fact user perl commit User EmailAddress FullName Profile Secret Metabase-Fact-0.025/xt/author/pod-syntax.t000644 000765 000024 00000000252 12664742761 020614 0ustar00davidstaff000000 000000 #!perl # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); Metabase-Fact-0.025/xt/author/test-version.t000644 000765 000024 00000000640 12664742761 021151 0ustar00davidstaff000000 000000 use strict; use warnings; use Test::More; # generated by Dist::Zilla::Plugin::Test::Version 1.05 use Test::Version; my @imports = qw( version_all_ok ); my $params = { is_strict => 0, has_version => 1, multiple => 0, }; push @imports, $params if version->parse( $Test::Version::VERSION ) >= version->parse('1.002'); Test::Version->import(@imports); version_all_ok; done_testing; Metabase-Fact-0.025/t/00-report-prereqs.dd000644 000765 000024 00000005631 12664742761 020355 0ustar00davidstaff000000 000000 do { my $x = { 'configure' => { 'requires' => { 'ExtUtils::MakeMaker' => '6.17', 'perl' => '5.006' } }, 'develop' => { 'requires' => { 'Dist::Zilla' => '5', 'Dist::Zilla::PluginBundle::DAGOLDEN' => '0.072', 'English' => '0', 'File::Spec' => '0', 'File::Temp' => '0', 'IO::Handle' => '0', 'IPC::Open3' => '0', 'Pod::Coverage::TrustPod' => '0', 'Pod::Wordlist' => '0', 'Software::License::Apache_2_0' => '0', 'Test::CPAN::Meta' => '0', 'Test::More' => '0', 'Test::Pod' => '1.41', 'Test::Pod::Coverage' => '1.08', 'Test::Spelling' => '0.12', 'Test::Version' => '1', 'blib' => '1.01' } }, 'runtime' => { 'requires' => { 'CPAN::DistnameInfo' => '0', 'Carp' => '0', 'Data::GUID' => '0', 'Getopt::Long' => '0', 'IO::Prompt::Tiny' => '0', 'JSON::MaybeXS' => '0', 'Pod::Usage' => '0', 'overload' => '0', 'perl' => '5.006', 'strict' => '0', 'warnings' => '0' } }, 'test' => { 'recommends' => { 'CPAN::Meta' => '2.120900' }, 'requires' => { 'Cwd' => '0', 'ExtUtils::MakeMaker' => '0', 'File::Spec' => '0', 'File::Temp' => '0.20', 'Test::Fatal' => '0', 'Test::More' => '0.88', 'lib' => '0', 'perl' => '5.006' } } }; $x; }Metabase-Fact-0.025/t/00-report-prereqs.t000644 000765 000024 00000012731 12664742761 020230 0ustar00davidstaff000000 000000 #!perl use strict; use warnings; # This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.024 use Test::More tests => 1; use ExtUtils::MakeMaker; use File::Spec; # from $version::LAX my $lax_version_re = qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )? | (?:\.[0-9]+) (?:_[0-9]+)? ) | (?: v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )? | (?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)? ) )/x; # hide optional CPAN::Meta modules from prereq scanner # and check if they are available my $cpan_meta = "CPAN::Meta"; my $cpan_meta_pre = "CPAN::Meta::Prereqs"; my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic # Verify requirements? my $DO_VERIFY_PREREQS = 1; sub _max { my $max = shift; $max = ( $_ > $max ) ? $_ : $max for @_; return $max; } sub _merge_prereqs { my ($collector, $prereqs) = @_; # CPAN::Meta::Prereqs object if (ref $collector eq $cpan_meta_pre) { return $collector->with_merged_prereqs( CPAN::Meta::Prereqs->new( $prereqs ) ); } # Raw hashrefs for my $phase ( keys %$prereqs ) { for my $type ( keys %{ $prereqs->{$phase} } ) { for my $module ( keys %{ $prereqs->{$phase}{$type} } ) { $collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module}; } } } return $collector; } my @include = qw( ); my @exclude = qw( ); # Add static prereqs to the included modules list my $static_prereqs = do 't/00-report-prereqs.dd'; # Merge all prereqs (either with ::Prereqs or a hashref) my $full_prereqs = _merge_prereqs( ( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ), $static_prereqs ); # Add dynamic prereqs to the included modules list (if we can) my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; if ( $source && $HAS_CPAN_META ) { if ( my $meta = eval { CPAN::Meta->load_file($source) } ) { $full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs); } } else { $source = 'static metadata'; } my @full_reports; my @dep_errors; my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs; # Add static includes into a fake section for my $mod (@include) { $req_hash->{other}{modules}{$mod} = 0; } for my $phase ( qw(configure build test runtime develop other) ) { next unless $req_hash->{$phase}; next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING}); for my $type ( qw(requires recommends suggests conflicts modules) ) { next unless $req_hash->{$phase}{$type}; my $title = ucfirst($phase).' '.ucfirst($type); my @reports = [qw/Module Want Have/]; for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) { next if $mod eq 'perl'; next if grep { $_ eq $mod } @exclude; my $file = $mod; $file =~ s{::}{/}g; $file .= ".pm"; my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC; my $want = $req_hash->{$phase}{$type}{$mod}; $want = "undef" unless defined $want; $want = "any" if !$want && $want == 0; my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required"; if ($prefix) { my $have = MM->parse_version( File::Spec->catfile($prefix, $file) ); $have = "undef" unless defined $have; push @reports, [$mod, $want, $have]; if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) { if ( $have !~ /\A$lax_version_re\z/ ) { push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)"; } elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) { push @dep_errors, "$mod version '$have' is not in required range '$want'"; } } } else { push @reports, [$mod, $want, "missing"]; if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) { push @dep_errors, "$mod is not installed ($req_string)"; } } } if ( @reports ) { push @full_reports, "=== $title ===\n\n"; my $ml = _max( map { length $_->[0] } @reports ); my $wl = _max( map { length $_->[1] } @reports ); my $hl = _max( map { length $_->[2] } @reports ); if ($type eq 'modules') { splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports; } else { splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports; } push @full_reports, "\n"; } } } if ( @full_reports ) { diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports; } if ( @dep_errors ) { diag join("\n", "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n", "The following REQUIRED prerequisites were not satisfied:\n", @dep_errors, "\n" ); } pass; # vim: ts=4 sts=4 sw=4 et: Metabase-Fact-0.025/t/base.t000644 000765 000024 00000005666 12664742761 015744 0ustar00davidstaff000000 000000 # Copyright (c) 2008 by Ricardo Signes. All rights reserved. # Licensed under terms of Perl itself (the "License"). # You may not use this file except in compliance with the License. # A copy of the License was distributed with this file or you may obtain a # copy of the License from http://dev.perl.org/licenses/ use strict; use warnings; use Test::More 0.88; use Test::Fatal; use lib 't/lib'; use Test::Metabase::StringFact; plan tests => 17; require_ok('Metabase::Fact'); #--------------------------------------------------------------------------# # fixtures #--------------------------------------------------------------------------# my ( $obj, $err ); #--------------------------------------------------------------------------# # required parameters missing #--------------------------------------------------------------------------# $err = exception { $obj = Metabase::Fact->new() }; like( $err, qr/missing required/, "new() without params throws error" ); for my $p (qw/ resource content /) { like( $err, qr/$p/, "... '$p' noted missing" ); } is( Metabase::Fact->default_schema_version, 1, "schema_version() defaults to 1", ); #--------------------------------------------------------------------------# # fake an object and test methods #--------------------------------------------------------------------------# # type is class munged from "::" to "-" is( Metabase::Fact->type, "Metabase-Fact", "->type converts class name" ); # unimplemented for my $m (qw/content_as_bytes content_from_bytes validate_content/) { my $obj = bless {} => 'Metabase::Fact'; $err = exception { $obj->$m }; like( $err, qr/$m not implemented by Metabase::Fact/, "$m not implemented" ); } #--------------------------------------------------------------------------# # new should take either hashref or list #--------------------------------------------------------------------------# my $string = "Who am I?"; my $args = { resource => "metabase:fact:543fc732-0eec-11df-a736-0018f34ec37c", content => $string, }; is exception { $obj = Test::Metabase::StringFact->new($args) }, undef, "new( ) doesn't die"; isa_ok( $obj, 'Test::Metabase::StringFact' ); is exception { $obj = Test::Metabase::StringFact->new(%$args) }, undef, "new( ) doesn't die"; isa_ok( $obj, 'Test::Metabase::StringFact' ); is( $obj->type, "Test-Metabase-StringFact", "object type is correct" ); is( $obj->content, $string, "object content correct" ); #--------------------------------------------------------------------------# # class validation #--------------------------------------------------------------------------# $err = exception { $obj->_load_fact_class("Cwd;die 'Insecure'!"); }; like( $err, qr/does not look like a class name/, "fact class loading validates class name" ); $err = exception { $obj->resource->_load("Cwd;die 'Insecure'!"); }; like( $err, qr/does not look like a class name/, "fact class loading validates class name" ); Metabase-Fact-0.025/t/fact/000755 000765 000024 00000000000 12664742761 015545 5ustar00davidstaff000000 000000 Metabase-Fact-0.025/t/lib/000755 000765 000024 00000000000 12664742761 015376 5ustar00davidstaff000000 000000 Metabase-Fact-0.025/t/report/000755 000765 000024 00000000000 12664742761 016143 5ustar00davidstaff000000 000000 Metabase-Fact-0.025/t/resource/000755 000765 000024 00000000000 12664742761 016457 5ustar00davidstaff000000 000000 Metabase-Fact-0.025/t/user/000755 000765 000024 00000000000 12664742761 015606 5ustar00davidstaff000000 000000 Metabase-Fact-0.025/t/user/profile.t000644 000765 000024 00000005752 12664742761 017444 0ustar00davidstaff000000 000000 use strict; use warnings; use Test::More; use Test::Fatal; use File::Spec; use File::Temp 0.20; use Cwd; use JSON::MaybeXS (); #--------------------------------------------------------------------------# # fixtures #--------------------------------------------------------------------------# my $json = JSON::MaybeXS->new(ascii => 1); sub _compare { my ( $report1, $report2 ) = @_; is( $report1->core_metadata->{resource}, $report2->core_metadata->{resource}, "Checking URI" ); is( $report1->guid, $report2->guid, "Checking GUID" ); for my $i ( 0 .. 1 ) { is_deeply( $report1->{content}[$i]->as_struct, $report2->{content}[$i]->as_struct, "Checking fact $i", ); } return 1; } #--------------------------------------------------------------------------# # start testing #--------------------------------------------------------------------------# require_ok('Metabase::User::Profile'); require_ok('Metabase::User::Secret'); #--------------------------------------------------------------------------# # new profile creation #--------------------------------------------------------------------------# my $profile; is exception { $profile = Metabase::User::Profile->create( full_name => "J\x{022f}hn Doe", email_address => 'jdoe@example.com', ); }, undef, "create new profile"; isa_ok( $profile, 'Metabase::User::Profile' ); #--------------------------------------------------------------------------# # save and load profiles #--------------------------------------------------------------------------# my $tempdir = File::Temp::tempdir( CLEANUP => 1 ); my $profile_file = File::Spec->catfile( $tempdir, 'profile.json' ); $profile->save($profile_file); ok( -r $profile_file, 'profile saved to file' ); my $profile_copy = Metabase::User::Profile->load($profile_file); ok( $profile_copy, "Loaded profile file (created with ->create)" ); isa_ok( $profile_copy, 'Metabase::User::Profile' ); _compare( $profile, $profile_copy ); # try profile-generator my $bin = File::Spec->rel2abs( File::Spec->catfile(qw/bin metabase-profile/) ); my $cwd = Cwd::cwd(); chdir $tempdir; END { chdir $cwd } my $output_file = 'my.profile.json'; my $X = $^X =~ m/\s/ ? qq{"$^X"} : $^X; $bin = $bin =~ m/\s/ ? qq{"$bin"} : $bin; qx/$X $bin -o $output_file --name "JohnPublic" --email jp\@example.com --secret 3.14159/; ok( -r $output_file, 'created named profile file with metabase-profile' ); qx/$X $bin --name "JohnPublic" --email jp\@example.com --secret 3.14159/; ok( -r 'metabase_id.json', 'created default profile file with metabase-profile' ); my $file_guts = do { local ( @ARGV, $/ ) = 'metabase_id.json'; <> }; my $facts = $json->decode($file_guts); my $profile_copy2 = Metabase::User::Profile->from_struct( $facts->[0] ); ok( $profile_copy2, "Loaded profile from file" ); my $secret_copy2 = Metabase::User::Secret->from_struct( $facts->[1] ); ok( $secret_copy2, "Loaded secret from file" ); done_testing; Metabase-Fact-0.025/t/resource/base.t000644 000765 000024 00000005643 12664742761 017566 0ustar00davidstaff000000 000000 # Copyright (c) 2010 by David Golden. All rights reserved. # Licensed under terms of Perl itself (the "License"). # You may not use this file except in compliance with the License. # A copy of the License was distributed with this file or you may obtain a # copy of the License from http://dev.perl.org/licenses/ use strict; use warnings; use Test::More; use Test::Fatal; use lib 't/lib'; plan tests => 14; require_ok('Metabase::Resource'); require_ok('Metabase::Resource::metabase'); #--------------------------------------------------------------------------# # fixtures #--------------------------------------------------------------------------# my ( $obj, $err ); #--------------------------------------------------------------------------# # required parameters missing #--------------------------------------------------------------------------# $err = exception { $obj = Metabase::Resource->new() }; like $err, qr/no resource string provided/, "new() without string throws error"; #--------------------------------------------------------------------------# # fake an object and test methods #--------------------------------------------------------------------------# # unimplemented for my $m (qw/validate/) { my $obj = bless {} => 'Metabase::Resource'; $err = exception { $obj->$m }; like $err, qr/$m not implemented by Metabase::Resource/, "$m not implemented"; } # bad schema $err = exception { $obj = Metabase::Resource->new("noschema") }; like $err, qr/could not determine URI scheme from/, "no schema found"; #--------------------------------------------------------------------------# # new should create proper subtype object #--------------------------------------------------------------------------# my $string = "metabase:user:b66c7662-1d34-11de-a668-0df08d1878c0"; is exception { $obj = Metabase::Resource->new($string) }, undef, "Metabase::Resource->new(\$string) should not die"; isa_ok( $obj, 'Metabase::Resource::metabase' ); isa_ok( $obj, 'Metabase::Resource::metabase::user' ); is( $obj->resource, $string, "\$obj->resource correct" ); is( "$obj", $string, "string overloading working correctly" ); #--------------------------------------------------------------------------# # generates typed metadata #--------------------------------------------------------------------------# # test metadata my $metadata_types = { type => '//str', guid => '//str', }; my $expected_metadata = { type => 'Metabase-Resource-metabase-user', guid => 'b66c7662-1d34-11de-a668-0df08d1878c0', }; is_deeply( $metadata_types, $obj->metadata_types, "Metadata types" ); is_deeply( $expected_metadata, $obj->metadata, "Metadata" ); #--------------------------------------------------------------------------# # accessors #--------------------------------------------------------------------------# for my $k ( sort keys %$expected_metadata ) { is( $obj->$k, $expected_metadata->{$k}, "\$obj->$k" ); } Metabase-Fact-0.025/t/resource/cpan.t000644 000765 000024 00000004173 12664742761 017572 0ustar00davidstaff000000 000000 # Copyright (c) 2010 by David Golden. All rights reserved. # Licensed under terms of Perl itself (the "License"). # You may not use this file except in compliance with the License. # A copy of the License was distributed with this file or you may obtain a # copy of the License from http://dev.perl.org/licenses/ use strict; use warnings; use Test::More; use Test::Fatal; use lib 't/lib'; plan tests => 7; require_ok('Metabase::Resource'); #--------------------------------------------------------------------------# # fixtures #--------------------------------------------------------------------------# my ( $obj, $err ); #--------------------------------------------------------------------------# # required parameters missing #--------------------------------------------------------------------------# $err = exception { $obj = Metabase::Resource->new() }; like $err, qr/no resource string provided/, "new() without string throws error"; #--------------------------------------------------------------------------# # new should create proper subtype object #--------------------------------------------------------------------------# my $string = "cpan:///distfile/JOHNDOE/Foo-Bar-1.23.tar.gz"; is exception { $obj = Metabase::Resource->new($string) }, undef, "Metabase::Resource->new(\$string) should not die"; isa_ok( $obj, 'Metabase::Resource::cpan' ); is( $obj->resource, $string, "object content correct" ); #--------------------------------------------------------------------------# # generates typed metadata #--------------------------------------------------------------------------# # test metadata my $metadata_types = { type => '//str', cpan_id => '//str', dist_file => '//str', dist_name => '//str', dist_version => '//str', }; my $expected_metadata = { type => 'Metabase-Resource-cpan-distfile', cpan_id => 'JOHNDOE', dist_file => 'JOHNDOE/Foo-Bar-1.23.tar.gz', dist_name => 'Foo-Bar', dist_version => '1.23', }; is_deeply( $metadata_types, $obj->metadata_types, "Metadata types" ); is_deeply( $expected_metadata, $obj->metadata, "Metadata" ); Metabase-Fact-0.025/t/resource/perl.t000644 000765 000024 00000004226 12664742761 017612 0ustar00davidstaff000000 000000 # Copyright (c) 2010 by David Golden. All rights reserved. # Licensed under terms of Perl itself (the "License"). # You may not use this file except in compliance with the License. # A copy of the License was distributed with this file or you may obtain a # copy of the License from http://dev.perl.org/licenses/ use strict; use warnings; use Test::More; use Test::Fatal; use lib 't/lib'; plan tests => 10; require_ok('Metabase::Resource'); #--------------------------------------------------------------------------# # fixtures #--------------------------------------------------------------------------# my ( $obj, $err ); #--------------------------------------------------------------------------# # required parameters missing #--------------------------------------------------------------------------# like( exception { $obj = Metabase::Resource->new() }, qr/no resource string provided/, "new() without string throws error" ); #--------------------------------------------------------------------------# # new should create proper subtype object #--------------------------------------------------------------------------# my $sha1 = "8c57606294f48eb065dff03f7ffefc1e4e2cdce4"; my $string = "perl:///commit/$sha1"; is exception { $obj = Metabase::Resource->new($string) }, undef, "Metabase::Resource->new(\$string) should not die"; isa_ok( $obj, 'Metabase::Resource::perl' ); is( $obj->resource, $string, "object content correct" ); #--------------------------------------------------------------------------# # generates typed metadata #--------------------------------------------------------------------------# # test metadata my $metadata_types = { type => '//str', sha1 => '//str', }; my $expected_metadata = { type => 'Metabase-Resource-perl-commit', sha1 => $sha1, }; is_deeply( $metadata_types, $obj->metadata_types, "Metadata types" ); is_deeply( $expected_metadata, $obj->metadata, "Metadata" ); is( $obj->sha1, $sha1, "sha1() correct" ); is( $obj->full_url, "http://perl5.git.perl.org/perl.git/$sha1", "full_url()", ); is( $obj->full_url('example.com'), "http://example.com/perl.git/$sha1", "full_url('example.com')" ); Metabase-Fact-0.025/t/report/report-as-string.t000644 000765 000024 00000004231 12664742761 021550 0ustar00davidstaff000000 000000 # Copyright (c) 2008 by Ricardo Signes. All rights reserved. # Licensed under terms of Perl itself (the "License"). # You may not use this file except in compliance with the License. # A copy of the License was distributed with this file or you may obtain a # copy of the License from http://dev.perl.org/licenses/ use strict; use warnings; use Test::More; use Test::Fatal; use lib 't/lib'; plan tests => 13; require_ok('Metabase::Report'); require_ok('Test::Metabase::StringFact'); #--------------------------------------------------------------------------# # fixtures #--------------------------------------------------------------------------# require ReportSubclasses; require FactSubclasses; my %params = ( resource => "cpan:///distfile/JOHNDOE/Foo-Bar-1.23.tar.gz", ); my %facts = ( FactOne => FactOne->new( %params, content => "FactOne" ), FactTwo => FactTwo->new( %params, content => "FactTwo" ), ); my ( $report, $err ); #--------------------------------------------------------------------------# # report that takes 1 fact #--------------------------------------------------------------------------# is exception { $report = JustOneFact->open(%params); }, undef, ": open() given no facts"; isa_ok( $report, 'JustOneFact' ); is exception { $report->add( 'FactOne' => 'This is FactOne' ); }, undef, "lives: add( 'Class' => 'foo' )"; is exception { $report->close; }, undef, "lives: close()"; #--------------------------------------------------------------------------# # round trip #--------------------------------------------------------------------------# my $class = ref $report; my $report2; is exception { $report2 = $class->from_struct( $report->as_struct ); }, undef, "lives: as_struct->from_struct"; isa_ok( $report2, $class ); is_deeply( $report, $report2, "report2 is a clone of report" ); # set_creator for my $fact ( $report, $report->facts ) { is( $fact->creator, undef, "no creator (round 1)" ); } my $creator_uri = 'metabase:user:351e99ea-1d21-11de-ab9c-3268421c7a0a'; $report->set_creator($creator_uri); for my $fact ( $report, $report->facts ) { is( $fact->creator, $creator_uri, "creator set properly (round 2)" ); } Metabase-Fact-0.025/t/report/report-check-spec.t000644 000765 000024 00000005360 12664742761 021652 0ustar00davidstaff000000 000000 # Copyright (c) 2008 by Ricardo Signes. All rights reserved. # Licensed under terms of Perl itself (the "License"). # You may not use this file except in compliance with the License. # A copy of the License was distributed with this file or you may obtain a # copy of the License from http://dev.perl.org/licenses/ use strict; use warnings; use Test::More; use Test::Fatal; use lib 't/lib'; plan tests => 9; require_ok('Metabase::Report'); require_ok('Test::Metabase::StringFact'); #--------------------------------------------------------------------------# # fixtures #--------------------------------------------------------------------------# require ReportSubclasses; require FactSubclasses; my %params = ( resource => "cpan:///distfile/JOHNDOE/Foo-Bar-1.23.tar.gz", ); my %facts = ( FactOne => FactOne->new( %params, content => "FactOne" ), FactTwo => FactTwo->new( %params, content => "FactTwo" ), ); my ( $obj, $err ); #--------------------------------------------------------------------------# # report that takes 1 fact #--------------------------------------------------------------------------# is exception { $obj = JustOneFact->new( %params, content => [ $facts{FactOne} ] ); }, undef, "lives: new() takes 1 fact, and given 1 fact"; isnt exception { $obj = JustOneFact->new( %params, content => [] ); }, undef, "dies: new() takes 1 fact, but given none"; isnt exception { $obj = JustOneFact->new( %params, content => [ @facts{qw/FactOne FactTwo/} ] ); }, undef, "dies: new() takes 1 fact, but given 2 facts"; #--------------------------------------------------------------------------# # report that takes 1+ facts #--------------------------------------------------------------------------# is exception { $obj = OneOrMoreFacts->new( %params, content => [ @facts{qw/FactOne FactTwo/} ] ); }, undef, "lives: new() takes 1+ fact, and given 2 facts"; #--------------------------------------------------------------------------# # report that takes 1 of each #--------------------------------------------------------------------------# is exception { $obj = OneOfEach->new( %params, content => [ @facts{qw/FactOne FactTwo/} ] ); }, undef, "lives: new() takes 1 of each, given 1 of each"; isnt exception { $obj = OneOfEach->new( %params, content => [ @facts{qw/FactOne FactOne/} ] ); }, undef, "dies: new() takes 1 of each, given 2 of one kind"; #--------------------------------------------------------------------------# # report that takes 1 of each #--------------------------------------------------------------------------# is exception { $obj = OneSpecificAtLeastThreeTotal->new( %params, content => [ @facts{qw/FactOne FactTwo FactTwo/} ] ); }, undef, "lives: new() takes 1 specific 3 total, given correctly"; Metabase-Fact-0.025/t/report/report-open-close.t000644 000765 000024 00000004677 12664742761 021723 0ustar00davidstaff000000 000000 # Copyright (c) 2008 by Ricardo Signes. All rights reserved. # Licensed under terms of Perl itself (the "License"). # You may not use this file except in compliance with the License. # A copy of the License was distributed with this file or you may obtain a # copy of the License from http://dev.perl.org/licenses/ use strict; use warnings; use Test::More; use Test::Fatal; use lib 't/lib'; plan tests => 15; require_ok('Metabase::Report'); require_ok('Test::Metabase::StringFact'); #--------------------------------------------------------------------------# # fixtures #--------------------------------------------------------------------------# require ReportSubclasses; require FactSubclasses; my %params = ( resource => "cpan:///distfile/JOHNDOE/Foo-Bar-1.23.tar.gz", ); my %facts = ( FactOne => FactOne->new( %params, content => "FactOne" ), FactTwo => FactTwo->new( %params, content => "FactTwo" ), ); my ( $obj, $err ); #--------------------------------------------------------------------------# # report that takes 1 fact #--------------------------------------------------------------------------# is exception { $obj = JustOneFact->open(%params); }, undef, "lives: open() given no facts"; isa_ok( $obj, 'JustOneFact' ); is exception { $obj->add( 'FactOne' => 'This is FactOne' ); }, undef, "lives: add( 'Class' => 'foo' )"; is exception { $obj->close; }, undef, "lives: close()"; #--------------------------------------------------------------------------# # add takes a fact directly #--------------------------------------------------------------------------# is exception { $obj = JustOneFact->open(%params); }, undef, "lives: open() given no facts"; isa_ok( $obj, 'JustOneFact' ); is exception { $obj->add( $facts{FactOne} ); }, undef, "lives: add( \$fact )"; is exception { $obj->close; }, undef, "lives: close()"; #--------------------------------------------------------------------------# # errors #--------------------------------------------------------------------------# is exception { $obj = JustOneFact->open(%params); }, undef, "lives: open() given no facts"; isa_ok( $obj, 'JustOneFact' ); is exception { $obj->add( 'FactOne' => 'This is FactOne' ); }, undef, "lives: add( 'Class' => 'foo' )"; is exception { $obj->add( 'FactTwo' => 'This is FactTwo' ); }, undef, "lives: add( 'Class2' => 'foo' )"; $err = exception { $obj->close }; like $err, qr/content invalid/, "dies: close() with two facts"; Metabase-Fact-0.025/t/lib/FactSubclasses.pm000644 000765 000024 00000001675 12664742761 020652 0ustar00davidstaff000000 000000 package FactSubClasses; use strict; use warnings; use Metabase::Fact::String; use Metabase::Fact::Hash; package FactOne; our @ISA = ('Metabase::Fact::String'); sub content_as_bytes { return reverse( $_[0]->{content} ) } sub content_from_bytes { return reverse( $_[1] ) } package FactTwo; our @ISA = ('Metabase::Fact::String'); sub content_as_bytes { return reverse( $_[0]->{content} ) } sub content_from_bytes { return reverse( $_[1] ) } package FactThree; our @ISA = ('Metabase::Fact::String'); sub validate_content { $_[0]->SUPER::validate_content; die "content not positive length" unless length $_[0]->content > 0; } sub content_metadata { return { 'length' => [ '//num' => length $_[0]->content ] }; } package FactFour; our @ISA = ('Metabase::Fact::Hash'); sub required_keys { qw/ first / } sub optional_keys { qw/ second / } sub content_metadata { return { 'size' => [ '//num' => scalar keys %{ $_[0]->content } ] }; } 1; Metabase-Fact-0.025/t/lib/ReportSubclasses.pm000644 000765 000024 00000001101 12664742761 021230 0ustar00davidstaff000000 000000 use strict; use warnings; package JustOneFact; our @ISA = ('Metabase::Report'); sub report_spec { return { 'Metabase::Fact' => 1 } } package OneOrMoreFacts; our @ISA = ('Metabase::Report'); sub report_spec { return { 'Metabase::Fact' => '1+' } } package OneOfEach; our @ISA = ('Metabase::Report'); sub report_spec { return { 'FactOne' => '1', 'FactTwo' => '1', }; } package OneSpecificAtLeastThreeTotal; our @ISA = ('Metabase::Report'); sub report_spec { return { 'FactOne' => '1', 'Metabase::Fact' => '3', }; } 1; Metabase-Fact-0.025/t/lib/Test/000755 000765 000024 00000000000 12664742761 016315 5ustar00davidstaff000000 000000 Metabase-Fact-0.025/t/lib/Test/Metabase/000755 000765 000024 00000000000 12664742761 020036 5ustar00davidstaff000000 000000 Metabase-Fact-0.025/t/lib/Test/Metabase/StringFact.pm000644 000765 000024 00000000674 12664742761 022447 0ustar00davidstaff000000 000000 package Test::Metabase::StringFact; use 5.006; use strict; use warnings; use Metabase::Fact::String; our @ISA = qw/Metabase::Fact::String/; sub content_metadata { my $self = shift; return { 'size' => [ '//num' => length $self->content ], }; } sub validate_content { my $self = shift; $self->SUPER::validate_content; die __PACKAGE__ . " content length must be greater than zero\n" if length $self->content < 0; } 1; Metabase-Fact-0.025/t/fact/hash.t000644 000765 000024 00000010473 12664742761 016662 0ustar00davidstaff000000 000000 # Copyright (c) 2008 by Ricardo Signes. All rights reserved. # Licensed under terms of Perl itself (the "License"). # You may not use this file except in compliance with the License. # A copy of the License was distributed with this file or you may obtain a # copy of the License from http://dev.perl.org/licenses/ use strict; use warnings; use Data::GUID qw/guid_string/; use Test::More; use Test::Fatal; use JSON::MaybeXS (); use lib 't/lib'; plan tests => 23; require_ok('FactSubclasses.pm'); #--------------------------------------------------------------------------# # fixtures #--------------------------------------------------------------------------# my $json = JSON::MaybeXS->new(ascii => 1); my ( $obj, $err ); my $struct = { first => 'alpha', second => 'beta', }; my $meta = { size => [ '//num' => 2 ], }; my $args = { resource => "cpan:///distfile/JOHNDOE/Foo-Bar-1.23.tar.gz", content => $struct, }; my $test_args = { resource => $args->{resource}, content => {}, }; $err = exception { $obj = FactFour->new($test_args) }; like( $err, qr/missing required keys.+?first/, 'missing required dies' ); $test_args->{content}{first} = undef; is exception { $obj = FactFour->new($test_args) }, undef, "undef required field is OK"; $test_args->{content}{first} = 1; is exception { $obj = FactFour->new($test_args) }, undef, "new( ) doesn't die"; $test_args->{content}{third} = 3; $err = exception { $obj = FactFour->new($test_args) }; like( $err, qr/invalid keys.+?third/, 'invalid key dies' ); isa_ok( $obj, 'Metabase::Fact::Hash' ); is exception { $obj = FactFour->new(%$args) }, undef, "new( ) doesn't die"; isa_ok( $obj, 'Metabase::Fact::Hash' ); ok( $obj->guid, "object has a GUID" ); is( $obj->type, "FactFour", "object type is correct" ); is( $obj->{metadata}{core}{type}, "FactFour", "object type is set internally" ); is( $obj->resource, $args->{resource}, "object refers to distribution" ); is_deeply( $obj->content_metadata, $meta, "object content_metadata() correct" ); is_deeply( $obj->content, $struct, "object content correct" ); my $want_struct = { content => $json->encode($struct), metadata => { core => { type => 'FactFour', schema_version => 1, guid => $obj->guid, resource => $args->{resource}, valid => 1, }, } }; my $have_struct = $obj->as_struct; is( $have_struct->{metadata}{core}{update_time}, $have_struct->{metadata}{core}{creation_time}, "creation_time equals update_time" ); my $creation_time = delete $have_struct->{metadata}{core}{creation_time}; like( $creation_time, qr/\A\d\d\d\d-\d\d-\d\dT\d\d:\d\d:\d\dZ\z/, 'creation_time is ISO 8601 Zulu', ); delete $have_struct->{metadata}{core}{update_time}; is_deeply( $have_struct, $want_struct, "object as_struct correct" ); my $creator_uri = 'metabase:user:351e99ea-1d21-11de-ab9c-3268421c7a0a'; $obj->set_creator($creator_uri); $want_struct->{metadata}{core}{creator} = Metabase::Resource->new($creator_uri); $have_struct = $obj->as_struct; delete $have_struct->{metadata}{core}{update_time}; delete $have_struct->{metadata}{core}{creation_time}; is_deeply( $have_struct, $want_struct, "object as_struct correct w/creator" ); $obj->set_valid(0); $want_struct->{metadata}{core}{valid} = 0; $have_struct = $obj->as_struct; delete $have_struct->{metadata}{core}{update_time}; delete $have_struct->{metadata}{core}{creation_time}; is_deeply( $have_struct, $want_struct, "set_valid(0)" ); $obj->set_valid(2); $want_struct->{metadata}{core}{valid} = 1; $have_struct = $obj->as_struct; delete $have_struct->{metadata}{core}{update_time}; delete $have_struct->{metadata}{core}{creation_time}; is_deeply( $have_struct, $want_struct, "set_valid(2) normalized to '1'" ); #--------------------------------------------------------------------------# $obj = FactFour->new(%$args); my $obj2 = FactFour->from_struct( $obj->as_struct ); is_deeply( $obj2, $obj, "roundtrip as->from struct" ); #--------------------------------------------------------------------------# { my $guid = uc guid_string; $obj = FactFour->new( %$args, guid => $guid ); ok( $obj, "got object (set upper case guid manually)" ); is( $obj->guid, lc $guid, "object has correct lower-case guid" ); } Metabase-Fact-0.025/t/fact/string.t000644 000765 000024 00000004267 12664742761 017251 0ustar00davidstaff000000 000000 # Copyright (c) 2008 by Ricardo Signes. All rights reserved. # Licensed under terms of Perl itself (the "License"). # You may not use this file except in compliance with the License. # A copy of the License was distributed with this file or you may obtain a # copy of the License from http://dev.perl.org/licenses/ use strict; use warnings; use Test::More; use Test::Fatal; use lib 't/lib'; plan tests => 12; require_ok('FactSubclasses.pm'); #--------------------------------------------------------------------------# # fixtures #--------------------------------------------------------------------------# my ( $obj, $err ); my $string = "Who am I?"; my $meta = { 'length' => [ '//num' => length $string ], }; my $args = { resource => "cpan:///distfile/JOHNDOE/Foo-Bar-1.23.tar.gz", content => $string, }; is exception { $obj = FactThree->new($args) }, undef, "new( ) doesn't die"; isa_ok( $obj, 'Metabase::Fact::String' ); my $test_guid = "b4ac3de6-15bb-11df-b44d-0018f34ec37c"; is exception { $obj = FactThree->new( %$args, guid => $test_guid ) }, undef, "new( ) doesn't die"; isa_ok( $obj, 'Metabase::Fact::String' ); is( $obj->type, "FactThree", "object type is correct" ); is( $obj->resource, $args->{resource}, "object refers to distribution" ); is_deeply( $obj->content_metadata, $meta, "object content_metadata() correct" ); is( $obj->content, $string, "object content correct" ); my $want_struct = { content => $string, metadata => { core => { type => 'FactThree', schema_version => 1, guid => $test_guid, resource => $args->{resource}, valid => 1, }, }, }; my $have_struct = $obj->as_struct; is( $have_struct->{metadata}{core}{update_time}, $have_struct->{metadata}{core}{creation_time}, "creation_time equals update_time" ); my $creation_time = delete $have_struct->{metadata}{core}{creation_time}; like( $creation_time, qr/\A\d\d\d\d-\d\d-\d\dT\d\d:\d\d:\d\dZ\z/, 'creation_time is ISO 8601 Zulu', ); delete $have_struct->{metadata}{core}{update_time}; is_deeply( $have_struct, $want_struct, "object as_struct() correct" ); Metabase-Fact-0.025/lib/Metabase/000755 000765 000024 00000000000 12664742761 016654 5ustar00davidstaff000000 000000 Metabase-Fact-0.025/lib/Metabase/Fact/000755 000765 000024 00000000000 12664742761 017531 5ustar00davidstaff000000 000000 Metabase-Fact-0.025/lib/Metabase/Fact.pm000644 000765 000024 00000065236 12664742761 020103 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; package Metabase::Fact; our $VERSION = '0.025'; use Carp (); use Data::GUID guid_string => { -as => '_guid' }; use JSON::MaybeXS (); use Metabase::Resource; #--------------------------------------------------------------------------# # main API methods -- shouldn't be overridden #--------------------------------------------------------------------------# # We originally used Params::Validate, but only for # required/optional/disallowed, and it was Yet Another Prereq for what # needed to be a very small set of libraries. Sadly, we've rolled our # own... -- rjbs, 2009-03-30 sub __validate_args { my ( $self, $args, $spec ) = @_; my $hash = ( @$args == 1 and ref $args->[0] ) ? { %{ $args->[0] } } : ( @$args == 0 ) ? {} : {@$args}; my @errors; for my $key ( keys %$hash ) { push @errors, qq{unknown argument "$key" when constructing $self} unless exists $spec->{$key}; } for my $key ( grep { $spec->{$_} } keys %$spec ) { push @errors, qq{missing required argument "$key" when constructing $self} unless defined $hash->{$key}; } Carp::confess( join qq{\n}, @errors ) if @errors; return $hash; } my $hex = '[0-9a-f]'; my $guid_re = qr(\A$hex{8}-$hex{4}-$hex{4}-$hex{4}-$hex{12}\z)i; sub __validate_guid { my ( $class, $string ) = @_; if ( $string !~ $guid_re ) { Carp::confess("'$string' is not formatted as a GUID string"); } return lc $string; } sub validate_resource { my ( $self, $uri ) = @_; # Metabase::Resource->new dies if invalid my $obj = Metabase::Resource->new($uri); if ( !( ref($obj) && $obj->isa("Metabase::Resource") ) ) { Carp::confess("Could not validate '$uri' as a Metabase::Resource"); } return $obj; } sub new { my ( $class, @args ) = @_; my $args = $class->__validate_args( \@args, { content => 1, resource => 1, # where to validate? -- dagolden, 2009-03-31 # still optional so we can manipulate anon facts -- dagolden, 2009-05-12 creator => 0, # helpful for constructing facts with non-random guids guid => 0, }, ); # create the object my $self = $class->_init_guts($args); # validate content eval { $self->validate_content }; if ($@) { Carp::confess("$class object content invalid: $@"); } return $self; } sub _zulu_datetime { my ( $y, $mo, $d, $h, $mi, $s ) = (gmtime)[ reverse 0 .. 5 ]; return sprintf( "%4d-%02d-%02dT%02d:%02d:%02dZ", 1900 + $y, 1 + $mo, $d, $h, $mi, $s ); } sub _bool { return $_[0] ? 1 : 0 } # used for both new() and from_struct() -- in the former case # only content, resource, guid and creator could exist; in # the latter case, all fields would exist sub _init_guts { my ( $class, $args ) = @_; # confirm type $args->{type} = $class->type unless defined $args->{type}; Carp::confess("illegal type ($args->{type}) for $class") if $args->{type} ne $class->type; # if restoring from_struct, we must cope with older schemas $args->{schema_version} = $class->default_schema_version unless defined $args->{schema_version}; $class->upgrade_fact($args) if $args->{schema_version} != $class->default_schema_version; # initialize guid if not provided if ( !defined $args->{guid} ) { $args->{guid} = lc _guid(); } # initialize the object my $self = bless {}, $class; $self->{content} = $args->{content}; my $meta = $self->{metadata} = { core => {} }; $meta->{core}{guid} = $class->__validate_guid( $args->{guid} ); $meta->{core}{creation_time} = $args->{creation_time} || _zulu_datetime(); $meta->{core}{update_time} = $meta->{core}{creation_time}; $meta->{core}{schema_version} = $args->{schema_version}; $meta->{core}{type} = $self->type; $meta->{core}{valid} = _bool( defined $args->{valid} ? $args->{valid} : 1 ); # validate creator via mutator if given $self->set_creator( $args->{creator} ) if defined $args->{creator}; # validate resource field $meta->{core}{resource} = $self->validate_resource( $args->{resource} ); return $self; } # Content accessor sub content { $_[0]->{content} } # Accessors for core metadata sub creation_time { $_[0]->{metadata}{core}{creation_time} } sub guid { $_[0]->{metadata}{core}{guid} } sub resource { $_[0]->{metadata}{core}{resource} } sub schema_version { $_[0]->{metadata}{core}{schema_version} } # Creator can be set once after the fact is created sub creator { $_[0]->{metadata}{core}{creator} } sub set_creator { my ( $self, $uri ) = @_; Carp::confess("can't set creator; it is already set") if $self->creator; # validate $uri my $obj = Metabase::Resource->new($uri); unless ( $obj->type eq 'Metabase-Resource-metabase-user' ) { Carp::confess( "creator must be a Metabase User Profile resource URI of\n" . "the form 'metabase:user:XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX'" ); } $self->{metadata}{core}{creator} = $obj; } # update_time can always be modified sub update_time { $_[0]->{metadata}{core}{update_time} } sub touch { my ($self) = @_; $self->{metadata}{core}{update_time} = _zulu_datetime(); } # valid can be modified sub valid { $_[0]->{metadata}{core}{valid} } sub set_valid { my ( $self, $val ) = @_; $self->{metadata}{core}{valid} = _bool($val); } # metadata structure accessors sub core_metadata { my $self = shift; return { %{ $self->{metadata}{core} } }; } sub core_metadata_types { return { creation_time => '//str', creator => '//str', guid => '//str', resource => '//str', schema_version => '//num', type => '//str', update_time => '//str', valid => '//bool', }; } sub resource_metadata { my $self = shift; $self->{metadata}{resource} ||= $self->resource->metadata; return { %{ $self->{metadata}{resource} } }; } sub resource_metadata_types { my $self = shift; return $self->resource->metadata_types; } # persistence routines # Class might not be in its own file -- check if method can resolve # or else try to load it my $id_re = qr/[_a-z]+/i; my $class_re = qr/^$id_re(?:::$id_re)*$/; sub _load_fact_class { my ( $class, $fact_class ) = @_; unless ( defined $fact_class ) { Carp::confess "Can't load undef as a module"; } unless ( $fact_class =~ $class_re ) { Carp::confess "'$fact_class' does not look like a class name"; } unless ( $fact_class->can('type') ) { eval "require $fact_class; 1" ## no critic or Carp::confess "Could not load fact class $fact_class\: $@"; } return 1; } sub as_struct { my ($self) = @_; # turn Metabase::Resources back into URI strings my $core = { %{ $self->core_metadata } }; $core->{resource} = $core->{resource}->resource; $core->{creator} = $core->{creator}->resource if exists $core->{creator}; return { content => $self->content_as_bytes, metadata => { # We only provide core metadata here, not resource or content metadata, # because we use as_struct for serialized transmission. The remote that # receives the transmission should reconstruct the metadata for itself, # as it is more likely to have an improved metadata producer. -- rjbs, # 2009-06-24 core => $core, } }; } sub from_struct { my ( $class, $struct ) = @_; # Might be called as Metabase::Fact->from_struct($struct), so we # need to find and load the actual fact class my $fact_class = $class->class_from_type( $struct->{metadata}{core}{type} ); $class->_load_fact_class($fact_class); my $metadata = $struct->{metadata}; my $core_meta = $metadata->{core}; # transform struct into content and core metadata arguments the way they # would be given to new, then validate these and get an object from # _init_guts my @args = ( ( map { $_ => $core_meta->{$_} } keys %$core_meta ), content => $fact_class->content_from_bytes( $struct->{content} ), ); my $args = $fact_class->__validate_args( \@args, { # when thawing, all of these must be provided content => 1, creation_time => 1, guid => 1, resource => 1, schema_version => 1, type => 1, valid => 1, # still optional so we can manipulate anon facts -- dagolden, 2009-05-12 creator => 0, update_time => 0, }, ); my $self = $fact_class->_init_guts($args); return $self; } sub as_json { my ($self) = @_; return JSON::MaybeXS->new(ascii => 1)->encode( $self->as_struct ); } sub from_json { my ( $class, $string ) = @_; my $struct = eval { JSON::MaybeXS->new(ascii => 1)->decode($string) } or Carp::confess "Error decoding JSON:\n$@"; return $class->from_struct($struct); } sub save { my ( $self, $filename ) = @_; my $class = ref($self); open my $fh, ">", $filename or Carp::confess "Error saving $class to '$filename'\: $!"; print {$fh} scalar $self->as_json; close $fh; return 1; } sub load { my ( $class, $filename ) = @_; open my $fh, "<", $filename or Carp::confess "Error loading fact from '$filename'\: $!"; my $string = do { local $/; <$fh> }; close $fh; return $class->from_json($string); } #--------------------------------------------------------------------------# # utilities for all facts to do class/type conversions #--------------------------------------------------------------------------# # type_from_class sub type { my $self = shift; my $type = ref $self || $self; $type =~ s{::}{-}g; return $type; } # XXX: I'm not really excited about having this in here. -- rjbs, 2009-03-28 # XXX: Need it ->type for symmetry. Make it private? -- dagolden, 2009-03-31 sub class_from_type { my ( undef, $type ) = @_; Carp::confess "can't get class from undef type" unless defined $type; $type =~ s/-/::/g; return $type; } #--------------------------------------------------------------------------# # class methods #--------------------------------------------------------------------------# # schema_version recorded in 'version' attribution during ->new # if format of content changes, class module should increment schema version # to check: if ( $obj->version != $class->schema_version ) ... # XXX should this be a fatal abstract? Forcing classes to be # explicit about schema versions? Annoying, but correct -- dagolden, 2009-03-31 sub default_schema_version { 1 } #--------------------------------------------------------------------------# # abstract methods -- mostly fatal #--------------------------------------------------------------------------# sub content_metadata { return +{} } sub content_metadata_types { return +{} } sub upgrade_fact { my ($self) = @_; Carp::confess "Detected a schema mismatch, but upgrade_fact not implemented by " . ( ref $self || $self ); } sub content_as_bytes { my ( $self, $content ) = @_; Carp::confess "content_as_bytes not implemented by " . ( ref $self || $self ); } sub content_from_bytes { my ( $self, $bytes ) = @_; Carp::confess "content_from_bytes not implemented by " . ( ref $self || $self ); } sub validate_content { my ( $self, $content ) = @_; Carp::confess "validate_content not implemented by " . ( ref $self || $self ); } 1; # ABSTRACT: base class for Metabase Facts __END__ =pod =encoding UTF-8 =head1 NAME Metabase::Fact - base class for Metabase Facts =head1 VERSION version 0.025 =head1 SYNOPSIS # defining the fact class package MyFact; use Metabase::Fact::Hash; our @ISA = qw/Metabase::Fact::Hash/; # using the fact class my $fact = TestReport->new( resource => 'RJBS/Metabase-Fact-0.001.tar.gz', content => { status => 'FAIL', time => 3029, }, ); $client->send_fact($fact); =head1 DESCRIPTION L is a framework for associating content and metadata with arbitrary resources. A Metabase can be used to store test reports, reviews, coverage analysis reports, reports on static analysis of coding style, or anything else for which datatypes are constructed. Metabase::Fact is a base class for Facts (really opinions or analyses) that can be sent to or retrieved from a Metabase repository. =head2 Structure of a Fact object A Fact object associates a C attribute with a C attribute and a C attribute. The C attribute must be in a URI format that can be validated via a L subclass. The C attribute is an opaque scalar with subclass-specific meaning. The C attribute is a URI with a "metabase:user" scheme and type (see L). Facts have three sets of metadata associate with them. Metadata are generally for use in indexing, searching and managing Facts. =over =item * C describe universal properties of all Facts and are used to submit, store, manage and retrieve Facts within the Metabase framework. =item * C describe index properties derived from the C attribute. (As these can be regenerated from the C -- which is part of C -- they are not stored with a serialized Fact.) =item * C describe index properties derived from the C attribute. (As these can be regenerated from the C -- which is part of C -- they are not stored with a serialized Fact.) =back Each of the three metadata sets has an associated accessor: C, C and C. Each of the three sets also has an accessor that returns a hashref with a data type for each possible element in the set: C, C and C. Data types are loosely based on L. For example: '//str' -- indicates a value that should be compared stringwise '//num' -- indicates a value that should be compared numerically '//bool' -- indicates a valut that is true or false When searching on metadata, you must join the set name to the metadata element name with a period character. For example: core.guid core.creator core.resource resource.scheme content.size content.score =head1 ATTRIBUTES Unless otherwise noted, all attributes are read-only and are either provided as arguments to the constructor or are generated during construction. All attributes (except C) are also part of C. =head2 Arguments provided to new =head3 content (required) A reference to the actual information associated with the fact. The exact form of the content is up to each Fact class to determine. =head3 resource (required) The canonical resource (URI) the Fact relates to. For CPAN distributions, this would be a C URI. (See L.) The associated accessor returns a Metabase::Resource subclass. =head3 creator (optional) A L URI that indicates the creator of the Fact. If not set during Fact creation, it will be set by the Metabase when a Fact is submitted based on the submitter Profile. The C mutator may be called to set C, but only if it is not previously set. The associated accessor returns a Metabase::Resource subclass or C if the creator has not been set. =head3 guid (optional) The Fact object's Globally Unique IDentifier. This is generated automatically if not provided. Generally, users should not provide a C argument, but it is permitted for use in special cases where a non-random C is necessary. =head2 Generated during construction These attributes are generated automatically during the call to C. =head3 type The class name, with double-colons converted to dashes to be more URI-friendly. e.g. C would be C. =head3 schema_version The C of the Fact subclass that created the object. This may or may not be the same as the current C of the class if newer versions of the class have been released since the object was created. =head3 creation_time Fact creation time in UTC expressed in extended ISO 8601 format with a "Z" (Zulu) suffix. For example: 2010-01-10T12:34:56Z =head3 update_time When the fact was created, stored or otherwise updated, expressed an ISO 8601 UTC format as with C. The C method may be called at any time to update the value to the current time. This attribute generally only has local significance within a particular Metabase repository. For example, it may be used to sort Facts by when they were stored or changed in a Metabase. =head3 valid A boolean value indicating whether the fact is considered valid. It defaults to true. The C method may be called to change the C property, for example, to mark a fact invalid rather than deleting it. The value of C is always normalized to return "1" for true and "0" for false. =head1 CONSTRUCTOR =head2 new $fact = MyFact->new( resource => 'AUTHORID/Foo-Bar-1.23.tar.gz', content => $content_structure, ); Constructs a new Fact. The C and C attributes are required. No other attributes should be provided to C except C. =head1 CLASS METHODS =head2 type $type = MyFact->type; The C accessor may also be called as a class method. =head2 class_from_type $class = MyFact->class_from_type( $type ); A utility function to invert the operation of the C method. =head2 upgrade_fact MyFact->upgrade_fact( $struct ); This method will be called when initializing a fact from a data structure that claims to be of a schema version other than the schema version reported by the loaded class's C method. It will be passed the hashref of args being used to initialized the fact object (generally the output of C from an older version), and should alter that hash in place. =head2 default_schema_version $version = MyFact->default_schema_version; Defaults to 1. Subclasses should override this method if they make a backwards-incompatible change to the internals of the content attribute. Schema version numbers should be monotonically-increasing integers. The default schema version is used to set an objects schema_version attribution on creation. =head1 PERSISTENCE METHODS The following methods are implemented by Metabase::Fact and subclasses generally should not need to override them. =head2 save $fact->save($filename); This method writes out the fact to a file in JSON format. If the file cannot be written, an exception is raised. If the save is successful, a true value is returned. Internally, it calls C. =head2 load my $fact = Metabase::Fact->load($filename); This method loads a fact from a JSON format file and returns it. If the file cannot be read or is not valid JSON, and exception is thrown. Internally, it calls C. =head2 as_json This returns a JSON string containing the serialized object. Internally, it calls C. =head2 from_json This method regenerates a fact from a JSON string generated by C. Internally, it calls C. =head2 as_struct This returns a simple data structure that represents the fact and can be used for transmission over the wire. It serializes the content and core metadata, but not other metadata, which should be recomputed by the receiving end. =head2 from_struct my $fact = Metabase::Fact->from_struct( $struct ); This takes the output of the C method and reconstitutes a Fact object. If the class the struct represents is not loaded, C will attempt to load the class or will throw an error. =head1 OBJECT METHODS The following methods are implemented by Metabase::Fact and subclasses generally should not need to override them. =head2 core_metadata This returns a hashref containing the fact's core metadata. This includes things like the guid, creation time, described resource, and so on. =head2 core_metadata_types This returns a hashref of types for each core metadata element =head2 resource_metadata This method returns metadata describing the resource. =head2 resource_metadata_types This returns a hashref of types for each resource metadata element =head2 set_creator $fact->set_creator($profile_uri); This method sets the C core metadata for the core metadata for the fact. If the fact's C is already set, an exception will be thrown. =head2 set_valid $fact->set_valid(0); This method sets the C core metadata to a boolean value. =head2 touch $fact->touch This method sets the C core metadata for the core metadata for the fact to the current time in ISO 8601 UTC format with a trailing "Z" (Zulu) suffice. =head1 ABSTRACT METHODS Methods marked as F must be implemented by a Fact subclass. (The version in Metabase::Fact will die with an error if called.) In the documentation below, the terms F, F, F, etc. have their usual RFC 2119 meanings. These methods MUST throw an exception if an error occurs. =head2 content_as_bytes B $string = $fact->content_as_bytes; This method MUST serialize a Fact's content as bytes in a scalar and return it. The method for serialization is up to the individual fact class to determine. Some common subclasses are available to handle serialization for common data types. See L and L. =head2 content_from_bytes B $content = $fact->content_from_bytes( $string ); $content = $fact->content_from_bytes( \$string ); Given a scalar, this method MUST regenerate and return the original content data structure. It MUST accept either a string or string reference as an argument. It MUST NOT overwrite the Fact's content attribute directly. =head2 content_metadata B $content_meta = $fact->content_metadata; If provided, this method MUST return a hash reference with content-specific indexing metadata. The key MUST be the name of the field for indexing and SHOULD provide dimensions to differentiate one set of content from another. Values MUST be simple scalars, not references. Here is a hypothetical example of C for an image fact: sub content_metadata { my $self = shift; return { width => _compute_width ( $self->content ), height => _compute_height ( $self->content ), caption => _extract_caption( $self->content ), } } Field names should be valid perl identifiers, consisting of alphanumeric characters or underscores. Hyphens and periods are allowed, but are not recommended. =head2 content_metadata_types B my $typemap = $fact->content_metadata_types; This method is used to identify the datatypes of keys in the data structure provided by C. If provided, it MUST return a hash reference. It SHOULD contain a key for every key that could appear in the data structure generated by C and provide a value corresponding to a datatype for each key. It MAY contain keys that do not always appear in the result of C. Data types are loosely based on L. Type SHOULD be one of the following: '//str' -- indicates a value that should be compared stringwise '//num' -- indicates a value that should be compared numerically '//bool' -- indicates a boolean value where "1" is true and "0" is false Here is a hypothetical example of C for an image fact: sub content_metadata_types { return { width => '//num', height => '//num', caption => '//str', } } Consumers of C SHOULD assume that any C key not found in the result of C is a '//str' resource. =head2 validate_content B eval { $fact->validate_content }; This method SHOULD check for the validity of content within the Fact. It MUST throw an exception if the fact content is invalid. (The return value is ignored.) =head2 validate_resource B eval { $fact->validate_resource }; This method SHOULD check whether the resource type is relevant for the Fact subclass. It SHOULD use L to create a resource object and evaluate the resource object scheme and type. It MUST throw an exception if the resource type is invalid. Otherwise, it MUST return a valid Metabase::Resource subclass. For example: sub validate_resource { my ($self) = @_; # Metabase::Resource->new dies if invalid my $obj = Metabase::Resource->new($self->resource); if ($obj->scheme eq 'cpan' && $obj->type eq 'distfile') { return $obj; } else { my $fact_type = $self->type; Carp::confess("'$resource' does not apply to '$fact_type'"); } } The default C accepts any resource that can initialize a C object. =head1 BUGS Please report any bugs or feature using the CPAN Request Tracker. Bugs can be submitted through the web interface at L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Bugs / Feature Requests Please report any bugs or feature requests through the issue tracker at L. You will be notified automatically of any progress on your issue. =head2 Source Code This is open source software. The code repository is available for public review and contribution under the terms of the license. L git clone https://github.com/dagolden/Metabase-Fact.git =head1 AUTHORS =over 4 =item * David Golden =item * Ricardo Signes =item * H.Merijn Brand =back =head1 CONTRIBUTORS =for stopwords David Steinbrunner Karen Etheridge Nathan Gary Glenn Randy Stauner =over 4 =item * David Steinbrunner =item * Karen Etheridge =item * Nathan Gary Glenn =item * Randy Stauner =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2016 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut Metabase-Fact-0.025/lib/Metabase/Report.pm000644 000765 000024 00000022400 12664742761 020463 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; package Metabase::Report; our $VERSION = '0.025'; use Carp (); use JSON::MaybeXS (); use Metabase::Fact; our @ISA = qw/Metabase::Fact/; #--------------------------------------------------------------------------# # abstract methods -- fatal #--------------------------------------------------------------------------# sub report_spec { my $self = shift; Carp::confess "report_spec method not implemented by " . ref $self; } sub set_creator { my ( $self, $uri ) = @_; $self->SUPER::set_creator($uri); for my $fact ( $self->facts ) { $fact->set_creator($uri) unless $fact->creator; } } #--------------------------------------------------------------------------# # alternate constructor methods #--------------------------------------------------------------------------# # adapted from Fact::new() -- must keep in sync # content field is optional -- should other fields be optional at this # stage? Maybe we shouldn't let any fields be optional # XXX should probably refactor arg_spec for Fact->new so we can reuse it # and just make the content one optional. -- dagolden, 2009-03-31 sub open { my ( $class, @args ) = @_; my $args = $class->__validate_args( \@args, { resource => 1, # still optional so we can manipulate anon facts -- dagolden, 2009-05-12 creator => 0, # helpful for constructing facts with non-random guids guid => 0, } ); $args->{content} ||= []; # create and check my $self = $class->_init_guts($args); return $self; } sub add { my ( $self, @args ) = @_; Carp::confess("report is already closed") if $self->{__closed}; my ( $fact, $fact_class, $content ); if ( @args == 1 && $args[0]->isa('Metabase::Fact') ) { $fact = $args[0]; } else { ( $fact_class, $content ) = @args; $fact = $fact_class->new( resource => $self->resource->resource, content => $content, ); } $fact->set_creator( $self->creator->resource ) if $self->creator; push @{ $self->{content} }, $fact; return $self; } # close just validates -- otherwise unnecessary sub close { my ($self) = @_; my $class = ref $self; my $ok = eval { $self->validate_content; 1 }; unless ($ok) { my $error = $@ || '(unknown error)'; Carp::confess("$class object content invalid: $error"); } $self->{__closed} = 1; return $self; } # accessor for facts -- this must work regardless of __closed so # that facts can be added using content_meta of facts already added sub facts { my ($self) = @_; return @{ $self->content }; } #--------------------------------------------------------------------------# # implement required abstract Fact methods #--------------------------------------------------------------------------# sub from_struct { my ( $class, $struct ) = @_; my $self = $class->SUPER::from_struct($struct); $self->{__closed} = 1; return $self; } sub content_as_bytes { my $self = shift; Carp::confess("can't serialize an open report") unless $self->{__closed}; my $content = [ map { $_->as_struct } @{ $self->content } ]; my $encoded = eval { JSON::MaybeXS->new(ascii => 1)->encode($content) }; Carp::confess $@ if $@; return $encoded; } sub content_from_bytes { my ( $self, $string ) = @_; $string = $$string if ref $string; my $fact_structs = JSON::MaybeXS->new(ascii => 1)->decode($string); my @facts; for my $struct (@$fact_structs) { my $class = $self->class_from_type( $struct->{metadata}{core}{type} ); my $fact = eval { $class->from_struct($struct) } or Carp::confess "Unable to create a '$class' object: $@"; push @facts, $fact; } return \@facts; } # XXX what if spec is '0' (not '0+')? -- dagolden, 2009-03-30 sub validate_content { my ($self) = @_; my $spec = $self->report_spec; my $content = $self->content; die ref $self . " content must be an array reference of Fact object" unless ref $content eq 'ARRAY'; my @fact_matched; # check that each spec matches for my $k ( keys %$spec ) { $spec->{$k} =~ m{^(\d+)(\+)?$}; my $minimum = defined $1 ? $1 : 0; my $exact = defined $2 ? 0 : 1; # exact unless "+" # mark facts that match a spec my $found = 0; for my $i ( 0 .. @$content - 1 ) { if ( $content->[$i]->isa($k) ) { $found++; $fact_matched[$i] = 1; } } if ($exact) { die "expected $minimum of $k, but found $found\n" if $found != $minimum; } else { die "expected at least $minimum of $k, but found $found\n" if $found < $minimum; } } # any facts that didn't match anything? my $unmatched = grep { !$_ } @fact_matched; die "$unmatched fact(s) not in the spec\n" if $unmatched; return; } #--------------------------------------------------------------------------# # class methods #--------------------------------------------------------------------------# sub fact_classes { my ($self) = @_; my $class = ref $self || $self; return keys %{ $self->report_spec }; } sub load_fact_classes { my ($self) = @_; $self->_load_fact_class($_) for $self->fact_classes; return; } 1; # ABSTRACT: a base class for collections of Metabase facts __END__ =pod =encoding UTF-8 =head1 NAME Metabase::Report - a base class for collections of Metabase facts =head1 VERSION version 0.025 =head1 SYNOPSIS package MyReport; use Metabase::Report; our @ISA = qw/Metabase::Report/; __PACKAGE__->load_fact_classes; sub report_spec { return { 'Fact::One' => 1, # one of Fact::One 'Fact::Two' => "0+", # zero or more of Fact::Two } } =head1 DESCRIPTION L is a system for associating metadata with CPAN distributions. The metabase can be used to store test reports, reviews, coverage analysis reports, reports on static analysis of coding style, or anything else for which datatypes are constructed. Metabase::Report is a base class for collections of Metabase::Fact objects that can be sent to or retrieved from a Metabase system. Metabase::Report is itself a subclass of Metabase::Fact and offers the same API, except as described below. =head1 SUBCLASSING A subclass of Metabase::Report only requires one method, C>. =head1 ATTRIBUTES =head3 content The C attribute of a Report must be a reference to an array of Metabase::Fact subclass objects. =head1 METHODS In addition to the standard C constructor, the following C, C and C methods may be used to construct a report piecemeal, instead. =head2 open $report = Report::Subclass->open( id => 'AUTHORID/Foo-Bar-1.23.tar.gz', ); Constructs a new, empty report. The 'id' attribute is required. The 'refers_to' attribute is optional. The 'content' attribute may be provided, but see C below. No other attributes may be provided to C. =head2 add $report->add( 'Fact::Subclass' => $content ); Using the 'id' attribute of the report, this method constructs a new Fact from a class and a content argument. The resulting Fact is appended to the Report's content array. =head2 close $report->close; This method validates the report based on all Facts added so far. =head2 facts This method returns a list of all the facts in the report. In scalar context, it returns the number of facts in the report. =head1 CLASS METHODS =head2 fact_classes =head2 load_fact_classes Loads each class listed in the report spec. =head1 ABSTRACT METHODS Methods marked as 'required' must be implemented by a report subclass. (The version in Metabase::Report will die with an error if called.) In the documentation below, the terms 'must, 'must not', 'should', etc. have their usual RFC 2119 meanings. Methods MUST throw an exception if an error occurs. =head2 report_spec B $spec = Report::Subclass->report_spec; The C method MUST return a hash reference that defines how many Facts of which types must be in the report for it to be considered valid. Keys MUST be class names. Values MUST be non-negative integers that indicate the number of Facts of that type that must be present for a report to be valid, optionally followed by a '+' character to indicate that the report may contain more than the given number. For example: { Fact::One => 1, # one of Fact::One Fact::Two => "0+", # zero or more of Fact::Two } =head1 BUGS Please report any bugs or feature using the CPAN Request Tracker. Bugs can be submitted through the web interface at L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHORS =over 4 =item * David Golden =item * Ricardo Signes =item * H.Merijn Brand =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2016 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut Metabase-Fact-0.025/lib/Metabase/Resource/000755 000765 000024 00000000000 12664742761 020443 5ustar00davidstaff000000 000000 Metabase-Fact-0.025/lib/Metabase/Resource.pm000644 000765 000024 00000022173 12664742761 021006 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; package Metabase::Resource; our $VERSION = '0.025'; use Carp (); #--------------------------------------------------------------------------# # main API methods -- shouldn't be overridden #--------------------------------------------------------------------------# use overload ( '""' => sub { $_[0]->resource }, '==' => sub { _obj_eq(@_) }, '!=' => sub { !_obj_eq(@_) }, fallback => 1, ); # Check if two objects are the same object sub _obj_eq { return overload::StrVal( $_[0] ) eq overload::StrVal( $_[1] ); } my $id_re = qr/[_a-z]+/i; my $class_re = qr/^$id_re(?:::$id_re)*$/; sub _load { my ( $class, $subclass ) = @_; unless ( $subclass =~ $class_re ) { Carp::confess "'$subclass' does not look like a class name"; } eval "require $subclass; 1" ## no critic or Carp::confess("Could not load '$subclass': $@"); } my %installed; sub _add { my ( $self, $name, $value ) = @_; $self->{metadata}{$name} = $value; my $method = ref($self) . "::$name"; if ( !$installed{$method} ) { no strict 'refs'; ## no critic *{$method} = sub { return $_[0]->{metadata}{$name} }; $installed{$method}++; } return; } sub _type { my ($self) = @_; my $class = ref $self || $self; $class =~ s{::}{-}g; return $class; } sub new { my ( $class, $resource ) = @_; Carp::confess("no resource string provided") unless defined $resource && length $resource; if ( ref $resource && eval { $resource->isa('Metabase::Resource') } ) { $resource = $resource->resource; } # parse scheme my ($scheme) = $resource =~ m{\A([^:]+):}; Carp::confess("could not determine URI scheme from '$resource'\n") unless defined $scheme && length $scheme; my $schema_class = "Metabase::Resource::$scheme"; $class->_load($schema_class); my $type_class = $schema_class->_extract_type($resource); $class->_load($type_class); # construct object my $self = bless { resource => $resource, metadata => {}, }, $type_class; if ( $self->can('_init') ) { $self->_init; } $self->_add( type => $self->_type ); $self->validate; return $self; } # Don't cause segfault with perl-5.6.1 by # overloading undef stuff... sub resource { return '' unless ref $_[0] && defined $_[0]->{resource}; return "$_[0]->{resource}"; } # return a copy sub metadata { my ($self) = @_; return { %{ $self->{metadata} || {} } }; } sub metadata_types { my ($self) = @_; return { 'type' => '//str', %{ $self->_metadata_types || {} } }; } #--------------------------------------------------------------------------# # abstract methods -- fatal #--------------------------------------------------------------------------# sub validate { my ($self) = @_; Carp::confess "validate not implemented by " . ( ref $self || $self ); } 1; # ABSTRACT: factory class for Metabase resource descriptors __END__ =pod =encoding UTF-8 =head1 NAME Metabase::Resource - factory class for Metabase resource descriptors =head1 VERSION version 0.025 =head1 SYNOPSIS my $resource = Metabase::Resource->new( 'cpan:///distfile/RJBS/Metabase-Fact-0.001.tar.gz', ); my $resource_meta = $resource->metadata; my $typemap = $resource->metadata_types; =head1 DESCRIPTION L is a framework for associating metadata with arbitrary resources. A Metabase can be used to store test reports, reviews, coverage analysis reports, reports on static analysis of coding style, or anything else for which L types are constructed. Resources in Metabase are URI's that consist of a scheme and scheme specific information. For example, a standard URI framework for a CPAN distribution is defined by the L class. cpan:///distfile/RJBS/URI-cpan-1.000.tar.gz Metabase::Resource is a factory class for resource descriptors. It provide a common interface to extract scheme-specific indexing metadata from a scheme-specific resource subclass. For example, the L class will deconstruct the example above this into a Metabase resource metadata structure with the following elements: type => Metabase-Resource-cpan-distfile dist_file => RJBS/URI-cpan-1.000.tar.gz cpan_id => RJBS dist_name => URI-cpan dist_version => 1.000 Only the C field is mandatory for all resources. The other fields are all specific to Metabase::Resource::cpan. =head1 COMMON METHODS =head2 new my $resource = Metabase::Resource->new( 'cpan:///distfile/RJBS/Metabase-Fact-0.001.tar.gz', ); Takes a single resource string argument and constructs a new Resource object from a resource subtype determined by the URI scheme. Throws an error if the required resource subclass is not available. =head2 resource Returns the string used to initialize the resource object. =head2 scheme Returns a string containing the scheme. =head2 _cache (private) Returns a hash reference for subclasses to use to store data derived from the C string. =head1 OVERLOADING Resources have stringification overloaded to call C. Equality (==) and inequality (!=) are overloaded to perform string comparison instead. =head1 SUBCLASSING AND SUBCLASS METHODS Metabase::Resource relies on subclasses to implement scheme-specific parsing of the URI into relevant index metadata. Subclasses SHOULD NOT implement a C constructor, as the Metabase::Resource constructor will load the subclass, construct the object, bless the object into the subclass, and then call C on the object. Subclasses MAY store structured data derived from the content string during validation. Subclasses SHOULD use the C method to access the resource string and the C method to access the scheme. Subclasses MAY use the C<_cache> accessor to store derived metadata data. Subclasses MUST provide a C method to return data types for all elements stored in C<_cache>. All subclasses MUST implement the C, C and C methods, as described below. All methods MUST throw an exception if an error occurs. =head2 validate $resource->validate This method is called by the constructor. It SHOULD return true if the resource string is valid according to scheme-specific rules. It MUST die if the resource string is invalid. =head2 metadata $meta = $resource->metadata; This method MUST return a hash reference with resource-specific indexing metadata for the Resource. The key MUST be the name of the field for indexing. The C key MUST be present and the C value MUST be identical to the string from the C accessor. Other keys SHOULD provide dimensions to differentiate one resource from another in the context of C. If a scheme has subcategories, the key C SHOULD be used for the subcategory. Values MUST be simple scalars, not references. Here is a hypothetical example of a C function for a metabase user resource like 'metabase:user:ec2726a4-070c-11df-a2e0-0018f34ec37c': sub metadata { my $self = shift; my ($uuid) = $self =~ m{\Ametabase:user:(.+)\z}; return { scheme => 'metabase', type => 'user', user => $uuid, } } Field names should be valid perl identifiers, consisting of alphanumeric characters or underscores. Hyphens and periods are allowed, but are not recommended. =head2 metadata_types my $typemap = $resource->metadata_types; This method is used to identify the datatypes of keys in the data structure provided by C. It MUST return a hash reference. It SHOULD contain a key for every key that could appear in the data structure generated by C and provide a value corresponding to a datatype for each key. It MAY contain keys that do not always appear in the result of C. Data types are loosely based on L. Type SHOULD be one of the following: '//str' -- indicates a value that should be compared stringwise '//num' -- indicates a value that should be compared numerically Here is a hypothetical example of a C function for a metabase user resource like 'metabase:user:ec2726a4-070c-11df-a2e0-0018f34ec37c': sub metadata_types { return { scheme => '//str', type => '//str', user => '//str', } } Consumers of C SHOULD assume that any C key not found in the result of C is a '//str' resource. =head1 BUGS Please report any bugs or feature using the CPAN Request Tracker. Bugs can be submitted through the web interface at L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHORS =over 4 =item * David Golden =item * Ricardo Signes =item * H.Merijn Brand =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2016 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut Metabase-Fact-0.025/lib/Metabase/User/000755 000765 000024 00000000000 12664742761 017572 5ustar00davidstaff000000 000000 Metabase-Fact-0.025/lib/Metabase/User/EmailAddress.pm000644 000765 000024 00000002614 12664742761 022470 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; package Metabase::User::EmailAddress; our $VERSION = '0.025'; use Metabase::Fact::String; our @ISA = qw/Metabase::Fact::String/; 1; # ABSTRACT: Metabase fact for user email address __END__ =pod =encoding UTF-8 =head1 NAME Metabase::User::EmailAddress - Metabase fact for user email address =head1 VERSION version 0.025 =head1 SYNOPSIS my $email = Metabase::User::EmailAddress->new( resource => 'metabase:user:B66C7662-1D34-11DE-A668-0DF08D1878C0', content => 'jdoe@example.com', ); =head1 DESCRIPTION This is a simple string fact meant to be used to represent the email address of a user. At present, no email address validation is performed, but this may change in the future. =head1 BUGS Please report any bugs or feature using the CPAN Request Tracker. Bugs can be submitted through the web interface at L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHORS =over 4 =item * David Golden =item * Ricardo Signes =item * H.Merijn Brand =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2016 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut Metabase-Fact-0.025/lib/Metabase/User/FullName.pm000644 000765 000024 00000002424 12664742761 021635 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; package Metabase::User::FullName; our $VERSION = '0.025'; use Metabase::Fact::String; our @ISA = qw/Metabase::Fact::String/; 1; # ABSTRACT: Metabase fact for user full name __END__ =pod =encoding UTF-8 =head1 NAME Metabase::User::FullName - Metabase fact for user full name =head1 VERSION version 0.025 =head1 SYNOPSIS my $email = Metabase::User::FullName->new( resource => 'metabase:user:B66C7662-1D34-11DE-A668-0DF08D1878C0', content => 'John Doe', ); =head1 DESCRIPTION This is just a simple string fact that stores the real name of a user in his profile. =head1 BUGS Please report any bugs or feature using the CPAN Request Tracker. Bugs can be submitted through the web interface at L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHORS =over 4 =item * David Golden =item * Ricardo Signes =item * H.Merijn Brand =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2016 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut Metabase-Fact-0.025/lib/Metabase/User/Profile.pm000644 000765 000024 00000007565 12664742761 021545 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; package Metabase::User::Profile; our $VERSION = '0.025'; use Carp (); use Data::GUID guid_string => { -as => '_guid' }; use Metabase::Report; our @ISA = qw/Metabase::Report/; __PACKAGE__->load_fact_classes; #--------------------------------------------------------------------------# # public API #--------------------------------------------------------------------------# sub create { my ( $class, @args ) = @_; my $args = $class->__validate_args( \@args, { full_name => 1, email_address => 1, } ); # resource string must reference our own guid, so pregenerate it my $guid = lc _guid(); my $profile = $class->open( guid => $guid, resource => "metabase:user:$guid", ); # we are our own creator $profile->set_creator( $profile->resource ); # add facts $profile->add( 'Metabase::User::FullName' => $args->{full_name} ); $profile->add( 'Metabase::User::EmailAddress' => $args->{email_address} ); $profile->close; return $profile; } #--------------------------------------------------------------------------# # internals #--------------------------------------------------------------------------# sub validate_resource { my ($self) = shift; my $resource = $self->SUPER::validate_resource(@_); my ($guid) = $resource->guid; Carp::confess "resource guid differs from fact guid" if $guid ne $self->guid; return $resource; } sub report_spec { return { 'Metabase::User::FullName' => '1', 'Metabase::User::EmailAddress' => '1+', }; } 1; # ABSTRACT: Metabase report class for user-related facts __END__ =pod =encoding UTF-8 =head1 NAME Metabase::User::Profile - Metabase report class for user-related facts =head1 VERSION version 0.025 =head1 SYNOPSIS use Metabase::User::Profile; my $profile = Metabase::User::Profile->create( full_name => 'John Doe', email_address => 'jdoe@example.com', ); =head1 DESCRIPTION Metabase report class encapsulating Facts about a metabase user =head1 USAGE =head2 The short way my $profile = Metabase::User::Profile->create( full_name => 'John Doe', email_address => 'jdoe@example.com', ); =head2 The long way my $profile = Metabase::User::Profile->open( resource => 'metabase:user:b66c7662-1d34-11de-a668-0df08d1878c0' creator => 'metabase:user:b66c7662-1d34-11de-a668-0df08d1878c0' ); $profile->add( 'Metabase::User::EmailAddress' => 'jdoe@example.com' ); $profile->add( 'Metabase::User::FullName' => 'John Doe' ); $profile->close; =head1 METHODS =head2 create my $new_profile = Metabase::User::Profile->create(%arg); This method creates a new user profile object from the given parameters. Valid parameters include: full_name - the user's full name email_address - the user's email address =head2 load my $profile = Metabase::User::Profile->load($filename); This method loads a profile from disk and returns it. =head2 save $profile->save($filename); This method writes out the profile to a file. If the file cannot be written, an exception is raised. If the save is successful, a true value is returned. =head1 BUGS Please report any bugs or feature using the CPAN Request Tracker. Bugs can be submitted through the web interface at L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHORS =over 4 =item * David Golden =item * Ricardo Signes =item * H.Merijn Brand =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2016 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut Metabase-Fact-0.025/lib/Metabase/User/Secret.pm000644 000765 000024 00000002763 12664742761 021365 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; package Metabase::User::Secret; our $VERSION = '0.025'; use Metabase::Fact::String; our @ISA = qw/Metabase::Fact::String/; sub new { my $class = shift; my $self = $class->SUPER::new(@_); $self->set_creator( $self->resource ) unless $self->creator; return $self; } 1; # ABSTRACT: Metabase fact for user shared authentication secret __END__ =pod =encoding UTF-8 =head1 NAME Metabase::User::Secret - Metabase fact for user shared authentication secret =head1 VERSION version 0.025 =head1 SYNOPSIS my $secret = Metabase::User::Secret->new( resource => 'metabase:user:B66C7662-1D34-11DE-A668-0DF08D1878C0', content => 'aixuZuo8', ); =head1 DESCRIPTION This fact is a simple string, storing the shared secret that will be used to authenticate user during fact submission. =head1 BUGS Please report any bugs or feature using the CPAN Request Tracker. Bugs can be submitted through the web interface at L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHORS =over 4 =item * David Golden =item * Ricardo Signes =item * H.Merijn Brand =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2016 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut Metabase-Fact-0.025/lib/Metabase/Resource/cpan/000755 000765 000024 00000000000 12664742761 021364 5ustar00davidstaff000000 000000 Metabase-Fact-0.025/lib/Metabase/Resource/cpan.pm000644 000765 000024 00000004003 12664742761 021717 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; package Metabase::Resource::cpan; our $VERSION = '0.025'; use Carp (); use Metabase::Resource; our @ISA = qw/Metabase::Resource/; sub _extract_type { my ( $self, $resource ) = @_; my ($type) = $resource =~ m{\Acpan:///([^/]+)/}; Carp::confess("could not determine Metabase::Resource type from '$resource'\n") unless defined $type && length $type; return __PACKAGE__ . "::$type"; } 1; # ABSTRACT: class for Metabase resources __END__ =pod =encoding UTF-8 =head1 NAME Metabase::Resource::cpan - class for Metabase resources =head1 VERSION version 0.025 =head1 SYNOPSIS my $resource = Metabase::Resource->new( 'cpan:///distfile/RJBS/Metabase-Fact-0.001.tar.gz', ); my $resource_meta = $resource->metadata; my $typemap = $resource->metadata_types; =head1 DESCRIPTION Generates resource metadata for resources of the scheme 'cpan'. The L class supports the following sub-type(s). =head2 distfile my $resource = Metabase::Resource->new( 'cpan:///distfile/RJBS/URI-cpan-1.000.tar.gz', ); For the example above, the resource metadata structure would contain the following elements: scheme => cpan type => distfile dist_file => RJBS/URI-cpan-1.000.tar.gz cpan_id => RJBS dist_name => URI-cpan dist_version => 1.000 =head1 BUGS Please report any bugs or feature using the CPAN Request Tracker. Bugs can be submitted through the web interface at L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHORS =over 4 =item * David Golden =item * Ricardo Signes =item * H.Merijn Brand =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2016 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut Metabase-Fact-0.025/lib/Metabase/Resource/metabase/000755 000765 000024 00000000000 12664742761 022224 5ustar00davidstaff000000 000000 Metabase-Fact-0.025/lib/Metabase/Resource/metabase.pm000644 000765 000024 00000005354 12664742761 022571 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; package Metabase::Resource::metabase; our $VERSION = '0.025'; use Carp (); use Metabase::Resource; our @ISA = qw/Metabase::Resource/; my $hex = '[0-9a-f]'; my $guid_re = qr(\A$hex{8}-$hex{4}-$hex{4}-$hex{4}-$hex{12}\z)i; sub _validate_guid { my ( $self, $string ) = @_; if ( $string !~ $guid_re ) { Carp::confess("'$string' is not formatted as a GUID string"); } return $string; } sub _extract_type { my ( $self, $resource ) = @_; # determine type my ($type) = $resource =~ m{\Ametabase:([^:]+)}; Carp::confess("could not determine URI type from '$resource'\n") unless defined $type && length $type; return __PACKAGE__ . "::$type"; } 1; # ABSTRACT: class for Metabase resources __END__ =pod =encoding UTF-8 =head1 NAME Metabase::Resource::metabase - class for Metabase resources =head1 VERSION version 0.025 =head1 SYNOPSIS my $resource = Metabase::Resource->new( "metabase:user:B66C7662-1D34-11DE-A668-0DF08D1878C0" ); my $resource_meta = $resource->metadata; my $typemap = $resource->metadata_types; =head1 DESCRIPTION Generates resource metadata for resources of the scheme 'metabase'. The L class supports the following sub-type(s). =head2 fact my $resource = Metabase::Resource->new( "metabase:fact:bd83d51e-0eea-11df-8413-0018f34ec37c" ); This resource is for a generic Metabase Fact. (I.e. for a Fact about another Fact). For the example above, the resource metadata structure would contain the following elements: scheme => metabase type => user fact => bd83d51e-0eea-11df-8413-0018f34ec37c =head2 user my $resource = Metabase::Resource->new( "metabase:user:b66c7662-1d34-11de-a668-0df08d1878c0" ); This resource is for a Metabase user. (I.e. corresponding to the GUID of a Metabase::User::Profile.) For the example above, the resource metadata structure would contain the following elements: scheme => metabase subtype => user user => b66c7662-1d34-11de-a668-0df08d1878c0 =head1 BUGS Please report any bugs or feature using the CPAN Request Tracker. Bugs can be submitted through the web interface at L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHORS =over 4 =item * David Golden =item * Ricardo Signes =item * H.Merijn Brand =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2016 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut Metabase-Fact-0.025/lib/Metabase/Resource/perl/000755 000765 000024 00000000000 12664742761 021405 5ustar00davidstaff000000 000000 Metabase-Fact-0.025/lib/Metabase/Resource/perl.pm000644 000765 000024 00000004053 12664742761 021745 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; package Metabase::Resource::perl; our $VERSION = '0.025'; use Carp (); use Metabase::Resource; our @ISA = qw/Metabase::Resource/; sub _extract_type { my ( $self, $resource ) = @_; # determine type # Possible types could be: # - commit # - tag -- not implemented # - tarball -- not implemented my ($type) = $resource =~ m{\Aperl:///([^/]+)/}; Carp::confess("could not determine Metabase::Resource type from '$resource'\n") unless defined $type && length $type; return __PACKAGE__ . "::$type"; } 1; # ABSTRACT: class for Metabase resources under the perl scheme __END__ =pod =encoding UTF-8 =head1 NAME Metabase::Resource::perl - class for Metabase resources under the perl scheme =head1 VERSION version 0.025 =head1 SYNOPSIS my $resource = Metabase::Resource->new( 'perl:///commit/8c576062', ); my $resource_meta = $resource->metadata; my $typemap = $resource->metadata_types; =head1 DESCRIPTION Generates resource metadata for resources of the scheme 'perl'. The L class supports the following sub-type(s). =head2 commit my $resource = Metabase::Resource->new( 'perl:///commit/8c576062', ); For the example above, the resource metadata structure would contain the following elements: scheme => perl type => commit sha1 => 8c576062 =head1 BUGS Please report any bugs or feature using the CPAN Request Tracker. Bugs can be submitted through the web interface at L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHORS =over 4 =item * David Golden =item * Ricardo Signes =item * H.Merijn Brand =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2016 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut Metabase-Fact-0.025/lib/Metabase/Resource/perl/commit.pm000644 000765 000024 00000007375 12664742761 023247 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; package Metabase::Resource::perl::commit; our $VERSION = '0.025'; use Carp (); use Metabase::Resource::perl; our @ISA = qw/Metabase::Resource::perl/; sub _metadata_types { return { sha1 => '//str', }; } sub _init { my ($self) = @_; my ($string) = $self =~ m{\Aperl:///commit/(.+)\z}; Carp::confess("could not determine commit from '$self'\n") unless defined $string && length $string; my $sha1 = $1; Carp::confess("illegal commit hash") unless $sha1 =~ m/^[a-f0-9]+$/; $self->_add( 'sha1' => $sha1 ); return $self; } #pod =method full_url #pod #pod my $url = $self->full_url($host); #pod #pod Returns an ordinary HTTP URL to the resource. If C<$host> is not #pod given, it defaults to the official master Perl repository at #pod L. #pod #pod =cut sub full_url { my ( $self, $host ) = @_; $host ||= 'perl5.git.perl.org'; return "http://${host}/perl.git/" . $self->sha1; } # 'commit' validates during _init, really sub validate { 1 } #pod =pod #pod #pod =head1 SYNOPSIS #pod #pod my $resource = Metabase::Resource->new( #pod 'perl:///commit/8c576062', #pod ); #pod #pod my $resource_meta = $resource->metadata; #pod my $typemap = $resource->metadata_types; #pod my $url = $self->full_url; #pod #pod =head1 DESCRIPTION #pod #pod Generates resource metadata for resources of the scheme 'perl:///commit'. #pod #pod my $resource = Metabase::Resource->new( #pod 'perl:///commit/8c576062', #pod ); #pod #pod For the example above, the resource metadata structure would contain the #pod following elements: #pod #pod scheme => perl #pod type => commit #pod sha1 => 8c576062 #pod #pod =head1 BUGS #pod #pod Please report any bugs or feature using the CPAN Request Tracker. #pod Bugs can be submitted through the web interface at #pod L #pod #pod When submitting a bug or request, please include a test-file or a patch to an #pod existing test-file that illustrates the bug or desired feature. #pod #pod =cut 1; # ABSTRACT: class for Metabase resources about perl commits __END__ =pod =encoding UTF-8 =head1 NAME Metabase::Resource::perl::commit - class for Metabase resources about perl commits =head1 VERSION version 0.025 =head1 SYNOPSIS my $resource = Metabase::Resource->new( 'perl:///commit/8c576062', ); my $resource_meta = $resource->metadata; my $typemap = $resource->metadata_types; my $url = $self->full_url; =head1 DESCRIPTION Generates resource metadata for resources of the scheme 'perl:///commit'. my $resource = Metabase::Resource->new( 'perl:///commit/8c576062', ); For the example above, the resource metadata structure would contain the following elements: scheme => perl type => commit sha1 => 8c576062 =head1 METHODS =head2 full_url my $url = $self->full_url($host); Returns an ordinary HTTP URL to the resource. If C<$host> is not given, it defaults to the official master Perl repository at L. =head1 BUGS Please report any bugs or feature using the CPAN Request Tracker. Bugs can be submitted through the web interface at L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHORS =over 4 =item * David Golden =item * Ricardo Signes =item * H.Merijn Brand =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2016 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut Metabase-Fact-0.025/lib/Metabase/Resource/metabase/fact.pm000644 000765 000024 00000003755 12664742761 023511 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; package Metabase::Resource::metabase::fact; our $VERSION = '0.025'; use Carp (); use Metabase::Resource::metabase; our @ISA = qw/Metabase::Resource::metabase/; sub _metadata_types { return { guid => '//str', }; } sub _init { my ($self) = @_; my ($guid) = $self =~ m{\Ametabase:[^:]+:(.+)\z}; Carp::confess("could not determine guid from '$self'\n") unless defined $guid && length $guid; $self->_add( guid => $guid ); return $self; } sub validate { my $self = shift; $self->_validate_guid( $self->guid ); return 1; } 1; # ABSTRACT: class for Metabase facts __END__ =pod =encoding UTF-8 =head1 NAME Metabase::Resource::metabase::fact - class for Metabase facts =head1 VERSION version 0.025 =head1 SYNOPSIS my $resource = Metabase::Resource->new( "metabase:fact:B66C7662-1D34-11DE-A668-0DF08D1878C0" ); my $resource_meta = $resource->metadata; my $typemap = $resource->metadata_types; my $user_id = $resource->guid; =head1 DESCRIPTION This resource is for a Metabase fact. (I.e. corresponding to the GUID of a Metabase::Fact subclass.) For the example above, the resource metadata structure would contain the following elements: scheme => metabase subtype => subtype guid => b66c7662-1d34-11de-a668-0df08d1878c0 =head1 BUGS Please report any bugs or feature using the CPAN Request Tracker. Bugs can be submitted through the web interface at L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHORS =over 4 =item * David Golden =item * Ricardo Signes =item * H.Merijn Brand =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2016 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut Metabase-Fact-0.025/lib/Metabase/Resource/metabase/user.pm000644 000765 000024 00000003147 12664742761 023545 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; package Metabase::Resource::metabase::user; our $VERSION = '0.025'; use Metabase::Resource::metabase::fact; our @ISA = qw/Metabase::Resource::metabase::fact/; 1; # ABSTRACT: class for Metabase user profiles __END__ =pod =encoding UTF-8 =head1 NAME Metabase::Resource::metabase::user - class for Metabase user profiles =head1 VERSION version 0.025 =head1 SYNOPSIS my $resource = Metabase::Resource->new( "metabase:user:B66C7662-1D34-11DE-A668-0DF08D1878C0" ); my $resource_meta = $resource->metadata; my $typemap = $resource->metadata_types; my $user_id = $resource->guid; =head1 DESCRIPTION This resource is for a Metabase user. (I.e. corresponding to the GUID of a Metabase::User::Profile.) For the example above, the resource metadata structure would contain the following elements: scheme => metabase type => user guid => b66c7662-1d34-11de-a668-0df08d1878c0 =head1 BUGS Please report any bugs or feature using the CPAN Request Tracker. Bugs can be submitted through the web interface at L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHORS =over 4 =item * David Golden =item * Ricardo Signes =item * H.Merijn Brand =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2016 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut Metabase-Fact-0.025/lib/Metabase/Resource/cpan/distfile.pm000644 000765 000024 00000006425 12664742761 023534 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; package Metabase::Resource::cpan::distfile; our $VERSION = '0.025'; use Carp (); use CPAN::DistnameInfo (); use Metabase::Resource::cpan; our @ISA = qw/Metabase::Resource::cpan/; sub _metadata_types { return { cpan_id => '//str', dist_file => '//str', dist_name => '//str', dist_version => '//str', }; } sub _init { my ($self) = @_; # determine subtype my ($string) = $self =~ m{\Acpan:///distfile/(.+)\z}; Carp::confess("could not determine distfile from '$self'\n") unless defined $string && length $string; my $data = $self->_validate_distfile($string); for my $k ( keys %$data ) { $self->_add( $k => $data->{$k} ); } return $self; } # distfile validates during _init, really sub validate { 1 } # XXX should really validate AUTHOR/DISTNAME-DISTVERSION.SUFFIX # -- dagolden, 2010-01-27 # # my $suffix = qr{\.(?:tar\.(?:bz2|gz|Z)|t(?:gz|bz)|zip)}; # # for now, we'll use CPAN::DistnameInfo; # # map DistnameInfo calls to our names my %distfile_map = ( cpanid => 'cpan_id', dist => 'dist_name', version => 'dist_version', ); sub _validate_distfile { my ( $self, $string ) = @_; my $two = substr( $string, 0, 2 ); my $one = substr( $two, 0, 1 ); my $path = "authors/id/$one/$two/$string"; my $d = eval { CPAN::DistnameInfo->new($path) }; my $bad = defined $d ? 0 : 1; my $cache = { dist_file => $string }; for my $k ( $bad ? () : ( keys %distfile_map ) ) { my $value = $d->$k; defined $value or $bad++ and last; $cache->{ $distfile_map{$k} } = $value; } if ($bad) { Carp::confess("'$string' can't be parsed as a CPAN distfile"); } return $cache; } 1; # ABSTRACT: class for Metabase resources __END__ =pod =encoding UTF-8 =head1 NAME Metabase::Resource::cpan::distfile - class for Metabase resources =head1 VERSION version 0.025 =head1 SYNOPSIS my $resource = Metabase::Resource->new( 'cpan:///distfile/RJBS/Metabase-Fact-0.001.tar.gz', ); my $resource_meta = $resource->metadata; my $typemap = $resource->metadata_types; =head1 DESCRIPTION Generates resource metadata for resources of the scheme 'cpan:///distfile'. my $resource = Metabase::Resource->new( 'cpan:///distfile/RJBS/URI-cpan-1.000.tar.gz', ); For the example above, the resource metadata structure would contain the following elements: scheme => cpan type => distfile dist_file => RJBS/URI-cpan-1.000.tar.gz cpan_id => RJBS dist_name => URI-cpan dist_version => 1.000 =head1 BUGS Please report any bugs or feature using the CPAN Request Tracker. Bugs can be submitted through the web interface at L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHORS =over 4 =item * David Golden =item * Ricardo Signes =item * H.Merijn Brand =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2016 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut Metabase-Fact-0.025/lib/Metabase/Fact/Hash.pm000644 000765 000024 00000007566 12664742761 020770 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; package Metabase::Fact::Hash; our $VERSION = '0.025'; use Carp (); use JSON::MaybeXS (); use Metabase::Fact; our @ISA = qw/Metabase::Fact/; sub validate_content { my ($self) = @_; my $content = $self->content; my $class = ref $self; Carp::confess "content must be a hashref" unless ref $content eq 'HASH'; my $get_req = $self->can('required_keys') || sub { () }; my $get_opt = $self->can('optional_keys') || sub { () }; # find missing my @missing = grep { !exists $content->{$_} } $get_req->(); Carp::croak "missing required keys for $class\: @missing\n" if @missing; # check for invalid my %valid = map { $_ => 1 } ( $get_req->(), $get_opt->() ); my @invalid = grep { !exists $valid{$_} } keys %$content; Carp::croak "invalid keys for $class\: @invalid\n" if @invalid; return 1; } sub content_as_bytes { my ($self) = @_; return JSON::MaybeXS->new(ascii => 1)->encode( $self->content ); } sub content_from_bytes { my ( $class, $bytes ) = @_; return JSON::MaybeXS->new(ascii => 1)->decode($bytes); } 1; # ABSTRACT: fact subtype for simple hashes __END__ =pod =encoding UTF-8 =head1 NAME Metabase::Fact::Hash - fact subtype for simple hashes =head1 VERSION version 0.025 =head1 SYNOPSIS # defining the fact class package MyComment; use Metabase::Fact::Hash; our @ISA = qw/Metabase::Fact::Hash/; sub required_keys { qw/poster/ } sub optional_keys { qw/comment/ } sub content_metadata { my $self = shift; return { poster => [ '//str' => $self->content->{poster} ], }; } sub validate_content { my $self = shift; $self->SUPER::validate_content; # required and optional keys # other analysis of values } ...and then... # using the fact class my $fact = MyFact->new( resource => 'RJBS/Metabase-Fact-0.001.tar.gz', content => { poster => 'larry', comment => 'Metabase rocks!', } ); $client->send_fact($fact); =head1 DESCRIPTION Many (if not most) facts to be stored in a Metabase are just hashes of simple data. Metabase::Fact::Hash is a subclass of L with most of the required Fact methods already implemented. If you write your class as a subclass of Metabase::Fact::Hash, you can store simple hashes in it. You should implement C and/or C as shown in the SYNOPSIS. The superclass C will ensure that required keys exist and that only required an optional keys exist. You may wish to subclass C to validate the specific content of the hash given to the constructor. You may wish to implement a C method to generate metadata about the hash contents. =head1 ATTRIBUTES =head2 Arguments provided to new =head3 resource B The canonical resource (URI) the Fact relates to. For CPAN distributions, this would be a C URL. (See L.) =head3 content B A reference to the actual information associated with the fact. The exact form of the content is up to each Fact class to determine. =head1 METHODS For information on the methods provided by this class, see L. =head1 BUGS Please report any bugs or feature using the CPAN Request Tracker. Bugs can be submitted through the web interface at L When submitting a bug or request, please include a test file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHORS =over 4 =item * David Golden =item * Ricardo Signes =item * H.Merijn Brand =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2016 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut Metabase-Fact-0.025/lib/Metabase/Fact/String.pm000644 000765 000024 00000004747 12664742761 021351 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; package Metabase::Fact::String; our $VERSION = '0.025'; use Carp (); use Metabase::Fact; our @ISA = qw/Metabase::Fact/; # document that content must be characters, not bytes -- dagolden, 2009-03-28 sub validate_content { my ($self) = @_; Carp::confess "content must be scalar value" unless defined $self->content && ref \( $self->content ) eq 'SCALAR'; } sub content_as_bytes { my ($self) = @_; my $bytes = $self->content; utf8::encode($bytes) if $] ge '5.008'; # converts in-place return $bytes; } sub content_from_bytes { my ( $class, $bytes ) = @_; utf8::decode($bytes) if $] ge '5.008'; # converts in-place return $bytes; } 1; # ABSTRACT: fact subtype for simple strings __END__ =pod =encoding UTF-8 =head1 NAME Metabase::Fact::String - fact subtype for simple strings =head1 VERSION version 0.025 =head1 SYNOPSIS # defining the fact class package MyFact; use Metabase::Fact::String; our @ISA = qw/Metabase::Fact::String/; sub content_metadata { my $self = shift; return { 'size' => [ '//num' => length $self->content ], }; } sub validate_content { my $self = shift; $self->SUPER::validate_content; die __PACKAGE__ . " content length must be greater than zero\n" if length $self->content < 0; } ...and then... # using the fact class my $fact = MyFact->new( resource => 'RJBS/Metabase-Fact-0.001.tar.gz', content => "Hello World", ); $client->send_fact($fact); =head1 DESCRIPTION Base class for facts that are just strings of text. Strings must be characters, not bytes. You may wish to implement a C method to generate metadata about the hash contents. You should also implement a C method to validate the structure of the hash you're given. =head1 BUGS Please report any bugs or feature using the CPAN Request Tracker. Bugs can be submitted through the web interface at L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHORS =over 4 =item * David Golden =item * Ricardo Signes =item * H.Merijn Brand =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2016 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut Metabase-Fact-0.025/bin/metabase-profile000644 000765 000024 00000007131 12664742761 020301 0ustar00davidstaff000000 000000 #!/usr/bin/perl use 5.006; use strict; use warnings; package metabase_profile; # dzil needs this # PODNAME: metabase-profile # ABSTRACT: create a metabase profile our $VERSION = '0.025'; use Getopt::Long; use JSON::MaybeXS (); use Metabase::User::Profile; use Metabase::User::Secret; use Pod::Usage; use IO::Prompt::Tiny qw(prompt); my ( %profile, $help, $output, $full_name, $email_address, $password ); my $result = GetOptions( 'help|h' => \$help, 'output|o:s' => \$output, 'name:s' => \$full_name, 'email:s' => \$email_address, 'secret:s' => \$password, ); pod2usage( { -verbose => 2 } ) if !$result || $help; # setup output file and confirm it doesn't exist if ( !defined $output ) { $output = "metabase_id.json"; } if ( -f $output ) { die "Won't over-write existing '$output' file. Aborting.\n"; } # get profile information $profile{full_name} = $full_name if defined $full_name; $profile{email_address} = $email_address if defined $email_address; $profile{password} = $password if defined $password; my @prompts = ( full_name => 'full name', email_address => 'email address', password => 'password/secret', ); while (@prompts) { my ( $key, $phrase ) = splice( @prompts, 0, 2 ); next if $profile{$key}; chomp( my $answer = prompt("Enter $phrase\: ") ); $profile{$key} = $answer; } # create profile and secret objects $password = delete $profile{password}; my $profile = Metabase::User::Profile->create(%profile); my $secret = Metabase::User::Secret->new( resource => $profile->resource, content => $password, ); # write output print "Writing profile to '$output'\n"; open my $fh, ">", $output; print {$fh} JSON::MaybeXS->new(ascii => 1, pretty => 1)->encode( [ $profile->as_struct, $secret->as_struct, ] ); close $fh; chmod 0600, $output; __END__ =pod =encoding UTF-8 =head1 NAME metabase-profile - create a metabase profile =head1 VERSION version 0.025 =head1 SYNOPSIS $ metabase-profile Enter full name: John Doe Enter email address: jdoe@example.com Enter password/secret: zqxjkh Writing profile to 'metabase_id.json' =head1 USAGE The metabase-profile program makes it easy to create a user profile for submitting facts and reports to a Metabase server. Valid options include: --email ADDRESS user email address eg "jd@example.com" --name FULLNAME full user name, eg "John Doe" -o, --output FILENAME output filename --secret PASSWORD password for authentication -h, --help print man page If no output file name is given, the default name 'metabase_id.json' will be used. If the output filename (or default) exists, the program will abort rather than overwrite the file. The output file will be in JSON and contain the user profile and the user's shared secret. Typically, when a Metabase server first receives a report from a new user profile, the shared secret is recorded and will be used to authenticate subsequent submissions. The output should not be shared publicly or made group or world readable. Use the resulting file according to the instructions of your Metabase client program. You may wish to copy it across computers if you would like to be identified consistently when submitting reports from different locations. =head1 AUTHORS =over 4 =item * David Golden =item * Ricardo Signes =item * H.Merijn Brand =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2016 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut