App-CELL-0.222000755001750000144 012766160463 13301 5ustar00smithfarmusers000000000000App-CELL-0.222/README.rst000444001750000144 100512766160463 15121 0ustar00smithfarmusers000000000000========= App::CELL ========= .. image:: https://travis-ci.org/smithfarm/cell.svg?branch=master :target: https://travis-ci.org/smithfarm/cell .. image:: https://badge.fury.io/pl/App-CELL.svg :target: https://badge.fury.io/pl/App-CELL -------------------------------------------------------------------- Configuration, Error-handling, Localization, and Logging "framework" -------------------------------------------------------------------- Documentation ============= http://metacpan.org/pod/App::CELL App-CELL-0.222/MANIFEST.SKIP000444001750000144 252112766160463 15334 0ustar00smithfarmusers000000000000#!start included /usr/lib/perl5/5.18.1/ExtUtils/MANIFEST.SKIP # Avoid version control files. \bRCS\b \bCVS\b \bSCCS\b ,v$ \B\.svn\b \B\.git\b \B\.gitignore\b \b_darcs\b \B\.cvsignore$ # Avoid VMS specific MakeMaker generated files \bDescrip.MMS$ \bDESCRIP.MMS$ \bdescrip.mms$ # Avoid Makemaker generated and utility files. \bMANIFEST\.bak \bMakefile$ \bblib/ \bMakeMaker-\d \bpm_to_blib\.ts$ \bpm_to_blib$ \bblibdirs\.ts$ # 6.18 through 6.25 generated this # Avoid Module::Build generated and utility files. \bBuild$ \b_build/ \bBuild.bat$ \bBuild.COM$ \bBUILD.COM$ \bbuild.com$ # Avoid temp and backup files. ~$ \.old$ \#$ \b\.# \.bak$ \.tmp$ \.# \.rej$ # Avoid OS-specific files/dirs # Mac OSX metadata \B\.DS_Store # Mac OSX SMB mount metadata files \B\._ # Avoid Devel::Cover and Devel::CoverX::Covered files. \bcover_db\b \bcovered\b # Avoid MYMETA files ^MYMETA\. #!end included /usr/lib/perl5/5.18.1/ExtUtils/MANIFEST.SKIP # Avoid configuration metadata file ^MYMETA\. # Avoid Module::Build generated and utility files. \bBuild$ \bBuild.bat$ \b_build \bBuild.COM$ \bBUILD.COM$ \bbuild.com$ ^MANIFEST\.SKIP # Avoid archives of this distribution \bApp-Dochazka-Common-[\d\.\_]+ # Avoid release script helper files \bCPAN_NAME$ \bOBS_PROJECT$ \bVERSION_MODULE$ # Avoid perlcritic, travis config files \B\.perlcriticrc\b \B\.travis.yml\b App-CELL-0.222/Makefile.PL000444001750000144 201212766160463 15403 0ustar00smithfarmusers000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4205 require 5.012; use ExtUtils::MakeMaker; use File::ShareDir::Install; install_share dist => 'config'; WriteMakefile( 'NAME' => 'App::CELL', 'VERSION_FROM' => 'lib/App/CELL.pm', 'PREREQ_PM' => { 'Date::Format' => 0, 'File::HomeDir' => 0, 'File::Next' => 0, 'File::ShareDir' => '1.00', 'File::ShareDir::Install' => '0.11', 'File::Spec' => 0, 'File::Temp' => 0, 'Log::Any' => 0, 'Log::Any::Adapter' => '0.1', 'Log::Any::Test' => 0, 'Params::Validate' => 0, 'Test::Warnings' => 0, 'Try::Tiny' => 0 }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [ 'bin/CELLdemo.plx' ], 'PL_FILES' => {} ); package App::CELL; use File::ShareDir::Install qw(postamble); App-CELL-0.222/Build.PL000444001750000144 276412766160463 14743 0ustar00smithfarmusers000000000000#!/usr/bin/perl use 5.012000; # CPAN Testers use strict; use warnings; use Module::Build; my $build = Module::Build->new( module_name => 'App::CELL', dist_author => q{Smithfarm }, dist_version_from => 'lib/App/CELL.pm', license => 'bsd', create_license => 0, create_readme => 0, share_dir => { dist => [ 'config' ], }, configure_requires => { 'Module::Build' => 0, 'Software::License' => 0, }, build_requires => { 'Log::Any::Test' => 0, 'File::ShareDir::Install' => 0.11, 'File::Spec' => 0, 'File::Temp' => 0, 'Params::Validate' => 0, 'Test::Warnings' => 0, 'Try::Tiny' => 0, }, requires => { 'perl' => 5.012, 'Date::Format' => 0, 'File::HomeDir' => 0, 'File::ShareDir' => 1.0, 'File::Next' => 0, 'Log::Any' => 0, 'Log::Any::Adapter' => 0.10, 'Params::Validate' => 0, 'Try::Tiny' => 0, }, meta_merge => { resources => { repository => 'https://github.com/smithfarm/cell', bugtracker => 'https://github.com/smithfarm/cell/issues', } }, add_to_cleanup => [ 'App-CELL-*' ], # create_makefile_pl => 'traditional', ); $build->create_build_script; App-CELL-0.222/META.json000444001750000144 474012766160463 15064 0ustar00smithfarmusers000000000000{ "abstract" : "Configuration, Error-handling, Localization, and Logging", "author" : [ "Smithfarm " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4205", "license" : [ "bsd" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "App-CELL", "prereqs" : { "build" : { "requires" : { "File::ShareDir::Install" : "0.11", "File::Spec" : "0", "File::Temp" : "0", "Log::Any::Test" : "0", "Params::Validate" : "0", "Test::Warnings" : "0", "Try::Tiny" : "0" } }, "configure" : { "requires" : { "Module::Build" : "0", "Software::License" : "0" } }, "runtime" : { "requires" : { "Date::Format" : "0", "File::HomeDir" : "0", "File::Next" : "0", "File::ShareDir" : "1", "Log::Any" : "0", "Log::Any::Adapter" : "0.1", "Params::Validate" : "0", "Try::Tiny" : "0", "perl" : "5.012" } } }, "provides" : { "App::CELL" : { "file" : "lib/App/CELL.pm", "version" : "0.222" }, "App::CELL::Config" : { "file" : "lib/App/CELL/Config.pm" }, "App::CELL::Guide" : { "file" : "lib/App/CELL/Guide.pm", "version" : "0.222" }, "App::CELL::Load" : { "file" : "lib/App/CELL/Load.pm" }, "App::CELL::Log" : { "file" : "lib/App/CELL/Log.pm" }, "App::CELL::Message" : { "file" : "lib/App/CELL/Message.pm" }, "App::CELL::Status" : { "file" : "lib/App/CELL/Status.pm" }, "App::CELL::Test" : { "file" : "lib/App/CELL/Test.pm" }, "App::CELL::Test::LogToFile" : { "file" : "lib/App/CELL/Test/LogToFile.pm" }, "App::CELL::Util" : { "file" : "lib/App/CELL/Util.pm" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/smithfarm/cell/issues" }, "license" : [ "http://opensource.org/licenses/bsd-license.php" ], "repository" : { "url" : "https://github.com/smithfarm/cell" } }, "version" : "0.222", "x_serialization_backend" : "JSON::PP version 2.27203" } App-CELL-0.222/LICENSE000444001750000144 306712766160463 14451 0ustar00smithfarmusers000000000000Copyright (c) 2014-2015, SUSE LLC All rights reserved. This is free software, licensed under: The (three-clause) BSD License The BSD License Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of SUSE LLC nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. App-CELL-0.222/WISHLIST000444001750000144 234212766160463 14630 0ustar00smithfarmusers000000000000MIGHT IMPLEMENT SOMEDAY 20140526 release.sh process multiple arguments (ATM it takes only one) 20140529 Status.pm: 'ok' and 'not_ok' methods are almost identical - use a "subroutine factory" to generate them 20140529 Guide.pm: write verbiage about how statuses are for handling expected errors. It's still OK to croak if something unexpected happens. 20140609 If sitedir is passed to load routine by argument or environment variable, return an error status if sitedir not loaded 20140610 Clarify that messages cannot be overwritten 20140610 Implement Status.pm->dump (currently just a stub) 20140610 Change debug_mode to log_level (for finer granularity of control) 20140613 Log.pm: add a check for (caller)[0] -- if being called from App::CELL itself, check a flag that toggles _all_ App::CELL log messages so the application developer can suppress them if needed WILL PROBABLY NEVER IMPLEMENT 20140516 put meta, core, and site params directly in the module's symbol table like RT does it 20140516 get App::CELL to build on Perl 5.10.0 (SLE_11_SP3) 20140524 add 'testing' mode to Load->init (prefix all paths, e.g., with '/tmp') 20140610 get App::CELL to run in taint mode App-CELL-0.222/MANIFEST000444001750000144 135112766160463 14567 0ustar00smithfarmusers000000000000bin/CELLdemo.plx Build.PL Changes config/CELL_Config.pm config/CELL_Message_en.conf config/CELL_MetaConfig.pm config/CELL_SiteConfig.pm config/README lib/App/CELL.pm lib/App/CELL/Config.pm lib/App/CELL/Guide.pm lib/App/CELL/Load.pm lib/App/CELL/Log.pm lib/App/CELL/Message.pm lib/App/CELL/Status.pm lib/App/CELL/Test.pm lib/App/CELL/Test/LogToFile.pm lib/App/CELL/Util.pm LICENSE Makefile.PL MANIFEST MANIFEST.SKIP META.json META.yml README.rst t/000-dependencies.t t/001-log.t t/002-util.t t/003-test.t t/004-debug.t t/005-message.t t/006-config.t t/030-status.t t/031-status_ok.t t/032-status-expurgate.t t/033-status-accessor.t t/050-load.t t/070-config.t t/100-cell.t t/110-site.t t/111-site.t t/manifest.t t/pod-coverage.t t/pod.t WISHLIST App-CELL-0.222/META.yml000444001750000144 307412766160463 14713 0ustar00smithfarmusers000000000000--- abstract: 'Configuration, Error-handling, Localization, and Logging' author: - 'Smithfarm ' build_requires: File::ShareDir::Install: '0.11' File::Spec: '0' File::Temp: '0' Log::Any::Test: '0' Params::Validate: '0' Test::Warnings: '0' Try::Tiny: '0' configure_requires: Module::Build: '0' Software::License: '0' dynamic_config: 1 generated_by: 'Module::Build version 0.4205, CPAN::Meta::Converter version 2.150005' license: bsd meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: App-CELL provides: App::CELL: file: lib/App/CELL.pm version: '0.222' App::CELL::Config: file: lib/App/CELL/Config.pm App::CELL::Guide: file: lib/App/CELL/Guide.pm version: '0.222' App::CELL::Load: file: lib/App/CELL/Load.pm App::CELL::Log: file: lib/App/CELL/Log.pm App::CELL::Message: file: lib/App/CELL/Message.pm App::CELL::Status: file: lib/App/CELL/Status.pm App::CELL::Test: file: lib/App/CELL/Test.pm App::CELL::Test::LogToFile: file: lib/App/CELL/Test/LogToFile.pm App::CELL::Util: file: lib/App/CELL/Util.pm requires: Date::Format: '0' File::HomeDir: '0' File::Next: '0' File::ShareDir: '1' Log::Any: '0' Log::Any::Adapter: '0.1' Params::Validate: '0' Try::Tiny: '0' perl: '5.012' resources: bugtracker: https://github.com/smithfarm/cell/issues license: http://opensource.org/licenses/bsd-license.php repository: https://github.com/smithfarm/cell version: '0.222' x_serialization_backend: 'CPAN::Meta::YAML version 0.012' App-CELL-0.222/Changes000444001750000144 7710112766160463 14757 0ustar00smithfarmusers000000000000Revision history for perl-CELL NOTE: versions 0.001-0.040 were developed in the 'dochazka' project on SourceForge (under the top-level directory 'api'). Versions 0.041 and later are in the perl-CELL project repo. 0.001-0.003 2014-01-01 - start coding - add "version bump" functionality to dev.sh script - work on initialization 0.004 2014-01-02 15:13 - revamp CELL.pm - use Log::Fast instead of Sys::Syslog - some changes to top-level README 0.005-0.007 2014-01-03 - break out logging into CELL::Log - lots of work on CELL::Config - finish _import_sysconfig in CELL::Config - refactor _import_sysconfig ( broke it into pieces, iterate over array of subroutine references ) 0.008 2014-01-04 17:00 - first crack at Config::Error (inspired by brian d foy) 0.009-0.010 2014-01-07 - refactor CELL.pm - refactor and merged Error.pm and Log.pm - start refactoring Config.pm 0.011-0.013 2014-01-08 - get 'make test' running on refactored modules - WIP: ticket #25 - fix argument passing issue with CELL::Error->new - first crack at CELL::Message (mostly POD for now) 0.014-0.015 2014-01-09 - CELL::Message now working; testing in progress - CELL::Config tweaked - ready to continue working ticket #13 0.016 2014-01-10 23:45 - Config.pm now loading core configuration parameters 0.017-0.019 2014-01-11 - Message.pm refinements - bring in OBS stuff - work on OBS stuff (including new release.sh script) - close tickets #13 and #17 0.020-0.024 2014-01-12 15:50 - work on release script (api/bin/release.sh) - implement CELL->config method - implement CELL::Config::config and CELL->config - implement CELL::Config::set_meta and CELL->set_meta - basic unit tests for the above - add more unit tests and configuration parameters 0.025-0.031 2014-01-13 - work on ticket #38 - move former api/bin/ to api-dev/ to keep api/ free of distractions - another tweak on api-dev/release.sh - make API pass manifest.t - add unit test for CELL::Util and fix bug in that module - rename CELL::Error to CELL::Status - stop using tags after they possibly cause origin to get into detached HEAD state 0.032-0.036 2014-01-14 - revamp Status.pm to enable "OK" status level - add class diagram - start working on ticket #44 "Add an 'OK' status to CELL::Status" - refactor CELL.pm - revamp Status.pm - start splitting off CELL::Config::Meta - finish initial write-up of Meta.pm 0.037-0.039 2014-01-15 - work on tickets - pass all unit tests 0.040 2014-01-16 03:43 - Log.pm: add new 'arbitrary' function so we can write higher-level log messages without requiring Status.pm - Status.pm: avert possible circular dependency problems 0.041-0.043 2014-01-17 - change all occurrences of 'dochazka' to 'CELL' - debug release scripts - start initial write-up of CELL.pm (mainly POD) 0.044 2014-01-21 09:44 - start implementing new features: - multiple config files - flexible names - config files can be in subdirectories of config dir - meta parameters in config files instead of hard-coded - messages in config files instead of hard-coded 0.045 2014-01-21 12:02 - Config.pm: implement get_param() and set_meta() - Load.pm: first crack at find_files() 0.046-0.050 2014-01-22 - debugging in progress - start testing Message.pm - implement unit test for CELL::Load::find_files - fix some bugs found by unit testing - move get_and_load_config_files to CELL::Load and prepare for use with 'message' type config files - make Load.pm deal with messages better 0.051 2014-01-23 23:03 - new Test.pm module for re-useable testing code - change t/03-load.pm to use the new module - start working on new format for message config files (staging/message-slurp.plx) 0.052 2014-01-25 11:58 - put message file parsing code into Load.pm - write some unit tests for parsing message files and configuration files - start CELL Localization Guide (in staging/) 0.053 2014-01-27 11:39 - implement caching in find_files - pass over (and log) duplicate config parameters 0.054 2014-01-27 21:52 - put finishing touches on Load.pm - add a number of unit tests for Load.pm 0.055-0.59 2014-01-28 - put standard CELL configuration files in dist/config/ - fix bugs - in Load.pm, make parse_message_file get language tag from the filename, so the user doesn't have to enter a language tag for each message she defines - fix release script - add language tags verbiage to Localization Guide - work on Localization Guide 0.060-0.063 2014-01-29 - caress Load.pm and get ready to start testing CELL::Config::init - unit tests for Load.pm more or less done - Config.pm: _import_config strip double quotes as well as single - Log.pm: do not use CELL::Status, convert package variable to state - Status.pm: include message object in status object - add more unit tests (almost ready to test CELL::Config::init) - CELL::Config::init working now - CELL::Message::init working now 0.064 2014-01-30 - CELL.pm: work on POD and code - Log.pm: accept lower/mixed-case level - Util.pm: no newline in timestamp - 07-cell.t: new unit tests for CELL.pm - Config.pm: fix regex, don't use meta param for re-entrantness - Message.pm: make init be re-entrant and report errors - put unit test of CELL::Message::init in the right file 0.065 2014-01-30 15:26 - rename to App::CELL (from just plain CELL) 0.066 2014-01-31 16:54 - refactor Localization Guide - draft Apologia (attempt to justify App::CELL's existence to CPAN gurus) 0.067 2014-04-25 17:21 - start work on File::ShareDir based 'config' directory (ticket #17) 0.068 2014-04-26 22:11 - some minor changes left over on laptop from months ago - fix bug in Perl script used by release.sh to determine the current version 0.069 2014-04-26 22:48 - initial File::ShareDir support 0.070 2014-05-03 12:05 - dependencies to Makefile.PL - File::ShareDir to testing dependencies in t/00-dependencies.t 0.071 2014-05-04 23:22 - work on ShareDir functionality (ticket #17) 0.072-0.074 2014-05-05 - separate CELL and site configuration directories (rewrite config/README) - try to pass CPAN Testers smoke test - edit Changes file for style - clean up comments in release script - fix bug: "App::CELL->init not processing argument correctly" - note that dist/dev.sh bump depends on Perl::Version 0.075-0.76 2014-05-06 - remove obsolete dependencies - add some error-checking to the release script - use regexp quote-like operator instead of single-quotes (Load.pm) - chang App::CELL::Load::find_file so it can walk multiple directories (ticket #18) 0.077 2014-05-07 22:46 - add tickets/ directory with README - Status.pm: croak on CRIT errors - start implementing major design change: first, load App::CELL's own internal configuration from the distro sharedir and _then_ load from site configuration directory if it exists 0.078-0.080 2014-05-08 21:16 - Status.pm: remove croaking on CRIT errors - move directory functions from Config.pm to Load.pm - move is_directory_viable() to Util.pm - major refactoring to implement design change referred to in 0.077 - clean up unit test files - add new unit test 003-debug.t - minor POD fix in CELL.pm - Config.pm: initialize meta, core, site package variables; fix bug in get_param - Load.pm: improve error checking; more useful debugging messages - Config.pm: fix bug "get_param, set_meta, and _set_core_site do not respect hash structure" 0.081 2014-05-09 10:23 - general cleanup 0.082 2014-05-09 14:16 - Test.pm: - new cleartmpdir function, use it in unit tests - write proper SYNOPSIS - new unit tests (t/003-test.t) - t/030-status.t: add more tests - update dependencies in t/000-dependencies.t and Makefile.PL - expand release/README 0.083 2014-05-09 17:15 - CELL.pm: remove 'status_ok' and 'status' wrappers - CELL_Config.pm and CELL_MetaConfig.pm: prefix all params with 'CELL_', add comments - Message.pm: fix bug "'new' method suffers from flawed logic" 0.084 2014-05-09 17:47 - CELL.pm: move 'config' logic to Config.pm and make it a wrapper - Message.pm: add some comments - t/100-cell.t: add a test, fix a test 0.085 2014-05-09 22:23 - Config.pm: improve error-checking in get_param - Log.pm: add $log_level package variable, add 'set_log_level' subroutine, - Load.pm: revamp SYNOPSIS, fix POD for 'init' subroutine (close ticket #19), fix white-space bug in parse_message_file - CELL.pm: change re-entrancy processing, avoid referring to config params and messages before they have been loaded - CELL_Message_en.pm: prefix all messages with CELL_ (close ticket #9) 0.086 2014-05-09 23:21 - t/050-find-and-parse.t: add whitespace to trigger bug in event of regression - config/CELL_Message_en.conf: add CELL_OVERWRITE_META_PARAM message - Config.pm: use CELL_OVERWRITE_META_PARAM - Load.pm: make functions and log messages easier to follow - open bug #23 Put sprintf into eval block in Message->new 0.087 2014-05-11 13:36 - (Perl::Critic) add .perlcriticrc, disable "no strict 'refs'" warnings - (Perl::Critic) use two-argument form of 'bless' - (Perl::Critic) convert nested subroutine into anonymous subroutine - (Perl::Critic) avoid explicit 'return undef' - replace 'eval' with Try::Tiny, update dependencies - Message.pm turn warnings into exceptions in 'new' (close ticket #23) 0.088 2014-05-11 17:15 - add 'Testing with Perl::Critic' section to release README - (Perl::Critic) unpack @_ in CELL.pm - (Perl::Critic) use @ARGV with 'local' in Test.pm - Log.pm: remember $ident and re-use it when necessary - Message.pm: add 'error' attribute to message class, add 'stringify' method to message class revamp error checking in 'new' 0.089 2014-05-11 20:01 - implement major design change: migrate to Log::Any (ticket #27) - t/001-log.t: rewrite to use Log::Any::Test - remove dependency on Log::Fast 0.090 2014-05-11 21:23 - Log.pm: rename 'configure' subroutine to 'init', tweak POD, expand permitted levels (ticket #28) - audit all calls to App::CELL::Status->new (ticket #5) 0.091 2014-05-11 22:29 - CELL_Config.pm, Message.pm: add CELL_SUPPORTED_LANGUAGES and CELL_LANGUAGE core params (ticket #15) - CELL.pm, t/100-cell.t: initialize package variables in Message.pm - Config.pm: unpack @_ in 'config' subroutine 0.092 2014-05-12 13:18 - Load.pm: improve error checking in 'init' (ticket #21); tweak variable names, subroutine names, param names, message names; fix return status - tweak param names, variable names, message names in unit test files - t/004-debug.t: indicate how to activate logging in a test 0.093 2014-05-12 16:48 - completely revamp logging in light of migration to Log::Any 0.094 2014-05-12 23:36 - t/004-log.t: use $ENV{'HOME'} instead of ~ - CELL.pm, Load.pm: optionally take PARAMHASH (appname, sitedir) 0.095 2014-05-13 17:10 - add bin/ directory and start demo.plx script there - CELL_Message_en.conf: add some testing messages - t/001-log.t: test logging via Status->new with testing message - Log.pm: attempt to inherit from Log::Any (not working yet) 0.096 2014-05-14 22:23 - bin/demo.plx now actually does something - Config.pm: removed obsolete dependencies - t/004-debug.plx: remove obsolete CELL_DEBUG_MODE test and add comment explaining purpose of this unit test file, so I'm not tempted to delete it later 0.097 2014-05-15 14:04 - CELL_Config.pm: get rid of CELL_DEBUG_MODE - Load.pm: generate debug message for each meta/core/site param loaded; make process_stanza slightly less verbose; improve debug messages generated by sitedir search routine; no longer look in home directory or /etc/sysconfig because application developer can now specify a literal sitedir path to App::CELL->init - Makefile.PL, t/000-dependencies.t: remove dependency on Config::General - Status.pm: log using $log object; fix bug in 'log' method that was causing "at [FILE] line [LINE]" to be appended twice; add 'text' accessor method 0.098 2014-05-15 21:56 - Load.pm: clean up get_sitedir some more -- now, application is expected to specify sitedir in call to 'App::CELL->init' by providing either a 'sitedir' parameter specifying a full path, or an 'enviro' parameter specifying name of environment variable containing a full path. The only alternative considered is the CELL_SITEDIR environment variable. This makes more sense than what we were attempting before, and streamlines the code. - t/050-find-and-parse.t renamed -> t/050-load.t - t/070-config.h: rewriting (ticket #33) - WIP - add LICENSE and WISHLIST files to dist/ directory 0.099-0.0100 2014-05-16 - Load.pm: tweaked log messages, fixed bug in _report_load_status: "success log message not being logged because status code 'OK'" - t/070-config.t: add more tests (ticket #33) - Status.pm: add boolean methods for 'notice', 'warn', 'err', etc. - config/: add CELL_SiteConfig.pm, add unit testing params 0.101 2014-05-20 10:48 - t/050-load.t: fix diagnostic log messages - add LICENSE file with GPLv3 text - add item to WISHLIST 0.102 2014-05-21 12:45 - CELL.pm, Log.pm: minor cleanup - Status.pm: fix bug in 'new' -> "status log messages displaying the wrong caller" 0.103 2014-05-22 21:56 - Log.pm: change initialization routine so it takes a PARAMHASH, and added a 'show_caller' param to it - adapted CELL.pm and t/* to change in Log.pm 0.104 2014-05-22 22:17 - CELL.pm: fixed bug "App::CELL->init not recognizing appname param" - Log.pm: add 'ident' accessor routine - demo.plx: expanded demo script 0.105 2014-05-23 21:16 - CELL.pm, CELL_Config.pm: move verbiage to doc/guide.pod, implement CELL_LOG_SHOW_CALLER - Config.pm: spam the log less - Message.pm: cleanup 'new', make it return a status object (ticket #26) - Status.pm: make it handle status object from Message->new - t/005-message.t: adapt tests, add more tests 0.106 2014-05-23 22:54 - CELL.pm: honor "debug_mode" flag - Log.pm: honor debug_mode flag, replace a bunch of wrappers with a single AUTOLOAD routine - t/001-log.t: add some debug_mode-related tests 0.107 2014-05-24 10:19 - Load.pm: add sanity check to constructor (ticket #21) - config/: fix spelling of params, add params for sanity check - Message.pm: tell Data::Dumper to not include any newlines 0.108 2014-05-24 12:26 - Load.pm: suppress caller info in "parsed message" $log->debug call, generate more useful warnings/errors in find_files - Log.pm: expand AUTOLOAD routine, improve caller handling, eliminate ok and not_ok wrappers - Message.pm: improve caller handling in constructor - Status.pm: improve caller handling in constructor, make 'caller' accessor return array ref instead of array - t/070-config.t: turn on debug_mode - Config.pm, CELL_Message_en.conf: add value to CELL_OVERWRITE_META_PARAM, remove unused error/warning messages 0.109 2014-05-24 15:18 - Config.pm: cleanup 'get_param' - Log.pm: work on POD, fix AUTOLOAD so it passes all calls through to Log::Any, applying pre-processing selectively. - t/001-log.t: get rid of $log_any_obj since we can now access testing methods through the App::CELL::Log singleton - Guide.pm: new POD-only module with new high-level introduction to App::CELL - remove doc/ directory from the distro 0.110-0.013 2014-05-24 - Guide.pm: include verbiage from config/README (ticket #22) and staging/CELL-Localization-Guide.pod (ticket #13) - config/README: make it a stub - t/070-config.t: comment out Log::Any::Adapter as this causes local osc build to fail - remove t/TEMPLATE (obsolete) - remove Data::Printer dependency because (1) this causes build problems in OBS, and (2) no longer needed - change license to GPLv3 - change Makefile.PL to reflect license change - README: add copyright and license information - LICENSE: new license text 0.114-0.116 2014-05-25 - update WISHLIST - Makefile.PL: correct license string - change order of "use" boilerplate in all modules - config/ add use strict; use warnings; to config modules in sharedir - migrate from ExtUtils::MakeMaker to Module::Build - bring back Makefile.PL (someone might still need it) - dev.sh: add 'test' command 0.117-0.128 2014-05-25 - release.sh: run './Build test', add cpan-upload, move generated tarball to 'perl-cell-releases' directory, change order of operations, add comments, fix regression, add CPAN upload option - test release script, frivolously reversion the distro - fix bug "release script not incrementing version number properly" - extend MANIFEST.SKIP - dev.sh: use distclean instead of just clean - delete 'ignore.txt' and see if it makes any difference 0.129 2014-05-25 17:27 CEST - Changes: consolidate entries for better readability, convert dates to ISO format - release/timestamp.sh: add timezone 0.130 2014-05-25 20:47 CEST - CELL.pm: add LICENSE section, start implementing $CELL singleton (ticket #34) - test.sh: use './Build test' instead of 'make test' - Status.pm: make log method use '$log->status_obj' - Log.pm: fix status_obj method, start implementing message_obj (ticket #37), revamp SYNOPSIS, just use Log::Any (not inherit) 0.131 2014-05-25 21:06 CEST - CELL.pm: finish implementing $CELL singleton - t/100-cell.pm: use $CELL singleton 0.132 2014-05-26 12:55 CEST - Build.PL: remove 'executable' bit to improve Kwalitee score, add "perl => '5.12.0'" to requires 0.133 2014-05-26 15:13 CEST - change perl version to 5.012 everywhere 0.134 2014-05-26 22:56 CEST - dev.sh: run './Build disttest' because it re-builds META.yml and META.json - release.sh: more refinements - CELL.pm: export $log singleton as well as $CELL, re-write POD, put 'appname', 'enviro', and 'loaded' attributes into $CELL singleton, provide accessors for them, also provide 'sharedir' and 'sitedir' convenience "accessor" routines, change name of main routine from 'init' to 'load', use new $log-> methods instead of $log->init - Load.pm: make 'sharedir', 'sharedir_loaded', 'sitedir', 'sitedir_loaded' be package variables instead of state variables, return 'ERR' statuses instead of 'CRIT' - Log.pm: implement 'ident', 'show_caller', 'debug_mode' that will replace 'init' - CELL_Config.pm: add CELL_CORE_SAMPLE 0.135 2014-05-27 09:05 CEST - t/100-cell.t: add several tests - Test.pm: export cmp_arrays symbol - Build.PL: add 'Data::Dumper' to build_requires, add remote repo URL - CELL.pm: add supported_languages method 0.136 2014-05-27 10:09 CEST - dev.sh: always run './Build disttest' after 'perl Build.PL' to ensure META.json and META.yml are rebuilt, improve 'stop' routine 0.137 2014-05-27 10:35 CEST - tweak Build.PL and release.sh 0.138 2014-05-27 22:54 CEST - CELL.pm: add 'msg' method (wrapper to App::CELL::Message->new) - t/100-cell.pm: add some tests 0.139 2014-05-28 10:59 CEST - t/111-test.t: add "ad hoc testing" test - CELL_Config.pm: move 'use' statements to bottom, restore CELL_DEBUG_MODE, improve comment - CELL.pm: remove 'loaded' attribute from $CELL, re-implement 'meta' and 'config' methods in light of Config.pm change - Config.pm: new SYNOPSIS, new DESCRIPTIONS, introduce $meta, $core, and $site "singleton" objects, new AUTOLOAD routine to replace 'get_param' - Guide.pm: new verbiage - Log.pm: fix bug "Endless recursion between init and AUTOLOAD when logger not explicitly initializd" - release.sh: add '-ff' to force push to remote without testing - (some unit tests are failing) 0.140 2014-05-28 13:17 CEST - dev.sh: clean up after disttest - CELL.pm: fix SYNOPSIS, fix exports, change 'loaded' from attribute to method, fix call to no-longer-existent 'App::CELL::Config::config' function, delete 'meta' and 'config' wrappers - Config.pm: fix regex, get rid of stupid symbolic reference, delete 'use App::CELL::Load' that was causing grief - Load.pm: bring in the new $meta, $core, and $site "singletons", use them in sanity check - Log.pm: deal with situations when $log method is called before logger has been explicitly initialized - move t/111-test.t to t/006-config.t - t/110-cell.t: fix calls to 'meta' and 'config' 0.141 2014-05-28 13:57 CEST - globally change \o{12} to \012 in all regexes in attempt to appease Perl 5.12 0.142 2014-05-28 14:56 CEST - CELL.pm: add missing items to POD - t/: commented out lines that were uncommented for debugging and shouldn't have gone to CPAN 0.143 2014-05-28 16:00 CEST - Test/LogToFile.pm: new module - t/: use the new module in tests 0.144 2014-05-28 22:57 CEST - Build.PL: fix/improve metadata - CELL.pm, Load.pm, Log.pm: perlcritic fixes - Status.pm: delete boolean methods 'notice', 'warn', etc. because the same info can easily be obtained using the 'level' accessor method - t/: cleanup - release/: update README 0.145 2014-05-29 05:21 CEST - Build.PL: add Log::Any::Adapter to build_requires - t/000-dependencies.t: update 0.146 2014-05-29 05:28 CEST - t/000-dependencies.t: add Log::Any::Adapter, exports 0.147 2014-05-29 10:36 CEST - config/: add an error message - Status.pm: refactor 'ok' method (perlcritic) - Test.pm: make tempdir stuff use File::Temp - Util.pm: make timestamp ISO-conformant - t/: adjust tests 0.148 2014-05-29 16:58 CEST - ticket #48 (new 'set' method in Config.pm) -- WIP 0.149 2014-05-29 21:31 CEST - Config.pm: finish implementing new 'set' method - t/: update tests - Status.pm: new 'dump' method WIP, use $log->status_obj in 'new', refactor accessors - Log.pm: new permitted_objects method, refactor status_obj method 0.150 2014-05-30 11:35 CEST - remove '/a' regex modifier that doesn't work with Perl 5.012 (maybe nobody will miss it?) 0.151 2014-05-30 20:57 CEST - Status.pm: move some verbiage to Guide.pm, clarify edge cases - t/030-status.pm: add tests for edge cases 0.152 2014-05-31 17:06 CEST - change minimum Perl version to 5.012 everywhere - Status.pm: fix constructors in light of testing - CELL.pm, Message.pm: begin implementing language functionality - t/030-status.t: add lots of tests - t/070-config.t: use is_deeply instead of homegrown cmp_arrays - t/110-site.t: new tests 0.153 2014-06-01 11:36 CEST - Load.pm: removed more instances of 'a' regex modifier that causes Perl 5.012 to cry "syntax error" 0.154 2014-06-01 22:44 CEST - config/, Load.pm: clean up sanity-testing params (ticket #45) - CELL.pm: add "function factory" for status constructors (ticket #39) 0.155 2014-06-02 18:09 CEST - Config.pm, Log.pm: tweak AUTOLOAD routines for Perl 5.012 - CELL.pm: fix bug in "constructor factory" (upper/lower-case) - t/100-cell.t: add basic tests for the new status constructors 0.156 2014-06-02 18:20 CEST - Config.pm, Log.pm: add formal DESTROY routine (to appease Perl 5.012) 0.157 2014-06-03 13:46 CEST - Guide.pm: update to use new status constructors - Message.pm, Util.pm: move stringify_args to Util.pm - CELL.pm: add "odd number of args" error message to load routine - t/002-util.t: remove another 'a' regex modifier that I missed - Message.pm: first implementation of 'lang' method - t/110-site.t: add test for 'lang' message method 0.158 2014-06-03 23:05 CEST - Guide.pm: write new verbiage, edit old verbiage 0.159 2014-06-05 11:26 CEST - remove obsolete 'obs' directory from git repo - tweak release script - CELL_Config.pm: comment out CELL_ALREADY_INITIALIZED 0.160-0.163 2014-06-07 21:49 CEST - clean up git repo - move unnecessary file MANIFEST.SKIP from dist/ to staging/ - Build.PL: don't create LICENSE file every time - change LICENSE to BSD-3-Clause - misc/boilerplate/: add code for prepending copyright/license notice to each source code file - CELL.pm - restore 'LICENSE AND COPYRIGHT' POD section - move dev.sh and test.sh from dist/ to top level of git repo because they are not in the distro 0.164-0.165 2014-06-09 13:55 CEST - pod-coverage.t: add missing tests - Guide.pm: add CAVEATs section to warn against running in taint mode - Load.pm, Message.pm: fix infinite recursion bug in try .. catch .. - Load.pm: return fatal error if running in taint mode - Message.pm: if args sent to constructor but text cannot take them, stringify them and append to message text - Message.pm: comment out "Creating message object" debug message - t/001-log.t: do not test for "Creating message object" debug message - Status.pm: if message object creation fails in constructor and args are present, stringify them and append to text - Util.pm: fix bug "stringify_args can only take hashrefs" 0.166-0.168 2014-06-09 18:16 CEST - masochistically change CELL_SUPPORTED_LANGUAGES and CELL_LANGUAGE to CELL_SUPP_LANG and CELL_DEF_LANG, respectively - CELL.pm: make 'load' take sitedir only, make 'appname' method both get and set appname - Util.pm: make is_directory_viable return boolean - tweak Build.PL to clean App-CELL-* tarballs - Load.pm, etc.: support multiple sitedirs (tests for this still to be written, though) - t/110-site.t: add a multiple-sitedir-related unit test 0.169 2014-06-10 09:07 CEST - clarify that site params cannot be overwritten - move CELL_SITEDIR_LOADED and CELL_SITEDIR_LIST to CELL_META_SITEDIR_LOADED and CELL_META_SITEDIR_LIST, respectively - t/110-site.t: add some unit tests for the new "multiple sitedirs" feature - work on Guide.pm 0.170 2014-06-10 11:46 CEST - fix version 0.171 2014-06-10 12:23 CEST - t/111-site.t: add tests for non-existent sitedir - CELL.pm: cleanup - Load.pm: fix bug "$CELL->loaded returning 'SHARE' even though sharedir and sitedir are loaded" 0.172 2014-06-10 13:42 CEST - CELL_Message_en.conf: add reason to CELL_SITEDIR_NOT_FOUND - Load.pm: fix bug "Load.pm->init doesn't return meaningful error when get_sitedir fails" - Message.pm, t/001-log.t: tweak debug message 0.173-0.175 2014-06-11 13:04 CEST - t/: add unit tests for sitedir logic - Load.pm, Guide.pm: work on sitedir logic (make it work as documented) - t/: add tests for new sitedir logic - t/: adapt unit tests 0.176-0.180 2014-06-13 15:41 CEST - obs.sh: new OBS CI script - Log.pm: debug_mode method can now both set and get the debug_mode package variable - Load.pm: tone down (reduce level) of several log messages, re-learn how modulo operator works - call obs.sh (OBS CI script) from release script 0.181 2014-06-16 22:20 CEST - Message.pm: fix bug caused by failure to properly initialize $mesg package variable - load routine was spamming the log: make this "spamming" happen only when caller passes "verbose => 1" to load routine - be more careful about which messages actually get logged and under what conditions 0.182 2014-06-17 08:48 CEST - Guide.pm, Load.pm: improve documentation 0.183 2014-06-17 22:46 CEST - Load.pm: some logging-related fixes - Guide.pm: some work on documentation 0.184 2014-06-19 09:38 CEST - started adding "cell => 1" to all $log calls to enable the developer to suppress all log messages coming from CELL, if desired 0.185 2014-07-07 22:47 CEST - continue implementing 'cell => 1' parameter to $log-> functions so developer can suppress CELL's log messages if desired - Build.PL: require Log::Any::Adapter version 0.10 or higher, because earlier versions lack File.pm, which we rely on for log-to-file 0.186 2014-07-08 13:28 CEST - Guide.pm: add caveat section about site_perl/vendor_perl conflicts 0.187 2014-07-11 11:56 CEST - CELL.pm: have status_XYZ constructors issue a warning when they discard arguments because the argument list has an odd number of elements 0.188 2014-07-11 13:12 CEST - fix SF Bug #50 "$CELL->status_err creates status object with bad caller" - t/031-status_ok.t: add unit tests for CELL.pm status constructors 0.189 2014-07-11 13:22 CEST - LogToFile.pm: move POD up after CPAN started to choke on it 0.190 2014-07-15 - Message.pm: fix bug (error not reported properly when sprintf generates a warning) 0.191 2014-07-23 07:09 CEST - Load.pm: keep track of message line numbers in parse_message_file - Message.pm: when constructing message object for status object, take only selected attributes from the PARAMHASH - Status.pm: add an 'expurgate' method - t/110-site.t: comment out a unit test broken by the message constructor modifications 0.192 2014-07-23 07:16 CEST - release/release.sh: fix bug in script that broke timestamp insertion on Ubuntu 12.04 0.193 2014-07-23 07:52 CEST - Status.pm: tweak the new 'expurgate' method - t/032-status-expurgate.t: add unit tests 0.194 2014-07-23 09:00 CEST - Build.PL, t/: update dependencies to include Data::Structure::Util 0.195 2014-08-11 12:06 CEST - CELL.pm: minor tweak to eliminate a superfluous line of code - Log.pm: if this is a CELL internal debug message, log it only if the CELL_DEBUG_MODE environment variable exists and is true - Message.pm: fix POD of 'new' method 0.196 2014-08-12 15:34 CEST - Load.pm: when complaining about duplicate message/parameter definitions, include both offending and original file in error message 0.197 2014-10-15 10:25 CEST - Config.pm: add 'get_param' routine; rename 'get_all' routine to more descriptive 'get_param_metadata' - t/006-config.t: add test case for 'get_param' 0.198 2014-10-16 23:08 CEST - t/070-config.t: add test case for Bug #51 https://sourceforge.net/p/perl-cell/tickets/51/ 0.199 2014-10-17 11:56 CEST - Config.pm: fix bug "$meta can be used to access site/core parameters" 0.200 2014-10-22 08:18 CEST - Config.pm: fix bug "get_param_meta has same problem where $meta could be used to access $site variables" - t/070-config.pm: add test case for this bug 0.201 2014-11-05 14:58 CET - remove dependency on Data::Structure::Util, which does not work with perl 5.20 0.202 2014-11-28 17:50 CET - Status.pm: since 'dclone' might die (e.g., when a siteparam contains a REGEXP literal), put the dclone call in a Try::Tiny block 0.203 2014-12-23 15:38 CET - add (CELL) prefix to more App::CELL-internal log messages 0.204 2014-12-23 18:38 CET - Config.pm: do not concatenate a variable whose value might be undef 0.205 2015-01-13 23:29 CET - Config.pm: add 'exists' method; add 'get' wrapper for 'get_param' - t/: add rudimentary test of 'exists' method 0.206 2015-02-11 13:48 CET - Config.pm: fix undef bug 0.207 2015-02-12 14:00 CET - Status.pm: add 'args' accessor method - t/: test case for 'args' accessor method 0.208 2015-03-24 18:26 CET - switch over to static README with just a single line (from auto-generated mega-README) - Status.pm: in "new" (App::CELL::Status constructor), handle condition when 'level' property is undefined 0.209 2015-04-01 17:45 CEST - Status.pm: make level, code, and args accessors take an optional argument -> if present, set property to its value and return it - t/033-status-accessor.t: simple test cases for this commit 0.210 2015-04-14 09:46 CEST - add missing File::Temp build dependency 0.211 2015-07-21 17:56 CEST - update copyright statement to include 2015 - $VERSION only in CELL.pm and Guide.pm 0.212 2015-07-25 05:10 CEST - technical release 0.213 2015-07-27 11:38 CEST - Eliminate File::Touch dependency 0.214 2015-07-27 11:46 CEST - technical release 0.215 2015-07-30 10:08 CEST - add Params::Validate dependency - use Params::Validate in CELL.pm->load() and Load.pm->_conf_from_config 0.216 2016-07-30 16:53 CEST - Test.pm: export _touch so other modules can use it, too - Load.pm: reporting parameter value in _conf_from_config() is problematic; don't do it - Load.pm: allow config params to have undef as value 0.217 2015-44-11 11:44 CET - global: do not convert warnings into errors - tests: use Test::Warnings to test for unexpected warnings 0.218 2015-19-21 16:19 CET - Build.PL: do not specify Module::Build build dependency version (fixes OBS build target openSUSE_13.2) 0.219 2015-20-21 22:20 CET - README: switch to reStructuredText; add release mgmt instructions - README: eliminate README duplication - t/000-dependencies.t: do not check Module::Build 0.220 2016-09-04 09:12 CEST - t/050-load.t: send too many parameters to set() - release: use central release scripting - doc: fix POD line in App::CELL::Status - Add .travis.yml and badges on the README - MANIFEST.SKIP: avoid Perl Critic and Travis config files - test: try using TRAVIS_PERL_VERSION to detect Travis 0.221 2016-09-10 23:56 CEST - README.rst: drop Release management section - build/ops: regenerate Makefile.PL (CPANtesters) 0.222 2016-09-14 07:32 CEST - build/ops: use File::ShareDir::Install in Makefile.PL App-CELL-0.222/t000755001750000144 012766160463 13544 5ustar00smithfarmusers000000000000App-CELL-0.222/t/031-status_ok.t000444001750000144 216712766160463 16411 0ustar00smithfarmusers000000000000#!perl -T use 5.012; use strict; use warnings; use App::CELL qw( $CELL $log ); #use App::CELL::Test::LogToFile; use Data::Dumper; use Test::More; use Test::Warnings; my $status; $log->init( ident => 'CELLtest' ); $log->info("---------------------------------------------------- "); $log->info("--- 031-status_ok.t ---"); $log->info("---------------------------------------------------- "); $status = $CELL->status_ok(); #diag( Dumper( $status ) ); ok( $status->ok, "OK status is OK" ); is( $status->{code}, undef, "real code is undef" ); is( $status->code, '', "no code" ); is( $status->{text}, undef, "real text is undef" ); is( $status->text, '', "no text" ); is( $status->payload, undef, "payload is undefined" ); is_deeply( $status->args, [], "args is empty" ); $status = $CELL->status_ok( "foobar" ); #diag( Dumper( $status ) ); ok( $status->ok, "OK status is OK" ); is( $status->code, "foobar", "code is as expected" ); is( $status->text, "foobar", "text is as expected" ); is( $status->payload, undef, "payload is undefined" ); is_deeply( $status->args, [], "args is empty" ); done_testing; App-CELL-0.222/t/100-cell.t000444001750000144 713612766160463 15312 0ustar00smithfarmusers000000000000#!perl use 5.012; use strict; use warnings; use App::CELL qw( $CELL $log $meta $core $site ); use App::CELL::Test qw( cmp_arrays ); #use App::CELL::Test::LogToFile; use Data::Dumper; use File::ShareDir; use Test::More; use Test::Warnings; my $status; $log->init( ident => 'CELLtest' ); $log->info("------------------------------------------------------- "); $log->info("--- 100-cell.t ---"); $log->info("------------------------------------------------------- "); is_deeply( $CELL->supported_languages, [ 'en' ], "Hard-coded list of supported languages consists of 'en' only" ); ok( $CELL->language_supported( 'en' ), "English is supported" ); ok( ! $CELL->language_supported( 'fr' ), "French is not supported" ); my $bool = $meta->CELL_META_SITEDIR_LOADED; ok( ! defined($bool), "Random config param not loaded yet" ); ok( ! $CELL->loaded, "CELL doesn't think it's loaded" ); ok( ! $log->{debug_mode}, "And we're not in debug mode" ); ok( ! $CELL->sharedir, "And sharedir hasn't been loaded" ); ok( ! $CELL->sitedir, "And sitedir hasn't been loaded, either" ); # first try without pointing to site config directory -- CELL will # configure itself from the distro's ShareDir $status = $CELL->load(); is( $status->level, "WARN", "Load without sitedir gives warning" ); is( $CELL->loaded, "SHARE", "\$CELL->loaded says SHARE"); is_deeply( $site->CELL_SUPP_LANG, [ 'en' ], "CELL_SUPP_LANG is set to just English" ); is_deeply( $CELL->supported_languages, $site->CELL_SUPP_LANG, "Two different ways of getting supported_languages list" ); my $sharedir = $site->CELL_SHAREDIR_FULLPATH; ok( defined( $sharedir ), "CELL_SHAREDIR_FULLPATH is defined" ); is( $sharedir, File::ShareDir::dist_dir('App-CELL'), "CELL_SHAREDIR_FULLPATH is properly set to the ShareDir"); is( $sharedir, $CELL->sharedir, "Sharedir accessor works" ); my $msgobj = $CELL->msg( 'CELL_TEST_MESSAGE' ); is( $msgobj->text, "This is a test message", "Basic \$CELL->msg functionality"); $status = $CELL->status_crit( 'CELL_TEST_MESSAGE' ); #diag( Dumper( $status ) ); ok( $status->level eq 'CRIT' ); $status = $CELL->status_critical( 'CELL_TEST_MESSAGE' ); ok( $status->level eq 'CRITICAL' ); $status = $CELL->status_debug( 'CELL_TEST_MESSAGE' ); ok( $status->level eq 'DEBUG' ); $status = $CELL->status_emergency( 'CELL_TEST_MESSAGE' ); ok( $status->level eq 'EMERGENCY' ); $status = $CELL->status_err( 'CELL_TEST_MESSAGE' ); ok( $status->level eq 'ERR' ); $status = $CELL->status_error( 'CELL_TEST_MESSAGE' ); ok( $status->level eq 'ERROR' ); $status = $CELL->status_fatal( 'CELL_TEST_MESSAGE' ); ok( $status->level eq 'FATAL' ); $status = $CELL->status_info( 'CELL_TEST_MESSAGE' ); ok( $status->level eq 'INFO' ); $status = $CELL->status_inform( 'CELL_TEST_MESSAGE' ); ok( $status->level eq 'INFORM' ); $status = $CELL->status_not_ok( 'CELL_TEST_MESSAGE' ); ok( $status->level eq 'NOT_OK' ); $status = $CELL->status_notice( 'CELL_TEST_MESSAGE' ); ok( $status->level eq 'NOTICE' ); $status = $CELL->status_ok( 'CELL_TEST_MESSAGE' ); ok( $status->level eq 'OK' ); $status = $CELL->status_trace( 'CELL_TEST_MESSAGE' ); ok( $status->level eq 'TRACE' ); $status = $CELL->status_warn( 'The very big %s', args => [ "Bubba" ] ); is( $status->text, 'The very big Bubba', "Status constructor takes argument" ); ok( $status->level eq 'WARN' ); $status = $CELL->status_warning( 'CELL_TEST_MESSAGE', payload => "bubba"); ok( $status->level eq 'WARNING' ); ok( $status->payload eq 'bubba' ); $status = $CELL->status_ok( 'CELL_TEST_MESSAGE_WITH_ARGUMENT', args => [ 'very nice' ] ); is_deeply( $status->args, [ 'very nice' ] ); done_testing; App-CELL-0.222/t/070-config.t000444001750000144 1130112766160463 15653 0ustar00smithfarmusers000000000000#!perl # # t/070-config.t # # Run Config.pm through its paces # use 5.012; use strict; use warnings; use App::CELL::Config qw( $meta $core $site ); use App::CELL::Load; use App::CELL::Log qw( $log ); use App::CELL::Test; #use App::CELL::Test::LogToFile; use Data::Dumper; use Test::More; use Test::Warnings; my $status; $log->init( ident => 'CELLtest', debug_mode => 1 ); $log->info("-------------------------------------------------------"); $log->info("--- 070-config.t ---"); $log->info("-------------------------------------------------------"); # # META # $status = $meta->CELL_META_TEST_PARAM_BLOOEY; ok( ! defined($status), "Still no blooey" ); ok( ! $meta->exists( 'CELL_META_TEST_PARAM_BLOOEY' ) ); $status = $meta->set( 'CELL_META_TEST_PARAM_BLOOEY', 'Blooey' ); ok( $status->ok, "Blooey create succeeded" ); ok( $meta->exists( 'CELL_META_TEST_PARAM_BLOOEY' ) ); # 'exists' returns undef on failure $status = exists $App::CELL::Config::meta->{ 'CELL_META_TEST_PARAM_BLOOEY' }; ok( defined( $status ), "Blooey exists after its creation" ); $status = $meta->CELL_META_TEST_PARAM_BLOOEY; is( $status, "Blooey", "Blooey has the right value via get_param" ); $status = App::CELL::Load::init( appname => 'CELLtest' ); is( $status->level, "WARN", "Load without sitedir gives warning" ); # 'exists' returns undef on failure $status = $meta->CELL_META_UNIT_TESTING; ok( defined( $status ), "Meta unit testing param exists" ); my $value = $App::CELL::Config::meta->{ 'CELL_META_UNIT_TESTING' }->{'Value'}; is( ref( $value ), "ARRAY", "Meta unit testing param is an array reference" ); is_deeply($value, [ 1, 2, 3, 'a', 'b', 'c' ], "Meta unit testing param, obtained by cheating, has expected value" ); my $result = $meta->CELL_META_UNIT_TESTING; is_deeply( $result, [ 1, 2, 3, 'a', 'b', 'c' ], "Meta unit testing param, obtained via get_param, has expected value" ); $status = $meta->set( 'CELL_META_UNIT_TESTING', "different foo" ); #diag( "\$status level is " . $status->level . ", code " . $status->code ); ok( $status->ok, "set_meta says OK" ); $result = undef; $result = $meta->CELL_META_UNIT_TESTING; is( $result, "different foo", "set_meta really changed the value" ); # (should also test that this triggers a log message !) # Bug #51 # https://sourceforge.net/p/perl-cell/tickets/51/ $result = undef; $result = $meta->CELL_CORE_UNIT_TESTING; #diag( "Use meta to access core param: " . Dumper( $result ) ); ok( ! defined( $result ), 'Cannot use $meta to access a core param' ); $result = $meta->CELL_SITE_UNIT_TESTING; ok( ! defined( $result ), 'Cannot use $meta to access a site param' ); $result = $meta->get_param('CELL_SITE_UNIT_TESTING'); ok( ! defined( $result ), 'Cannot use $meta to access a site param' ); $result = $meta->get_param_meta('CELL_SITE_UNIT_TESTING'); ok( ! defined( $result ), 'Cannot use $meta to access a site param' ); # # CORE # # 'exists' returns undef on failure $status = exists $App::CELL::Config::core->{ 'CELL_CORE_UNIT_TESTING' }; ok( defined( $status ), "Core unit testing param exists" ); $value = $App::CELL::Config::core->{ 'CELL_CORE_UNIT_TESTING' }->{'Value'}; is( ref( $value ), "ARRAY", "Core unit testing param is an array reference" ); is_deeply( $value, [ 'nothing special' ], "Core unit testing param, obtained by cheating, has expected value" ); $result = $core->CELL_CORE_UNIT_TESTING; is_deeply( $result, [ 'nothing special' ], "Core unit testing param, obtained via get_param, has expected value" ); $status = $core->set( 'CELL_CORE_UNIT_TESTING', "different bar" ); ok( $status->level eq 'ERR', "Attempt to set existing core param triggered ERR" ); my $new_result = $core->CELL_CORE_UNIT_TESTING; isnt( $new_result, "different bar", "set_core did not change the value" ); is( $new_result, $result, "the value stayed the same" ); # # SITE # # 'exists' returns undef on failure $status = exists $App::CELL::Config::site->{ 'CELL_SITE_UNIT_TESTING' }; ok( defined( $status ), "Site unit testing param exists" ); $value = $App::CELL::Config::site->{ 'CELL_SITE_UNIT_TESTING' }->{'Value'}; is( ref( $value ), "ARRAY", "Site unit testing param is an array reference" ); is_deeply( $value, [ 'Om mane padme hum' ], "Site unit testing param, obtained by cheating, has expected value" ); $result = $site->CELL_SITE_UNIT_TESTING; is_deeply( $result, [ 'Om mane padme hum' ], "Site unit testing param, obtained via get_param, has expected value" ); $status = $site->set( 'CELL_SITE_UNIT_TESTING', "different baz" ); ok( $status->level eq 'ERR', "Attempt to set existing site param triggered ERR" ); $new_result = $site->CELL_SITE_UNIT_TESTING; isnt( $new_result, "different baz", "set_site did not change the value" ); is( $new_result, $result, "the value stayed the same" ); done_testing; App-CELL-0.222/t/004-debug.t000444001750000144 227012766160463 15456 0ustar00smithfarmusers000000000000#!perl # # t/004-debug.t # # The purpose of this unit test is to demonstrate how the unit tests can be # used for debugging (not to test debugging) # use 5.012; use strict; use warnings; use App::CELL::Config qw( $site ); use App::CELL::Load; use App::CELL::Log qw( $log ); use Data::Dumper; use Test::More; use Test::Warnings; # # To activate debugging, uncomment the following # #use App::CELL::Test::LogToFile; #$log->init( debug_mode => 1 ); my $status; $log->init( ident => 'CELLtest' ); $log->info("---------------------------------------------------------"); $log->info("--- 004-debug.t ---"); $log->info("---------------------------------------------------------"); is( $site->CELL_SHAREDIR_LOADED, undef, "CELL_SHAREDIR_LOADED is undefined before load"); $status = App::CELL::Load::init( verbose => 1 ); is( $status->level, "WARN", "Load without sitedir results gives warning" ); is( $site->CELL_SHAREDIR_LOADED, 1, "CELL_SHAREDIR_LOADED is true after load"); $status = App::CELL::Status->new( level => 'NOTICE', code => 'CELL_TEST_MESSAGE' ); is( $status->msgobj->text, "This is a test message", "Test message was loaded" ); done_testing; App-CELL-0.222/t/pod.t000444001750000144 36212766160463 14631 0ustar00smithfarmusers000000000000#!perl -T use 5.012; use strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod my $min_tp = 1.22; eval "use Test::Pod $min_tp"; plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; all_pod_files_ok(); App-CELL-0.222/t/030-status.t000444001750000144 1115012766160463 15727 0ustar00smithfarmusers000000000000#!perl -T use 5.012; use strict; use warnings; use App::CELL::Log qw( $log ); use App::CELL::Status; use App::CELL::Test; use Data::Dumper; use Test::More; use Test::Warnings; my $status; $log->init( ident => 'CELLtest' ); $log->info("------------------------------------------------- "); $log->info("--- 030-status.t ---"); $log->info("------------------------------------------------- "); $status = App::CELL::Status->ok; ok( $status->ok, "OK status is OK" ); ok( ! $status->not_ok, "OK status is not not_ok" ); is( $status->level, "OK", "level returns OK" ); is( $status->code, "", "No code"); my $caller = $status->caller; is( scalar @$caller , 3, "Caller is present" ); is( @$caller[0], "main", "First element of caller is 'main'" ); $status = App::CELL::Status->ok( "My payload" ); is( $status->payload, "My payload", "OK status can take a payload" ); $status = App::CELL::Status->not_ok; ok( $status->not_ok, "NOT_OK status is not_ok" ); ok( ! $status->ok, "NOT_OK status is not ok" ); is( $status->level, "NOT_OK", "level returns NOT_OK" ); is( $status->code, "", "No code"); $caller = $status->caller; is( scalar @$caller , 3, "Caller is present" ); is( @$caller[0], "main", "First element of caller is 'main'" ); $status = App::CELL::Status->not_ok( "Not my payload" ); is( $status->payload, "Not my payload", "NOT_OK status can take a payload" ); $status = App::CELL::Status->new( level => 'OK' ); ok( $status->ok, "OK status via new is OK" ); ok( ! $status->not_ok, "OK status via new is not not_ok" ); is( $status->level, "OK", "level returns OK" ); is( $status->code, "", "No code"); $caller = $status->caller; is( scalar @$caller , 3, "Caller is present" ); is( @$caller[0], "main", "First element of caller is 'main'" ); $status = App::CELL::Status->new( level => 'NOT_OK' ); ok( $status->not_ok, "NOT_OK status via new is not OK" ); ok( ! $status->ok, "NOT_OK status via new is not OK" ); is( $status->level, "NOT_OK", "level returns NOT_OK" ); is( $status->code, "", "No code"); $caller = $status->caller; is( scalar @$caller , 3, "Caller is present" ); is( @$caller[0], "main", "First element of caller is 'main'" ); $status = App::CELL::Status->new( level => 'DEBUG', code => 'Bugs galore' ); ok( $status->not_ok, "DEBUG status is not OK" ); is( $status->level, "DEBUG", "level returns DEBUG" ); is( $status->code, 'Bugs galore', "Has the right code" ); is( @$caller[0], "main", "First element of caller is 'main'" ); $status = App::CELL::Status->new( level => 'FOOBAR', code => 'Bugs flying', payload => "Obstinate" ); is( $status->level, "ERR", "Attempt to create status with non-existent level defaults to ERR level"); is( $status->code, "Bugs flying", "Code is there"); is( @$caller[0], "main", "First element of caller is 'main'" ); is( $status->payload, "Obstinate", "FOOBAR-level status can take a payload" ); $status = App::CELL::Status->new( level => 'INFO' ); is( $status->level, "INFO", "INFO level is INFO" ); ok( $status->not_ok, "INFO status is not OK" ); ok( ! $status->ok, "INFO status is not OK in another way" ); $status = App::CELL::Status->new( level => 'NOTICE', foobar => 44 ); is( $status->level, "NOTICE", "NOTICE level is NOTICE" ); ok( $status->not_ok, "NOTICE status is not OK" ); is( $status->{foobar}, 44, "Value of undocumented attribute obtainable by cheating" ); $status = App::CELL::Status->new( level => 'WARN' ); ok( $status->not_ok, "WARN status is not OK" ); $status = App::CELL::Status->new( level => 'ERR' ); ok( $status->not_ok, "ERR status is not OK" ); $status = App::CELL::Status->new( level => 'CRIT' ); ok( $status->not_ok, "CRIT status is not OK" ); $status = App::CELL::Status->new( level => 'OK', payload => [ 0, 'foo' ] ); ok( $status->ok, "OK status object with payload is OK" ); is_deeply( $status->payload, [ 0, 'foo' ], "Payload is retrievable" ); $status = App::CELL::Status->new( level => 'NOTICE', code => "Pre-init notice w/arg ->%s<-", args => [ "CONTENT" ], ); ok( ! $status->ok, "Our pre-init status is not OK" ); ok( $status->not_ok, "Our pre-init status is not_ok" ); is( $status->msgobj->text, "Pre-init notice w/arg ->CONTENT<-", "Access message object through the status object" ); $status = App::CELL::Status->new( level => 'CRIT', code => "This is just a test. Don't worry; be happy.", payload => "FOOBARBAZ", ); is( $status->payload, "FOOBARBAZ", "Payload accessor function returns the right value" ); is( $status->level, "CRIT", "Level accessor function returns the right value" ); done_testing; App-CELL-0.222/t/003-test.t000444001750000144 326312766160463 15351 0ustar00smithfarmusers000000000000#!perl -T use 5.012; use strict; use warnings; use App::CELL::Log qw( $log ); use App::CELL::Status; use App::CELL::Test qw( cmp_arrays ); use File::Spec; use Test::More; use Test::Warnings; my $status; $log->init( ident => 'CELLtest' ); $log->info("-------------------------------------------------------- "); $log->info("--- 003-test.t ---"); $log->info("-------------------------------------------------------- "); $status = App::CELL::Test::mktmpdir(); ok( $status->ok, "mktmpdir status OK" ); my $tmpdir = $status->payload; ok( -d $tmpdir, "Test directory is present" ); $status = App::CELL::Test::touch_files( $tmpdir, 'foo', 'bar', 'baz' ); is( $status, 3, "touch_files returned right number" ); $status = App::CELL::Test::cleartmpdir(); ok( $status->ok, "cleartmpdir status OK" ); ok( ! -e $tmpdir, "Test directory really gone" ); $status = -d $tmpdir; ok( ! $status, "Test directory is really gone" ); my $booltrue = cmp_arrays( [ 0, 1, 2 ], [ 0, 1, 2 ] ); ok( $booltrue, "cmp_arrays works on identical arrays" ); my $boolfalse = cmp_arrays( [ 0, 1, 2 ], [ 'foo', 'bar', 'baz' ] ); ok( ! $boolfalse, "cmp_arrays works on different arrays" ); $booltrue = cmp_arrays( [], [] ); ok( $booltrue, "cmp_arrays works on two empty arrays" ); $boolfalse = cmp_arrays( [], [ 'foo' ] ); ok( ! $boolfalse, "cmp_arrays works on one empty and one non-empty array" ); $booltrue = cmp_arrays( [ 1, 1, 1, 1, 1 ], [ 1, 1, 1, 1, 1 ] ); ok( $booltrue, "cmp_arrays works on two identical arrays of repeating ones" ); #$boolfalse = cmp_arrays( [ 1, 1, 1, 1 ], [ 1, 1, 1, 1, 1 ] ); #is( $boolfalse, 0, "cmp_arrays works on two different arrays of repeating ones" ); done_testing; App-CELL-0.222/t/033-status-accessor.t000444001750000144 170612766160463 17520 0ustar00smithfarmusers000000000000#!perl use 5.012; use strict; use warnings; use App::CELL qw( $CELL $log ); #use App::CELL::Test::LogToFile; use Data::Dumper; use Test::More; use Test::Warnings; my $status; $log->init( ident => 'CELLtest' ); $log->info("------------------------------------------------- "); $log->info("--- 033-status-accessor.t ---"); $log->info("------------------------------------------------- "); $status = $CELL->load( verbose => 1 ); # load routine will generate a warning because no sitedir specified, # but App::CELL's own sharedir will be loaded is( $status->level, 'WARN' ); $status = $CELL->status_ok( 'CELL_TEST_MESSAGE', args => [ 1 ] ); is( $status->code, 'CELL_TEST_MESSAGE' ); # use accessors to change properties $status->level( 'CRIT' ); $status->code( 'SOMETHING_ELSE' ); $status->args( [ 'FOO', 'BAR' ] ); is( $status->level, 'CRIT' ); is( $status->code, 'SOMETHING_ELSE' ); is_deeply( $status->args, [ 'FOO', 'BAR' ] ); done_testing; App-CELL-0.222/t/001-log.t000444001750000144 513312766160463 15147 0ustar00smithfarmusers000000000000#!perl use 5.012; use strict; use warnings; use App::CELL::Load; use App::CELL::Log qw( $log ); use Log::Any::Test; # BE AWARE THAT App::CELL::Test::LogToFile is # incompatible with Log::Any::Test !! use Test::More; use Test::Warnings; # check environment delete $ENV{CELL_DEBUG_MODE}; # Initialize the logger $log->init( ident => 'CELLtest', debug_mode => 1 ); $log->info("-------------------------------------------------------- "); $log->info("--- 001-log.t ---"); $log->info("-------------------------------------------------------- "); $log->clear(); $log->trace ( "TRACE log message" ); $log->contains_only_ok( "TRACE log message", 'trace works'); $log->debug ( "DEBUG log message" ); $log->contains_only_ok( "DEBUG log message", 'debug works'); $log->info ( "INFO log message" ); $log->contains_only_ok( "INFO log message", 'info works'); $log->notice ( "NOTICE log message" ); $log->contains_only_ok( "NOTICE log message", 'notice works' ); $log->warn ( "WARN log message" ); $log->contains_only_ok( "WARN log message", 'warn works' ); $log->err ( "ERR log message" ); $log->contains_only_ok( "ERR log message", 'err works' ); $log->crit ( "CRIT log message" ); $log->contains_only_ok( "CRIT log message", 'crit works' ); $log->alert ( "ALERT log message" ); $log->contains_only_ok( "ALERT log message", 'alert works' ); $log->emergency ( "EMERGENCY log message" ); $log->contains_only_ok( "EMERGENCY log message", 'emergency works' ); $log->ok ( "OK log message" ); $log->contains_only_ok( "OK log message", 'ok works' ); $log->not_ok ( "NOT_OK log message" ); $log->contains_only_ok( "NOT_OK log message", 'not_ok works' ); my $status = App::CELL::Load::init( appname => 'CELLtest' ); is( $status->level, "WARN", "Messages from sharedir loaded" ); $log->clear(); $log->init( debug_mode => 0 ); $status = App::CELL::Status->new( level => 'NOTICE', code => 'CELL_TEST_MESSAGE' ); diag( Dumper $status ); $log->contains_only_ok( '\(CELL\) NOTICE: This is a test message', "NOTICE test message ok" ); $log->trace("foo"); $log->empty_ok("No trace when debug_mode off"); $log->debug("bar"); $log->empty_ok("No debug when debug_mode off"); $log->info("baz"); $log->contains_only_ok( "baz", "INFO messages log even if debug_mode is off" ); $log->init( debug_mode => 1 ); $log->debug("bar"); $log->contains_only_ok( "bar", "debug_mode back on" ); done_testing; App-CELL-0.222/t/manifest.t000444001750000144 64512766160463 15661 0ustar00smithfarmusers000000000000#!perl -T use 5.012; use strict; use warnings; use Test::More; if ( $ENV{TRAVIS_PERL_VERSION} ) { plan( skip_all => "Detected Travis environment - skipping test" ); } unless ( $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } my $min_tcm = 0.9; eval "use Test::CheckManifest $min_tcm"; plan skip_all => "Test::CheckManifest $min_tcm required" if $@; ok_manifest(); App-CELL-0.222/t/032-status-expurgate.t000444001750000144 146212766160463 17720 0ustar00smithfarmusers000000000000#!perl use 5.012; use strict; use warnings; use App::CELL qw( $CELL $log ); #use App::CELL::Test::LogToFile; use Data::Dumper; use Scalar::Util qw( blessed ); use Test::More; use Test::Warnings; my $status; $log->init( ident => 'CELLtest' ); $log->info("-------------------------------------------------- "); $log->info("--- 032-status-expurgate.t ---"); $log->info("-------------------------------------------------- "); $status = $CELL->load( verbose => 1 ); # load routine will generate a warning because no sitedir specified, # but App::CELL's own sharedir will be loaded is( $status->level, 'WARN' ); $status = $CELL->status_ok( 'CELL_TEST_MESSAGE' ); ok( blessed $status ); my $es = $status->expurgate; #diag( "Expurgated version: " . Dumper( $es ) ); ok( ! blessed $es ); done_testing; App-CELL-0.222/t/050-load.t000444001750000144 1210412766160463 15325 0ustar00smithfarmusers000000000000#!perl use 5.012; use strict; use warnings; use App::CELL::Load; use App::CELL::Log qw( $log ); use App::CELL::Test; use Data::Dumper; use File::Spec; #use File::Touch; use Test::More; use Test::Warnings; # # To activate debugging, uncomment the following # #use App::CELL::Test::LogToFile; #$log->init( debug_mode => 1 ); my $status; $log->init( ident => 'CELLtest' ); $log->info("------------------------------------------------------ "); $log->info("--- 050-load.t ---"); $log->info("------------------------------------------------------ "); $log->info("*****"); $log->info("***** TESTING find_files for 'message' type" ); $status = App::CELL::Test::cleartmpdir(); ok( $status, "Temporary directory not present" ); $status = App::CELL::Test::mktmpdir(); my $tmpdir = $status->payload(); my @file_list = qw{ CELL_Message.conf CELL_Message_en.conf Dochazka_MetaConfig.pm Bubba_MetaConfig.pm adfa343kk.conf Dochazka_SiteConfig.pm Dochazka_Config.pm }; my $count1 = App::CELL::Test::touch_files( $tmpdir, @file_list ); # now we have some files in $tmpdir my $return_list = App::CELL::Load::find_files( 'message', $tmpdir ); # how many matched the regex? my $count2 = keys( @$return_list ); #diag( "Touched $count1 files; $count2 of them match the regex" ); ok( $count2 == 2, "find_files found the right number of files" ); # which ones? #my @return_files = map { s|^.*/(?=[^/]*$)||g; $_; } @return_list; my @return_files = map { my ( undef, undef, $file ) = File::Spec->splitpath( $_ ); $file; } @$return_list; my @should_be = ( 'CELL_Message.conf', 'CELL_Message_en.conf' ); ok( App::CELL::Test::cmp_arrays( \@return_files, \@should_be ), "find_files found the right files" ); # what about meta, core, and site configuration files? $return_list = App::CELL::Load::find_files( 'meta', $tmpdir ); ok( keys( @$return_list ) == 2, "Right number of meta config files" ); $return_list = App::CELL::Load::find_files( 'core', $tmpdir ); ok( keys( @$return_list ) == 1, "Right number of core config files" ); $return_list = App::CELL::Load::find_files( 'site', $tmpdir ); ok( keys( @$return_list ) == 1, "Right number of site config files" ); $log->info("*****"); $log->info("***** TESTING parse_message_file" ); my $stuff = <<'EOS'; # This is a test TEST_MESSAGE OK TEST_MESSAGE OKAY BORKED_MESSAGE Bimble bomble brum TEST_MESSAGE_WITH_ARG This is a %s test message EOS my $full_path = File::Spec->catfile( $tmpdir, $file_list[0] ); App::CELL::Test::populate_file( $full_path, $stuff); my %messages; #diag( "BEFORE: %messages has " . keys(%messages) . " keys" ); App::CELL::Load::parse_message_file( File => $full_path, Dest => \%messages ); #diag( "Loaded " . keys(%messages) . " message codes from $full_path" ); ok( exists $messages{'TEST_MESSAGE'}, "TEST_MESSAGE loaded from file" ); is( $messages{'TEST_MESSAGE'}->{'en'}->{'Text'}, "OK", "TEST_MESSAGE has the right text"); $log->info("*****"); $log->info("***** TESTING parse_config_file" ); $return_list = App::CELL::Load::find_files( 'meta', $tmpdir ); is( scalar @$return_list, 2, "Found right number of meta config files"); #diag( "Meta config file found: $return_list->[0]" ); $full_path = $return_list->[0]; $stuff = <<'EOS'; # This is a test set( 'TEST_PARAM_1', 'Fine and dandy' ); set( 'TEST_PARAM_2', [ 0, 1, 2 ] ); set( 'TEST_PARAM_3', { 'one' => 1, 'two' => 2 } ); set( 'TEST_PARAM_1', 'Now is the winter of our discontent' ); set( 'TEST_PARAM_4', sub { 1; } ); set( 'UNDEFINED_VALUE', undef ); 1; EOS App::CELL::Test::populate_file( $full_path, $stuff); my %params = (); my $count = App::CELL::Load::parse_config_file( File => $full_path, Dest => \%params ); is( keys( %params ), 5, "Correct number of parameters loaded from file" ); is( $count, keys( %params ), "Return value matches number of parameters loaded"); ok( exists $params{ 'TEST_PARAM_1' }, "TEST_PARAM_1 loaded from file" ); is( $params{ 'TEST_PARAM_1' }->{ 'Value' }, "Fine and dandy", "TEST_PARAM_1 has the right value" ); is_deeply( $params{ 'TEST_PARAM_2' }->{ 'Value' }, [ 0, 1, 2], "TEST_PARAM_2 has the right value" ); is_deeply( $params{ 'TEST_PARAM_3' }->{ 'Value' }, { 'one' => 1, 'two' => 2 }, "TEST_PARAM_3 has the right value" ); is( $params{ 'UNDEFINED_VALUE' }->{ 'Value' }, undef, 'UNDEFINED_VALUE is undef' ); $log->info("*****"); $log->info("***** TESTING wrong number of arguments in set" ); $stuff = <<'EOS'; # This is a test set( 'TEST_PARAM_1', 'Fine and dandy' ); set( 'TEST_PARAM_2', [ 0, 1, 2 ] ); set( 'TEST_PARAM_3', { 'one' => 1, 'two' => 2 } ); set( 'TEST_PARAM_1', 'Now is the winter of our discontent' ); set( 'TEST_PARAM_4', sub { 1; } ); set( 'WRONG_NUMBER_OF_ARGUMENTS', 1, 2 ); 1; EOS $count = App::CELL::Test::populate_file( $full_path, $stuff ); ok( $count > 0, "$count characters written; greater than zero" ); %params = (); $count = App::CELL::Load::parse_config_file( File => $full_path, Dest => \%params ); is( $count, 0 ); # FIXME done_testing; App-CELL-0.222/t/pod-coverage.t000444001750000144 172512766160463 16446 0ustar00smithfarmusers000000000000#!perl -T use 5.012; use strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod::Coverage my $min_tpc = 1.08; eval "use Test::Pod::Coverage $min_tpc"; plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" if $@; # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, # but older versions don't recognize some common documentation styles my $min_pc = 0.18; eval "use Pod::Coverage $min_pc"; plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@; #all_pod_coverage_ok(); pod_coverage_ok( "App::CELL" ); pod_coverage_ok( "App::CELL::Config" ); pod_coverage_ok( "App::CELL::Guide" ); pod_coverage_ok( "App::CELL::Load" ); pod_coverage_ok( "App::CELL::Log" ); pod_coverage_ok( "App::CELL::Message" ); pod_coverage_ok( "App::CELL::Status" ); pod_coverage_ok( "App::CELL::Test" ); #pod_coverage_ok( "App::CELL::Test::LogToFile" ); pod_coverage_ok( "App::CELL::Util" ); done_testing; App-CELL-0.222/t/005-message.t000444001750000144 451212766160463 16016 0ustar00smithfarmusers000000000000#!perl use 5.012; use strict; use warnings; use File::ShareDir; use App::CELL::Load; use App::CELL::Log qw( $log ); use App::CELL::Message; #use App::CELL::Test::LogToFile; use Data::Dumper; use Test::More; use Test::Warnings; $log->init( ident => 'CELLtest', debug_mode => 1 ); $log->info("----------------------------------------------- "); $log->info("--- 005-message.t ---"); $log->info("----------------------------------------------- "); is_deeply( App::CELL::Message::supported_languages(), [ 'en' ], "Hard-coded list of supported languages consists of just 'en'" ); ok( App::CELL::Message::language_supported( 'en' ), "English is a supported language" ); # N.B.: App::CELL is not initialized at this point, so no messages or # config params have been loaded my $status = App::CELL::Message->new(); #diag( Dumper $status ); ok( $status->not_ok, "Message->new with no code is not OK"); ok( $status->level eq 'ERR', "Message->new with no code returns ERR status"); is( $status->code, 'CELL_MESSAGE_NO_CODE', "Error message code is correct" ); is( $status->text, 'CELL_MESSAGE_NO_CODE', "Error message text is correct" ); #diag( $message->stringify ); $status = App::CELL::Message->new( code => undef ); ok( $status->not_ok, "Message->new with no code is not OK"); ok( $status->level eq 'ERR', "Message->new with no code returns ERR status"); is( $status->code, 'CELL_MESSAGE_CODE_UNDEFINED', "Error message code is correct" ); is( $status->text, 'CELL_MESSAGE_CODE_UNDEFINED', "Error message text is correct" ); $status = App::CELL::Message->new( code => 'UNGHGHASDF!*' ); ok( $status->ok, "Message->new with unknown code is OK"); my $message = $status->payload(); is( $message->code, 'UNGHGHASDF!*', "Unknown message codes are passed through" ); #diag( "Text of " . $message->code . " message is ->" . $message->text . "<-" ); $status = App::CELL::Message->new( code => "Pre-init message w/arg ->%s<-", args => [ "CONTENT" ], ); ok( $status->ok, "Message->new with unknown code and arguments is OK"); $message = $status->payload(); is( $message->text, "Pre-init message w/arg ->CONTENT<-", "Pre-init unknown message codes can contain arguments" ); $log->debug( $message->text ); #diag( "Text of " . $message->code . " message is ->" . $message->text . "<-" ); done_testing; App-CELL-0.222/t/002-util.t000444001750000144 277712766160463 15357 0ustar00smithfarmusers000000000000#!perl -T use 5.012; use strict; use warnings; use App::CELL::Log qw( $log ); use App::CELL::Status; #use App::CELL::Test::LogToFile; use App::CELL::Util qw( utc_timestamp is_directory_viable ); use File::Spec; use Test::More; use Test::Warnings; my $status; $log->init( ident => 'CELLtest' ); $log->info("-------------------------------------------------------- "); $log->info("--- 002-util.t ---"); $log->info("-------------------------------------------------------- "); # test that App::CELL::Util::timestamp returns something that looks # like a timestamp my $timestamp_regex = qr/^\d{4,4}-\d{2,2}-\d{1,2} \d{2,2}:\d{2,2}/; my $timestamp = utc_timestamp(); ok( $timestamp =~ $timestamp_regex, "App::CELL::Util::timestamp" ); #diag( "Timestamp: " . $timestamp ); # App::CELL::Util::is_directory_viable with a viable directory my $test_dir = File::Spec->catfile ( File::Spec->rootdir(), ); #diag( "Testing directory $test_dir" ); $status = is_directory_viable( $test_dir ); ok( $status, "Root directory is viable" ); # App::CELL::Util::is_directory_viable with a non-viable directory $test_dir = "###foobarbazblat342###"; #diag( "Testing directory $test_dir" ); $status = is_directory_viable( $test_dir ); #diag( $App::CELL::Util::not_viable_reason ) unless $status; ok( ! $status, "Invalid directory is not viable" ); is( $App::CELL::Util::not_viable_reason, "does not exist", "Invalid directory is not viable for the right reason" ); done_testing; App-CELL-0.222/t/111-site.t000444001750000144 347412766160463 15342 0ustar00smithfarmusers000000000000#!perl use 5.012; use strict; use warnings; use App::CELL qw( $CELL $log $meta $core $site ); use App::CELL::Test qw( mktmpdir cleartmpdir populate_file ); #use App::CELL::Test::LogToFile; #use Data::Dumper; use File::Spec; use Scalar::Util qw( blessed ); use Test::More; use Test::Warnings; my $status; delete $ENV{CELL_DEBUG_MODE}; $log->init( ident => 'CELLtest', debug_mode => 1 ); $log->info("------------------------------------------------------- "); $log->info("--- 111-site.t ---"); $log->info("------------------------------------------------------- "); is( $CELL->loaded, 0, "\$CELL->loaded is zero before anything is loaded" ); ok( ! defined( $meta->CELL_META_SITEDIR_LOADED ), "Meta param undefined before load"); my $sitedir = 'NON-EXISTENT-FOO-BAR-DIRECTORY'; ok( ! -e $sitedir, "Non-existent foo bar directory does not exist" ); $status = $CELL->load( sitedir => $sitedir ); is( $CELL->loaded, "SHARE", "\$CELL->loaded is SHARE after unsuccessful call to \$CELL->load" ); ok( $status->not_ok, "CELL initialization with non-existent sitedir NOT ok" ); is( $status->level, "ERR", "Status is ERR" ); like( $status->code, qr/\(does not exist\)/, "Status code contains expected string" ); $status = undef; delete $ENV{'CELL_SITEDIR'}; $status = $CELL->load(); is( $status->level, 'WARN', "No arguments, no environment, no previous sitedir -> warning" ); $status = $CELL->load( enviro => 'FOO_BAR_ENVIRO_PARAM' ); ok( $status->not_ok, "Load with non-existent enviro param is NOT_OK" ); is( $status->level, 'ERR', "Load with non-existent enviro param yields ERR status" ); $ENV{'CELL_SITEDIR'} = 'NON-EXISTENT-FOO-BAR-DIRECTORY'; $status = undef; $status = $CELL->load(); ok( $status->not_ok, "Load without arguments, with CELL_SITEDIR defined to a bad value, returns NOT_OK status" ); done_testing; App-CELL-0.222/t/000-dependencies.t000444001750000144 254612766160463 17020 0ustar00smithfarmusers000000000000#!perl -T use 5.012; use strict; use warnings; use Test::More; use Test::Warnings; BEGIN { # CORE modules use_ok( 'Carp' ); use_ok( 'Data::Dumper' ); use_ok( 'Exporter', qw( import ) ); use_ok( 'File::Spec' ); use_ok( 'File::Temp' ); use_ok( 'Scalar::Util', qw( blessed ) ); use_ok( 'Storable' ); use_ok( 'Test::More' ); # non-core (CPAN) modules use_ok( 'Date::Format' ); use_ok( 'File::HomeDir' ); use_ok( 'File::Next' ); use_ok( 'File::ShareDir' ); use_ok( 'Log::Any' ); use_ok( 'Log::Any::Adapter' ); use_ok( 'Log::Any::Test' ); use_ok( 'Try::Tiny' ); # modules in this distro use_ok( 'App::CELL', qw( $CELL $log $meta $core $site ) ); use_ok( 'App::CELL::Config', qw( $meta $core $site ) ); use_ok( 'App::CELL::Load' ); use_ok( 'App::CELL::Log', qw( $log ) ); use_ok( 'App::CELL::Message' ); use_ok( 'App::CELL::Status' ); use_ok( 'App::CELL::Util', qw( utc_timestamp is_directory_viable ) ); use_ok( 'App::CELL::Test' ); #use_ok( 'App::CELL::Test::LogToFile' ); } #p( %INC ); #diag( "Testing Carp $Carp::VERSION, Perl $], $^X" ); #diag( "Testing Config::Simple $Config::Simple::VERSION, Perl $], $^X" ); #diag( "Testing CELL $App::CELL::VERSION, Perl $], $^X" ); #diag( "Testing App::CELL::Config $App::CELL::Config::VERSION, Perl $], $^X" ); done_testing; App-CELL-0.222/t/110-site.t000444001750000144 1125012766160463 15350 0ustar00smithfarmusers000000000000#!perl use 5.012; use strict; use warnings; use App::CELL qw( $CELL $log $meta $core $site ); use App::CELL::Test qw( mktmpdir cleartmpdir populate_file ); #use App::CELL::Test::LogToFile; #use Data::Dumper; use File::Spec; use Scalar::Util qw( blessed ); use Test::More; use Test::Warnings; my $status; delete $ENV{CELL_DEBUG_MODE}; $log->init( ident => 'CELLtest', debug_mode => 1 ); $log->info("------------------------------------------------------- "); $log->info("--- 110-site.t ---"); $log->info("------------------------------------------------------- "); $status = mktmpdir(); ok( $status->ok, "Temporary directory created" ); my $sitedir = $status->payload; ok( -d $sitedir, "tmpdir is a directory" ); ok( -W $sitedir, "tmpdir is writable by us" ); my $full_path = File::Spec->catfile( $sitedir, 'CELL_Message_en.conf' ); my $stuff = <<'EOS'; # some messages in English TEST_MESSAGE This is a test message. FOO_BAR Message that says foo bar. BAR_ARGS_MSG This %s message takes %s arguments. EOS #diag( "Now populating $full_path" ); populate_file( $full_path, $stuff ); $full_path = File::Spec->catfile( $sitedir, 'CELL_Message_cz.conf' ); $stuff = <<'EOS'; # some messages in Czech TEST_MESSAGE Tato zpráva slouží k testování. FOO_BAR Zpráva, která zní foo bar. BAR_ARGS_MSG Tato %s zpráva bere %s argumenty. EOS #diag( "Now populating $full_path" ); populate_file( $full_path, $stuff ); $full_path = File::Spec->catfile( $sitedir, 'CELL_SiteConfig.pm' ); $stuff = <<'EOS'; # set supported languages set( 'CELL_SUPP_LANG', [ 'en', 'cz' ] ); # a random parameter set( 'A_RANDOM_PARAMETER', "34WDFWWD" ); 1; EOS #diag( "Now populating $full_path" ); populate_file( $full_path, $stuff ); ok( ! defined( $meta->CELL_META_SITEDIR_LOADED ), "Meta param undefined before load"); $status = $CELL->load( sitedir => $sitedir ); ok( $status->ok, "CELL initialization with sitedir OK" ); ok( $meta->CELL_META_SITEDIR_LOADED, "Meta param set correctly after load" ); is( $CELL->loaded, "BOTH", "Both sharedir and sitedir have been loaded" ); is_deeply( $meta->CELL_META_SITEDIR_LIST, [ $sitedir ], "List of sitedirs is correct" ); is_deeply( $CELL->supported_languages, [ 'en', 'cz' ], "CELL now supports two languages instead of just one" ); ok( $CELL->language_supported( 'en' ), "English is supported" ); ok( $CELL->language_supported( 'cz' ), "Czech is supported" ); ok( ! $CELL->language_supported( 'fr' ), "French is not supported" ); is( $site->CELL_DEF_LANG, 'en', "Site language default is English" ); my $msgobj = $CELL->msg('TEST_MESSAGE'); ok( blessed($msgobj), "Message object is blessed" ); is( $msgobj->text, 'This is a test message.', "Test message has the right text" ); $msgobj = $CELL->msg( 'NON_EXISTENT_MESSAGE' ); ok( blessed($msgobj), "Message object with undefined code is blessed" ); is( $msgobj->text, 'NON_EXISTENT_MESSAGE', "Non-existent message text the same as non-existent message code" ); $msgobj = $CELL->msg( 'BAR_ARGS_MSG', "FooBar", 2 ); is( $msgobj->text, 'This FooBar message takes 2 arguments.' ); #$status = $msgobj->lang('cz'); #my $cesky_text = $status->payload->text; #is( $cesky_text, "Tato FooBar zpráva bere 2 argumenty." ); is( $site->A_RANDOM_PARAMETER, "34WDFWWD", "Random parameter has value we set" ); #--- # and now, a second sitedir #--- $status = mktmpdir(); ok( $status->ok, "Second temporary directory created" ); my $sitedir2 = $status->payload; ok( -d $sitedir2, "Second tmpdir is a directory" ); ok( -W $sitedir2, "Second tmpdir is writable by us" ); $full_path = File::Spec->catfile( $sitedir2, 'CELL2_Message_en.conf' ); $stuff = <<'EOS'; # some messages for the second sitedir TEST2_MESSAGE This is a test2 message. FOO2_BAR Second message that says bar foo. BAR2_ARGS_MSG This second %s message takes %s arguments. EOS #diag( "Now populating $full_path" ); populate_file( $full_path, $stuff ); $full_path = File::Spec->catfile( $sitedir2, 'CELL_SiteConfig.pm' ); $stuff = <<'EOS'; set( 'CELL2_BIG_BUS_PARAM', "Vehiculo longo" ); # a random parameter set( 'A_RANDOM_PARAMETER', "different value" ); use strict; use warnings; 1; EOS #diag( "Now populating $full_path" ); populate_file( $full_path, $stuff ); $status = $CELL->load( sitedir => $sitedir2 ); ok( $status->ok, "CELL initialization with second sitedir OK" ); is( $site->CELL2_BIG_BUS_PARAM, "Vehiculo longo", "Unique param has value we set" ); is( $site->A_RANDOM_PARAMETER, "34WDFWWD", "Attempt to overwrite existing site param failed" ); is( $meta->CELL_META_SITEDIR_LOADED, 2, "Meta param set correctly after second load"); is_deeply( $meta->CELL_META_SITEDIR_LIST, [ $sitedir, $sitedir2 ], "List of sitedirs correctly expanded after second load" ); done_testing; App-CELL-0.222/t/006-config.t000444001750000144 75512766160463 15625 0ustar00smithfarmusers000000000000#!perl use 5.012; use strict; use warnings; use App::CELL qw( $log $meta ); #use App::CELL::Test::LogToFile; use Test::More; use Test::Warnings; delete $ENV{CELL_DEBUG_MODE}; $log->init( debug_mode => 1 ); my $status; $log->debug("************************************ t/006-config.t"); $status = $meta->set('MY_PARAM', 42); ok( $status->ok, "\$meta->set status OK" ); is( $meta->MY_PARAM, 42, 'MY_PARAM is 42' ); is( $meta->get_param('MY_PARAM'), 42, 'MY_PARAM is still 42' ); done_testing; App-CELL-0.222/bin000755001750000144 012766160463 14051 5ustar00smithfarmusers000000000000App-CELL-0.222/bin/CELLdemo.plx000444001750000144 155512766160463 16325 0ustar00smithfarmusers000000000000#!perl use strict; use warnings; use App::CELL qw( $CELL $log $meta $core $site ); use File::HomeDir; use File::Spec; use Log::Any::Adapter ('File', File::Spec->catfile ( File::HomeDir::my_home(), 'tmp', 'CELLdemo.log', ) ); print "App::CELL has not been initialized\n" if not $meta->CELL_META_INIT_STATUS_BOOL; $CELL->init( appname => 'CELLdemo', debug_mode => 1 ); print "App::CELL has been initialized\n" if $meta->CELL_META_INIT_STATUS_BOOL; print "App::CELL supports the following languages: ", @{ $site->CELL_SUPPORTED_LANGUAGES }, "\n"; print "CELL_CORE_SAMPLE: ", $site->CELL_CORE_SAMPLE, "\n"; App::CELL::Config::set_site( 'CELL_CORE_SAMPLE', "foobar" ); print "CELL_CORE_SAMPLE: ", $site->CELL_CORE_SAMPLE, "\n"; $log->debug( "CELLtest.plx ending" ); __END__ =pod =head1 NAME demo.plx - demonstrate how App::CELL might be used =cut App-CELL-0.222/lib000755001750000144 012766160463 14047 5ustar00smithfarmusers000000000000App-CELL-0.222/lib/App000755001750000144 012766160463 14567 5ustar00smithfarmusers000000000000App-CELL-0.222/lib/App/CELL.pm000444001750000144 2727512766160463 16036 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015, SUSE LLC # # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions are met: # # 1. Redistributions of source code must retain the above copyright notice, # this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # 3. Neither the name of SUSE LLC nor the names of its contributors may be # used to endorse or promote products derived from this software without # specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # ************************************************************************* package App::CELL; use strict; use warnings; use 5.012; use Carp; use App::CELL::Config qw( $meta $core $site ); use App::CELL::Load; use App::CELL::Log qw( $log ); use App::CELL::Status; use App::CELL::Util qw( stringify_args utc_timestamp ); use Params::Validate qw( :all ); use Scalar::Util qw( blessed ); =head1 NAME App::CELL - Configuration, Error-handling, Localization, and Logging =head1 VERSION Version 0.222 =cut our $VERSION = '0.222'; =head1 SYNOPSIS # imagine you have a script/app called 'foo' . . . use Log::Any::Adapter ( 'File', "/var/tmp/foo.log" ); use App::CELL qw( $CELL $log $meta $site ); # load config params and messages from sitedir my $status = $CELL->load( sitedir => '/etc/foo' ); return $status unless $status->ok; # set appname to FOO_APPNAME (a config param just loaded from sitedir) $CELL->appname( $CELL->FOO_APPNAME || "foo" ); # write to the log $log->notice("Configuration loaded from /etc/foo"); # get value of site configuration parameter FOO_PARAM my $val = $site->FOO_PARAM; # get a list of all supported languages my @supp_lang = $CELL->supported_languages; # determine if a language is supported print "sk supported" if $CELL->language_supported('sk'); # get message object and text in default language $status = $CELL->msg('FOO_INFO_MSG'); my $fmsg = $status->payload if $status->ok; my $text = $fmsg->text; # get message object and text in default language # (message that takes arguments) $fmsg = $CELL->msg('BAR_ARGS_MSG', "arg1", "arg2"); print $fmsg->text, "\n"; # get text of message in a different language my $sk_text = $fmsg->lang('sk')->text; =head1 DESCRIPTION This is the top-level module of App::CELL, the Configuration, Error-handling, Localization, and Logging framework for applications (or scripts) written in Perl. For details, read the POD in the L distro. For an introduction, read L. =head1 EXPORTS This module provides the following exports: =over =item C<$CELL> - App::CELL singleton object =item C<$log> - App::CELL::Log singleton object =item C<$meta> - App::CELL::Config singleton object =item C<$core> - App::CELL::Config singleton object =item C<$site> - App::CELL::Config singleton object =back =cut use Exporter qw( import ); our @EXPORT_OK = qw( $CELL $log $meta $core $site ); our $CELL = bless { appname => __PACKAGE__, enviro => '', }, __PACKAGE__; # ($log is imported from App::CELL::Log) # ($meta, $core, and $site are imported from App::CELL::Config) =head1 METHODS =head2 appname If no argument is given, returns the C -- i.e. the name of the application or script that is using L for its configuration, error handling, etc. If an argument is given, assumes that it denotes the desired C and sets it. Also initializes the logger. =cut sub appname { my @ARGS = @_; return $CELL->{appname} if not @ARGS; $CELL->{appname} = $ARGS[0]; $log->ident( $CELL->{'appname'} ); } =head2 enviro Get the C attribute, i.e. the name of the environment variable containing the sitedir =cut sub enviro { return $CELL->{enviro}; } =head2 loaded Get the current load status, which can be any of the following: 0 nothing loaded yet 'SHARE' sharedir loaded 'BOTH' sharedir _and_ sitedir loaded =cut sub loaded { return 'SHARE' if $App::CELL::Load::sharedir_loaded and not @App::CELL::Load::sitedir; return 'BOTH' if $App::CELL::Load::sharedir_loaded and @App::CELL::Load::sitedir; return 0; } =head2 sharedir Get the C attribute, i.e. the full path of the site configuration directory (available only after sharedir has been successfully loaded) =cut sub sharedir { return '' if not $App::CELL::Load::sharedir_loaded; return $App::CELL::Load::sharedir; } =head2 sitedir Get the C attribute, i.e. the full path of the site configuration directory (available only after sitedir has been successfully loaded) =cut sub sitedir { return '' if not $App::CELL::Load::sitedir_loaded; return $App::CELL::Load::sitedir; } =head2 supported_languages Get list of supported languages. Equivalent to: $site->CELL_SUPP_LANG || [ 'en ] =cut sub supported_languages { return App::CELL::Message::supported_languages(); } =head2 language_supported Determine if a given language is supported. =cut sub language_supported { return App::CELL::Message::language_supported( $_[1] ); } =head2 C Attempt to load messages and configuration parameters from the sharedir and, possibly, the sitedir as well. Takes: a PARAMHASH that should include at least one of C or C (if both are given, C takes precedence with C as a fallback). The PARAMHASH can also include a C parameter which, when set to a true value, causes the load routine to log more verbosely. Returns: an C object, which could be any of the following: OK success WARN previous call already succeeded, nothing to do ERR failure On success, it also sets the C meta parameter. =cut sub load { my $class = shift; my ( %ARGS ) = validate( @_, { enviro => { type => SCALAR, optional => 1 }, sitedir => { type => SCALAR, optional => 1 }, verbose => { type => SCALAR, default => 0 }, } ); my $status; $log->info( "CELL version $VERSION called from " . (caller)[0] . " with arguments " . stringify_args( \%ARGS ), cell => 1, suppress_caller => 1 ); # we only get past this next call if at least the sharedir loads # successfully (sitedir is optional) $status = App::CELL::Load::init( %ARGS ); return $status unless $status->ok; $log->info( "App::CELL has finished loading messages and site conf params", cell => 1 ) if $meta->CELL_META_LOAD_VERBOSE; $log->show_caller( $site->CELL_LOG_SHOW_CALLER ); $log->debug_mode ( $site->CELL_DEBUG_MODE ); $App::CELL::Message::supp_lang = $site->CELL_SUPP_LANG || [ 'en' ]; $App::CELL::Message::def_lang = $site->CELL_DEF_LANG || 'en'; $meta->set( 'CELL_META_START_DATETIME', utc_timestamp() ); $log->info( "**************** App::CELL $VERSION loaded and ready ****************", cell => 1, suppress_caller => 1 ); return App::CELL::Status->ok; } =head2 Status constructors The following "factory" makes a bunch of status constructor methods (wrappers for App::CELL::Status->new ) =cut BEGIN { foreach (@App::CELL::Log::permitted_levels) { no strict 'refs'; my $level_uc = $_; my $level_lc = lc $_; *{"status_$level_lc"} = sub { my ( $self, $code, @ARGS ) = @_; if ( @ARGS % 2 ) { # odd number of arguments $log->warn( "status_$level_lc called with odd number (" . scalar @ARGS . ") of arguments; discarding the arguments!" ); @ARGS = (); } my %ARGS = @ARGS; return App::CELL::Status->new( level => $level_uc, code => $code, caller => [ caller ], %ARGS, ); } } } =head3 status_crit Constructor for 'CRIT' status objects =head3 status_critical Constructor for 'CRIT' status objects =head3 status_debug Constructor for 'DEBUG' status objects =head3 status_emergency Constructor for 'DEBUG' status objects =head3 status_err Constructor for 'ERR' status objects =head3 status_error Constructor for 'ERR' status objects =head3 status_fatal Constructor for 'FATAL' status objects =head3 status_info Constructor for 'INFO' status objects =head3 status_inform Constructor for 'INFORM' status objects =head3 status_not_ok Constructor for 'NOT_OK' status objects =head3 status_notice Constructor for 'NOTICE' status objects =head3 status_ok Constructor for 'OK' status objects =head3 status_trace Constructor for 'TRACE' status objects =head3 status_warn Constructor for 'WARN' status objects =head3 status_warning Constructor for 'WARNING' status objects =head2 msg Construct a message object (wrapper for App::CELL::Message::new) =cut sub msg { my ( $self, $code, @ARGS ) = @_; my $status = App::CELL::Message->new( code => $code, args => [ @ARGS ] ); return if $status->not_ok; # will return undef in scalar mode return $status->payload if blessed $status->payload; return; } =head1 LICENSE AND COPYRIGHT Copyright (c) 2014-2015, SUSE LLC All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of SUSE LLC nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. =cut # END OF CELL MODULE 1; App-CELL-0.222/lib/App/CELL000755001750000144 012766160463 15306 5ustar00smithfarmusers000000000000App-CELL-0.222/lib/App/CELL/Log.pm000444001750000144 2362112766160463 16546 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015, SUSE LLC # # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions are met: # # 1. Redistributions of source code must retain the above copyright notice, # this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # 3. Neither the name of SUSE LLC nor the names of its contributors may be # used to endorse or promote products derived from this software without # specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # ************************************************************************* package App::CELL::Log; use strict; use warnings; use 5.012; # IMPORTANT: this module must not depend on any other CELL modules use Data::Dumper; use File::Spec; use Log::Any; use Scalar::Util; =head1 NAME App::CELL::Log - the Logging part of CELL =head1 SYNOPSIS use App::CELL::Log qw( $log ); # set up logging for application FooBar -- need only be done once $log->init( ident => 'FooBar' ); # do not suppess 'trace' and 'debug' messages $log->init( debug_mode => 1 ); # do not append filename and line number of caller $log->init( show_caller => 0 ); # log messages at different log levels my $level = 'warn' # can be any of the levels provided by Log::Any $log->$level ( "Foobar log message" ); # the following App::CELL-specific levels are supported as well $log->ok ( "Info-level message prefixed with 'OK: '"); $log->not_ok ( "Info-level message prefixed with 'NOT_OK: '"); # by default, the caller's filename and line number are appended # to suppress this for an individual log message: $log->debug ( "Debug-level message", suppress_caller => 1 ); # Log a status object (happens automatically when object is # constructed) $log->status_obj( $status_obj ); # Log a message object $log->message_obj( $message_obj ); =head1 EXPORTS This module provides the following exports: =over =item C<$log> - App::CELL::Log singleton =back =cut use Exporter qw( import ); our @EXPORT_OK = qw( $log ); =head1 PACKAGE VARIABLES =over =item C<$ident> - the name of our application =item C<$show_caller> - boolean value, determines if caller information is displayed in log messages =item C<$debug_mode> - boolean value, determines if we display debug messages =item C<$log> - App::CELL::Log singleton object =item C<$log_any_obj> - Log::Any singleton object =item C<@permitted_levels> - list of permissible log levels =back =cut our $debug_mode = 0; our $ident = 'CELLtest'; our $show_caller = 1; our $log = bless {}, __PACKAGE__; our $log_any_obj; our @permitted_levels = qw( OK NOT_OK TRACE DEBUG INFO INFORM NOTICE WARN WARNING ERR ERROR CRIT CRITICAL FATAL EMERGENCY ); our $AUTOLOAD; =head1 DESCRIPTION App::CELL's logs using L. This C module exists to: (1) provide documentation, (2) store the logging category (C<$ident>), (3) store the L log object, (4) provide convenience functions for logging 'OK' and 'NOT_OK' statuses. =head1 METHODS =head2 debug_mode If argument provided, set the $debug_mode package variable. If no argument, simply return the current debug-mode setting. Examples: $log->debug_mode(0); # turn debug mode off $log->debug_mode(1); # turn debug mode on print "Debug mode is on\n" if $log->debug_mode; =cut sub debug_mode { my ( $self, @ARGS ) = @_; return $debug_mode = $ARGS[0] if @ARGS; return $debug_mode; } =head2 ident Set the $ident package variable and the Log::Any category =cut sub ident { my $self = shift; $ident = shift; return $log_any_obj = Log::Any->get_logger(category => $ident); } =head2 show_caller Set the $show_caller package variable =cut sub show_caller { return $show_caller = $_[1]; } =head2 permitted_levels Access the C<@permitted_levels> package variable. =cut sub permitted_levels { return @permitted_levels }; =head2 init Initializes (or reconfigures) the logger. Although in most cases folks will want to call this in order to set C, it is not required for logging to work. See L for instructions on how to log with L. Takes PARAMHASH as argument. Recognized parameters: =over =item C -- (i.e., category) string, e.g. 'FooBar' for the FooBar application, or 'CELLtest' if none given =item C -- sets the C<$show_caller> package variable (see above) =item C -- sets the C<$debug_mode> package variable (see above) =back Always returns 1. =cut sub init { my ( $self, %ARGS ) = @_; # process 'ident' if ( defined( $ARGS{ident} ) ) { if ( $ARGS{ident} eq $ident and $ident ne 'CELLtest' ) { $log->info( "Logging already configured", cell => 1 ); } else { $ident = $ARGS{ident}; $log_any_obj = Log::Any->get_logger(category => $ident); } } else { $ident = 'CELLtest'; $log_any_obj = Log::Any->get_logger(category => $ident); } # process 'debug_mode' argument if ( exists( $ARGS{debug_mode} ) ) { $debug_mode = 1 if $ARGS{debug_mode}; $debug_mode = 0 if not $ARGS{debug_mode}; } #$log->info( "debug_mode is $debug_mode", cell => 1 ); # process 'show_caller' if ( exists( $ARGS{show_caller} ) ) { $show_caller = 1 if $ARGS{show_caller}; $show_caller = 0 if not $ARGS{show_caller}; } return 1; } =head2 DESTROY For some reason, Perl 5.012 seems to want a DESTROY method =cut sub DESTROY { my $self = shift; $self->SUPER::DESTROY if $self->can("SUPER::DESTROY"); } =head2 AUTOLOAD Call Log::Any methods after some pre-processing =cut sub AUTOLOAD { my ( $class, $msg_text, @ARGS ) = @_; my $method = $AUTOLOAD; $method =~ s/.*:://; # if method is not in permitted_levels, pass through to Log::Any # directly if ( not grep { $_ =~ m/$method/i } @permitted_levels ) { return $log_any_obj->$method( $msg_text, @ARGS ); } # we are logging a message my %ARGS; %ARGS = @ARGS if @ARGS % 2 == 0; my ( $file, $line ); my $level; my $method_uc = uc $method; if ( $method_uc eq 'OK' or $method_uc eq 'NOT_OK' ) { $level = $method_uc; $method_uc = 'INFO'; $method = 'info'; } else { $level = $method_uc; } my $method_lc = lc $method; # determine what caller info will be displayed, if any if ( %ARGS ) { if ( $ARGS{caller} ) { ( undef, $file, $line ) = @{ $ARGS{caller} }; } elsif ( $ARGS{suppress_caller} ) { ( $file, $line ) = ( '', '' ); } else { ( undef, $file, $line ) = caller; } } else { ( undef, $file, $line ) = caller; } # if this is a CELL internal debug message, continue only if # the CELL_DEBUG_MODE environment variable exists and is true if ( $ARGS{'cell'} and ( $method_lc eq 'debug' or $method_lc eq 'trace') ) { return unless $ENV{'CELL_DEBUG_MODE'}; } # if we were called with 'cell => 1', prepend '(CELL)' to the message my $cell = ''; $cell = '(CELL) ' if $ARGS{cell}; $log->init( ident => $ident ) if not $log_any_obj; die "No Log::Any object!" if not $log_any_obj; return if not $debug_mode and ( $method_lc eq 'debug' or $method_lc eq 'trace' ); $log_any_obj->$method_lc( _assemble_log_message( "$cell$level: $msg_text", $file, $line ) ); return; } =head2 status_obj Take a status object and log it. =cut sub status_obj { my ( $self, $status_obj, $cell ) = @_; my ( $level, $text, $caller, %ARGS ); $level = $status_obj->level; $text = $status_obj->text; $caller = $status_obj->caller; $ARGS{caller} = $caller if $caller; $ARGS{cell} = $cell if $cell; $text = "" if not $text; #( $level, $text ) = _sanitize_level( $level, $text ); $log->init( ident => $ident ) if not $log_any_obj; return $log->$level( $text, %ARGS ); } #=head2 msg # #Take a message object and log it. # #=cut # #sub msg { # my ( $self, $msgobj, @ARGS ) = @_; # return if not blessed( $msgobj ); # $log->init( ident => $ident ) if not $log_any_obj; # my $level = $msgobj->level; # my $text = $msgobj->text; #} sub _sanitize_level { my ( $level, $msg_text ) = @_; if ( $level eq 'OK' ) { $level = 'INFO'; $msg_text = "OK: " . $msg_text; } elsif ( $level eq 'NOT_OK' ) { $level = 'INFO'; $msg_text = "NOT_OK: " . $msg_text; } return ( lc $level, $msg_text ); } sub _assemble_log_message { my ( $message, $file, $line ) = @_; if ( $file and File::Spec->file_name_is_absolute( $file ) ) { ( undef, undef, $file ) = File::Spec->splitpath( $file ); } return "$message at $file line $line" if $show_caller and $file; return $message; } 1; App-CELL-0.222/lib/App/CELL/Message.pm000444001750000144 2307212766160463 17411 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015, SUSE LLC # # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions are met: # # 1. Redistributions of source code must retain the above copyright notice, # this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # 3. Neither the name of SUSE LLC nor the names of its contributors may be # used to endorse or promote products derived from this software without # specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # ************************************************************************* package App::CELL::Message; use strict; use warnings; use 5.012; use App::CELL::Log qw( $log ); use App::CELL::Util qw( stringify_args ); use Data::Dumper; use Try::Tiny; =head1 NAME App::CELL::Message - handle messages the user might see =head1 SYNOPSIS use App::CELL::Message; # server messages: pass message code only, message text # will be localized to the site default language, if # assertainable, or, failing that, in English my $message = App::CELL::Message->new( code => 'FOOBAR' ) # and then we pass $message as an argument to # App::CELL::Status->new # client messages: pass message code and session id, # message text will be localized according to the user's language # preference setting my $message = App::CELL::Message->new( code => 'BARBAZ', session => $s_obj ); $msg_to_display = $message->App::CELL::Message->text; # a message may call for one or more arguments. If so, # include an 'args' hash element in the call to 'new': args => [ 'FOO', 'BAR' ] # they will be included in the message text via a call to # sprintf =head1 EXPORTS AND PUBLIC METHODS This module provides the following public functions and methods: =over =item C - construct a C object =item C - get text of an existing object =item C - get maximum size of a given message code =back =cut =head1 DESCRIPTION An App::CELL::Message object is a reference to a hash containing some or all of the following keys (attributes): =over =item C - message code (see below) =item C - message text =item C - error (if any) related to this message =item C - message language (e.g., English) =item C - maximum number of characters this message is guaranteed not to exceed (and will be truncated to fit into) =item C - boolean value: text has been truncated or not =back The information in the hash is sourced from two places: the C<$mesg> hashref in this module (see L) and the SQL database. The former is reserved for "system critical" messages, while the latter contains messages that users will come into contact with on a daily basis. System messages are English-only; only user messages are localizable. =head1 PACKAGE VARIABLES =head2 C<$mesg> The C module stores messages in a package variable, C<$mesg> (which is a hashref). =head2 C<@supp_lang> List of supported languages. Set by C<< $CELL->load >> from the value of CELL_SUPP_LANG =head2 C<$def_lang> The defined, or default, language. Set by C<< $CELL->load >> from the value of CELL_DEF_LANG =cut our $mesg = {}; our $supp_lang; our $def_lang; =head1 FUNCTIONS AND METHODS =head2 supported_languages Get reference to list of supported languages. =cut sub supported_languages { my $sl = $supp_lang || [ 'en' ]; return $sl; } =head2 language_supported Determine if a given language is supported. =cut sub language_supported { my ( $lang ) = @_; return 1 if grep( /$lang/, @{ supported_languages() } ); return 0; } =head2 default_language Return the default language. =cut sub default_language { my $dl = $def_lang || 'en'; return $dl; } =head2 new Construct a message object. Takes a PARAMHASH containing, at least, a 'code' attribute as well as, optionally, other attributes such as 'args' (a reference to an array of arguments). Returns a status object. If the status is ok, then the message object will be in the payload. See L. =cut sub new { my ( $class, %ARGS ) = @_; my $stringified_args = stringify_args( \%ARGS ); my $my_caller; my $msgobj = {}; #$log->debug( "Entering Message->new called from " . (caller)[1] . " line " . (caller)[2]); if ( $ARGS{called_from_status} ) { $my_caller = $ARGS{caller}; } else { $my_caller = [ caller ]; } if ( not exists( $ARGS{'code'} ) ) { return App::CELL::Status->new( level => 'ERR', code => 'CELL_MESSAGE_NO_CODE', caller => $my_caller, ); } if ( not $ARGS{'code'} ) { return App::CELL::Status->new( level => 'ERR', code => 'CELL_MESSAGE_CODE_UNDEFINED', caller => $my_caller, ); } $msgobj->{'code'} = $ARGS{code}; if ( $ARGS{lang} ) { $log->debug( $ARGS{code} . ": " . $mesg->{ $ARGS{code} }->{ $ARGS{lang} }->{ 'Text' }, cell => 1 ); } $msgobj->{'lang'} = $ARGS{lang} || $def_lang || 'en'; $msgobj->{'file'} = $mesg-> { $msgobj->{code} }-> { $msgobj->{lang} }-> { 'File' } || ''; $msgobj->{'line'} = $mesg-> { $msgobj->{code} }-> { $msgobj->{lang} }-> { 'Line' } || ''; # This next line is important: it may happen that the developer wants # to quickly code some messages/statuses without formally assigning # codes in the site configuration. In these cases, the $mesg lookup # will fail. Instead of throwing an error, we just generate a message # text from the value of 'code'. my $text = $mesg-> { $msgobj->{code} }-> { $msgobj->{lang} }-> { 'Text' } || $msgobj->{code}; # strip out anything that resembles a newline $text =~ s/\n//g; $text =~ s/\012/ -- /g; my $stringy = stringify_args( $ARGS{args} ) || ''; if ( defined $ARGS{args} and @{ $ARGS{args} } and not $text =~ m/%s/ ) { $ARGS{text} = $text . " ARGS: $stringy"; } else { $log->debug( "About to try sprintf on ->$text<- with arguments ->$stringy<-", cell => 1 ); # insert the arguments into the message text -- needs to be in an eval # block because we have no control over what crap the application # programmer might send us try { local $SIG{__WARN__} = sub { die @_; }; $ARGS{text} = sprintf( $text, @{ $ARGS{args} || [] } ); } catch { my $errmsg = $_; $errmsg =~ s/\012/ -- /g; $ARGS{text} = "CELL_MESSAGE_ARGUMENT_MISMATCH on $ARGS{code}, error was: $errmsg"; $log->err( $ARGS{text}, cell => 1); }; } $msgobj->{'text'} = $ARGS{text}; # uncomment if needed #$log->debug( "Creating message object ->" . $ARGS{code} . # "<- with args ->$stringified_args<-", # caller => $my_caller, cell => 1); # bless into objecthood my $self = bless $msgobj, __PACKAGE__; # return ok status with created object in payload return App::CELL::Status->new( level => 'OK', payload => $self, ); } =head2 lang Clones the message into another language. Returns a status object. On success, the new message object will be in the payload. =cut sub lang { my ( $self, $lang ) = @_; my $status = __PACKAGE__->new( code => $self->code, lang => $lang, args => $self->args, ); return $status; } =head2 stringify Generate a string representation of a message object using Data::Dumper. =cut sub stringify { local $Data::Dumper::Terse = 1; my $self = shift; my %u_self = %$self; return Dumper( \%u_self ); } =head2 code Accessor method for the 'code' attribute. =cut sub code { my $self = shift; return if not $self->{code}; # returns undef in scalar context return $self->{code}; } =head2 args Accessor method for the 'args' attribute. =cut sub args { my $self = $_[0]; return [] if not $self->{args}; return $self->{args}; } =head2 text Accessor method for the 'text' attribute. Returns content of 'text' attribute, or "" if it can't find any content. =cut sub text { my $self = $_[0]; return "" if not $self->{text}; return $self->{text}; } 1; App-CELL-0.222/lib/App/CELL/Guide.pm000444001750000144 7703312766160463 17070 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015, SUSE LLC # # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions are met: # # 1. Redistributions of source code must retain the above copyright notice, # this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # 3. Neither the name of SUSE LLC nor the names of its contributors may be # used to endorse or promote products derived from this software without # specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # ************************************************************************* package App::CELL::Guide; use strict; use warnings; use 5.012; =head1 NAME App::CELL::Guide - Introduction to App::CELL (POD-only module) =head1 VERSION Version 0.222 =cut our $VERSION = '0.222'; =head1 SYNOPSIS $ perldoc App::CELL::Guide =head1 INTRODUCTION L is the Configuration, Error-handling, Localization, and Logging (CELL) framework for applications written in Perl. In the L section, this Guide describes the CELL approach to each of these four areas, separately. Then, in the section, it presents the author's reasons for bundling them together. =head1 HISTORY CELL was written by Smithfarm in 2013 and 2014, initially as part of the Dochazka project [[ link to SourceForge ]]. Due to its generic nature, it was spun off into a separate project. =head1 GENERAL APPROACH This section presents CELL's approach to each of its four principal functions: L, L, L, and L. =head2 Approach to configuration CELL provides the application developer and site administrator with a straightforward and powerful way to define configuration parameters as needed by the application. If you are familiar with Request Tracker, you will know that there is a directory (C by default) which contains two files, called C and C -- as their names would indicate, they are actually Perl modules. The former is provided by the upstream developers and contains all of RT's configuration parameters and their "factory default" settings. The content of the latter is entirely up to the RT site administrator and contains only those parameters that need to be different from the defaults. Parameter settings in C, then, override the defaults set in C. L provides this same functionality in a drop-in Perl module, with some subtle differences. While RT uses a syntax like this: set( 'MY_PARAM', ...arguments...); where C<...arguments...> is a list of scalar values (as with any Perl subroutine), L uses a slightly different format: set( 'MY_PARAM', $scalar ); where C<$scalar> can be any scalar value, i.e. including references. (Another difference is that L provides both immutable site parameters _and_ mutable C configuration parameters, whereas RT's meta parameters are only used by RT itself.) For more information on configuration, see L. =head2 Error handling To facilitate error handling and make the application's source code easier to read and understand, or at least mitigate its impenetrability, CELL provides the L module, which enables functions in the application to return status objects if desired. Status objects have the following principal attributes: C, C, C, and C, which are given by the programmer when the status object is constructed, as well as attributes like C, C, and C, which are derived by CELL. In addition to the attributes, C also provides some useful methods for processing status objects. In order to signify an error, subroutine C could for example do this: return $CELL->status_err( code => 'Gidget displacement %s out of range', args => [ $displacement ], ); (Instead of having the error text in the C, it could be placed in a message file in the sitedir with a code like DISP_OUT_OF_RANGE.) On success, C could return an 'OK' status with the gidget displacement value in the payload: return $CELL->status_ok( payload => $displacement ); The calling function could check the return value like this: my $status = foo_dis(); return $status if $status->not_ok; my $displacement = $status->payload; For details, see L and L. CELL's error-handling logic is inspired by brian d foy's article "Return error objects instead of throwing exceptions" L =head2 Localization This CELL component, called "Localization", gives the programmer a way to encapsulate a "message" (in its simplest form, a string) within a message object and then use that object in various ways. So, provided the necessary message files have been loaded, the programmer could do this: my $message = $CELL->message( code => 'FOOBAR' ); print $message->text, '\n'; # message FOOBAR in the default language print $message->text( lang => 'de' ) # same message, in German Messages are loaded when CELL is initialized, from files in the site configuration directory. Each file contains messages in a particular language. For example, the file C contains messages relating to the Dochazka application, in the English language. To provide the same messages in German, the file would be copied to C and translated. Since message objects are used by L, it is natural for the programmer to put error messages, warnings, etc. in message files and refer to them by their codes. C could also be extended to provide methods for encrypting messages and/or converting them into various target formats (JSON, HTML, Morse code, etc.). For details, see and . =head2 Logging For logging, CELL uses L and optionally extends it by adding the caller's filename and line number to each message logged. Message and status objects have 'log' methods, of course, and by default all statuses (except 'OK') are logged upon creation. Here's how to set up (and do) logging in the application: use App::CELL::Log qw( $log ); $log->init( ident => 'AppFoo' ); $log->debug( "Three lines into AppFoo" ); L provides its own singleton, but since all method calls are passed to L, anyway, the L singleton behaves just like its L counterpart. This is useful, e.g., for testing log messages: use Log::Any::Test; $log->contains_only_ok( "Three lines into AppFoo" ); To actually see your log messages, you have to do something like this: use Log::Any::Adapter ('File', $ENV{'HOME'} . '/tmp/CELLtest.log'); =head1 DETAILED SPECIFICATIONS =head2 Configuration =head3 Three types of parameters CELL recognizes three types of configuration parameters: C, C, and C. These parameters and their values are loaded from files prepared and placed in the sitedir in advance. =head4 Meta parameters Meta parameters are by definition mutable: the application can change a meta parameter's value any number of times, and L will not care. Initial C param settings are placed in a file entitled C<$str_MetaConfig.pm> (where C<$str> is a string free of underscore characters) in the sitedir. For example, if the application name is FooApp, its initial C parameter settings could be contained in a file called C. At initialization time, L looks in the sitedir for files matching this description, and attempts to load them. (See L.) =head4 Core parameters As in Request Tracker, C paramters have immutable values and are intended to be used as "factory defaults", set by the developer, that the site administrator can override by setting site parameters. If the application is called FooApp, its core configuration settings could be contained in a file called C located in the sitedir. (See L for details.) =head4 Site parameters Site parameters are kept separate from core parameters, but are closely related to them. As far as the application is concerned, there are only site parameters. How this works is best explained by two examples. Let C be an application that uses L. In the first example, core param C is set to "Bar" and site param C is I set at all. When the application calls C<< $site->FOO >> the core parameter value "Bar" is returned. In the second example, the core param C is set to "Bar" and site param C is also set, but to a different value: "Whizzo". In this scenario, when the application calls C<< $site->FOO >> the site parameter ("Whizzo") value is returned. This setup allows the site administrator to customize the application. Site parameters are set in a file called C<$str_SiteConfig.pm>, where C<$str> could be the appname. =head4 Conclusion How these three types of parameters are defined and used is up to the application. As far as L is concerned, they are all optional. L itself has its own internal meta, core, and site parameters, but these are located elsewhere -- in the so-called "sharedir", a directory that is internal to the L distro/package. All these internal parameters start with C and are stored in the same namespaces as the application's parameters. That means the application programmer should avoid using parameters starting with C. =head3 Where configuration files are located =head4 sitedir Configuration parameters are placed in specially-named files within a directory referred to by L as the "site configuration directory", or "sitedir". This directory is not a part of the L distribution and L does not create it. Instead, the application is expected to provide the full path to this directory to CELL's initialization route, either via an argument to the function call or with the help of an environment variable. CELL's initialization routine calls L to do the actual work of walking the directory. This "sitedir" (site configuration directory) is assumed to be the place (or a place) where the application can store its configuration information in the form of C, C, and C parameters. For L purposes, C codes and their corresponding texts (in one or more languages) can be stored here as well, if desired. =head4 sharedir CELL itself has an analogous configuration directory, called the "sharedir", where it's own internal configuration defaults are stored. CELL's own core parameters can be overridden by the application's site params, and in some cases this can even be desirable. For example, the parameter C can be overridden in the site configuration to tell CELL to include debug-level messages in the log. During initialization, CELL walks first the sharedir, and then the sitedir, looking through those directories and all their subdirectories for meta, core, site, and message configuration files. The sharedir is part of the App::CELL distro and CELL's initialization routine finds it via a call to the C routine in the L module. =head3 How the sitedir is specified The sitedir must be created and populated with configuration files by the application programmer. Typically, this directory would form part of the application distro and the site administrator would be expected to make a site configuration file for application-specific parameters. The application developer and site administrator have flexibility in this regard -- CELL's initialization routine, C<< $CELL->load >> will work without a sitedir, with one sitedir, or even with multiple sitedirs. =head4 No sitedir It is possible, but probably not useful, to call C<< $CELL->load >> without a sitedir parameter and without any sitedir specified in the environment. In this case, CELL just loads the sharedir and returns OK. =head4 One sitedir If there is only one sitedir, there are three possible ways to specify it to CELL's load routine: (1) a C parameter, (2) an C parameter, or (3) the hard-coded C environment variable. =head4 Multiple sitedirs If the application needs to load configuration parameters from multiple sitedirs, this can be accomplished simply by calling C<< $CELL->load >> multiple times with different C arguments. =head3 Sitedir search algorithm Every time it is called, the load routine uses the following algorithm to search for a/the sitedir: =over =item C parameter -- a C parameter containing the full path to the sitedir can be passed. If it is present, CELL will try it first. If needed for portability, the path can be constructed using L (e.g. the C method) or similar. It should be string containing the full path to the directory. If the C argument points to a valid sitedir, it is loaded and OK is returned. If a C argument is present but invalid, an ERR status results. If no C argument was given, CELL continues to the next step. =item C parameter -- if no C parameter is given, C<< $CELL->load >> looks for a parameter called C which it interprets as the name of an environment variable containing the sitedir path. If the C argument points to a valid sitedir, it is loaded and OK is returned. If an C argument is present but invalid, an ERR status results. If there is no C argument at all, CELL continues to the next step. =item C environment variable -- if no viable sitedir can be found by consulting the function call parameters, CELL's load routine falls back to this hardcoded environment variable. If the C environment variable exists and points to a valid sitedir, it is loaded and OK is returned. If it exists but the directory is invalid, an ERR status is returned. If the environment variable doesn't exist, CELL writes a warning to the log (all attempts to find the sitedir failed). The return status in this case can be either WARN (if no sitedir was found in a previous call to the function) or OK if at least one sitedir has been loaded. =back The C routine is re-entrant: it can be called any number of times. On first call, it will load CELL's own sharedir, as well as any sitedir that can be found using the above algorithm. All further calls will just run the sitedir search algorithm again. Each time it will find and load at most one sitedir. CELL maintains a list of loaded sitedirs in C<< $meta->CELL_META_SITEDIR_LIST >>. For examples of how to call the C routine, see L. =head3 How configuration files are named Once it finds a valid sitedir, CELL walks it (including I its subdirectories), assembling a list of filenames matching one four regular expressions: =over =item C<^.+_MetaConfig.pm$> (meta) =item C<^.+_Config.pm$> (core) =item C<^.+_SiteConfig.pm$> (site) =item C<^.+_Message(_[^_]+){0,1}.conf$> (message) =back Files with names that don't match any of the above regexes are ignored. After the directory is walked, the files are loaded (i.e. parsed for config params and messages). The syntax of these files is simple and should be obvious from an examination of CELL's own configuration files in the sharedir (C in the distro). All four types of configuration file are there, with comments. Since the configuration files are Perl modules, Perl itself is leveraged to parse them. Values can be any legal scalar value, so references to arrays, hashes, or subroutines can be used, as well as simple numbers and strings. For details, see L, L and L. Message file parsing is done by a parsing routine that resides in L. For details on the syntax and how the parser works, see L. =head2 Configuration diagnostics CELL provides several ways for the application to find out if the configuration files were loaded properly. First of all, the load routine (C<< $CELL->load >>) returns a status object: if the status is not OK, something went wrong and the application should look at the status more closely. After program control returns from the load routine, the following methods and attributes can be used to find out what happened: =over =item C<< $site->CELL_SHAREDIR_LOADED >> (boolean value) =item C<< $site->CELL_SHAREDIR_FULLPATH >> (full path of CELL's sharedir) =item C<< $meta->CELL_META_SITEDIR_LOADED >> (boolean value: true if at least one sitedir has been loaded) =item C<< $meta->CELL_META_SITEDIR_LIST >> (reference to a list of all sitedirs that have been loaded -- full paths) =back =head3 Verbose and debug mode The load routine takes two options to increase its verbosity. The first option, C, can be passed like this: my $status = $CELL->load( verbose => 1 ); It causes the load routine to write additional information to the log. Since even this can easily be too much, the default value for C is zero (terse logging). The load routine also has a C mode which should be activated in combination with C. Debug mode is actually a function of the CELL logger, and is activated like this: $log->init( debug_mode => 1 ); Ordinarily the logger suppresses all log messages below C level (i.e., C and C). When C is activated, all messages are logged, regardless of level. =head2 Error handling =head3 STATUS OBJECTS The most frequent case will be a status code of "OK" with no message (shown here with optional "payload", which is whatever the function is supposed to return on success: # all green return App::CELL::Status->new( level => 'OK', payload => $my_return_value, ); To ensure this is as simple as possible in cases when no return value (other than the simple fact of an OK status) is needed, we provide a special constructor method: # all green return App::CELL::Status->ok; In most other cases, we will want the status message to be linked to the filename and line number where the C method was called. If so, we call the method like this: # relative to me App::CELL::Status->new( level => 'ERR', code => 'CODE1', args => [ 'foo', 'bar' ], ); It is also possible to report the caller's filename and line number: # relative to my caller App::CELL::Status->new( level => 'ERR', code => 'CODE1', args => [ 'foo', 'bar' ], caller => [ caller ], ); It is also possible to pass a message object in lieu of C and C (this could be useful if we already have an appropriate message on hand): # with pre-existing message object App::CELL::Status->new( level => 'ERR', msg_obj => $my_msg; ); Permitted levels are listed in the C<@permitted_levels> package variable in C. =head2 Localization =head3 Introduction To an application programmer, localization may seem like a daunting proposition, and All strings the application displays to users must be replaced by variable names. Then you have to figure out where to put all the strings, translate them into multiple languages, write a library (or find an existing one) to display the right string in the right language at the right time and place. What is more, the application must be configurable, so the language can be changed by the user or the site administrator. All of this is a lot of work, particularly for already existing, non-localized applications, but even for new applications designed from the start to be localizable. App::CELL's objective is to provide a simple, straightforward way to write and maintain localizable applications in Perl. Notice the key word "localizable" -- the application may not, and most likely will not, be localized in the initial stages of development, but that is the time when localization-related design decisions need to be made. App::CELL tries to take some of the guesswork out of those decisions. Later, when it really is time for the application to be translated into one or more additional languages, this becomes a relatively simple matter of translating a bunch of text strings that are grouped together in one or more configuration files with syntax so trivial that no technical expertise is needed to work with them. (Often, the person translating the application is not herself technically inclined.) =head2 Localization with App::CELL All strings that may potentially need be localized (even if we don't have them translated into other languages yet) are placed in message files under the site configuration directory. In order to be found and parsed by App::CELL, message files must meet some basic conditions: =over =item 1. file name format: C =item 2. file location: anywhere under the site configuration directory =item 3. file contents: must be parsable =back =head3 Format of message file names At initialization time, App::CELL walks the site configuration directory tree looking for filenames that meet certain regular expressions. The regular expression for message files is: ^.+_Message(_[^_]+){0,1}.conf$ In less-precise human terms, this means that the initialization routine looks for filenames consisting of at least three, but possibly four, components: =over =item 1. the application name (this can be anything) =item 2. followed by C<_Message> =item 3. optionally followed by C<_languagetag> where "languagetag" is a language tag (see L for details) =item 4. ending in C<.conf> =back Examples: CELL_Message.conf CELL_Message_en.conf CELL_Message_cs-CZ.conf DifferentApplication_Message.conf =head3 Location of message files As noted above, message files will be found as long as they are readable and located anywhere under the base site configuration directory. For details on how this base site configuration directory is searched for and determined, see L. =head3 How message files are parsed Message files are parsed line-by-line. The parser routine is C in the C module. Lines beginning with a hash sign ('#') are ignored. The remaining lines are divided into "stanzas", which must be separated by one or more blank lines. Stanzas are interpreted as follows: the first line of the stanza should contain a message code, which is simply a string. Any legal Perl scalar value can be used, as long as it doesn't contain white space. CELL itself uses ALL_CAPS strings starting with C. The remaining lines of the stanza are assumed to be the message text. Two caveats here: =over =item 1. In the configuration file, message text strings can be written on multiple lines =item 2. However, this is intended purely as a convenience for the application programmer. When C encounters multiple lines of text, it simply concatenated them together to form a single, long string. =back For details, see the C function in C, as well as App::CELL's own message file(s) in C directory of the App::CELL distro. =head2 How the language is determined Internally, each message text string is stored along with a language tag, which defines which language the message text is written in. The language tag is derived from the filename using a regular expression like this one: _Message_([^_]+).conf$ (The part in parentheses signifies the part between C<_Message_> and C<.conf> -- this is stored in the C attribute of the message object.) No sanity checks are conducted on the language tag. Whatever string the regular expression produces becomes the language tag for all messages in that file. If no language tag is found, CELL first looks for a config parameter called C and, failing that, the hard-coded fallback value is C. I'll repeat that, since it's important: CELL assumes that the message file names contain the relevant language tag. If the message file name is C, then CELL will tag all messages in that file as being in the C language. Message files can also be named like this: C, i.e. without a language tag. In this case, CELL will attempt to determine the default language from a site configuration parameter (C). If this parameter is not set, then CELL will give up and assume that all message text strings are in English (language tag C -- CELL's author's native tongue). =head2 Language tags in general See the W3C's "Language tags in HTML and XML" white paper for a detailed explanation of language tags: L And see here for list of all language tags: L Note that you should use hyphens, and not underscores, to separate components within the language tag, i.e.: MyApp_Message_cs-CZ.conf # correct MyApp_Message_cs_CZ.conf # WRONG!! Non-ASCII characters in config/message file names: may or may not work. Better to avoid them. =head2 Normal usage In normal usage, the programmer adds messages to the respective message files. After CELL initialization, these messages (or, more precisely, message code-language pairs) will be available to the programmer to use, either directly via CELL::Message->new or indirectly as status codes. If a message code has text strings in multiple languages, these language variants can be obtained by specifying the C parameter to CELL::Message->new. If the C parameter is not specified, CELL will always try to use the default language (C or English if that parameter has not been set). =head2 Logging CELL's logging facility is based on L. In practice, this means that L is simply a wrapper around this useful module. To use it, one imports the L singleton via L like this: use App::CELL qw( $log ); Since this I the L singleton, all L methods can be used with it. CELL provides some conveniences, but they are optional. Actually, if the developer does not intend to use any of CELL's conveniences, there is no reason to import it through L at all and one can use L directly. In this case, CELL's log messages will go to the same log as the application's provided the L category is the same as the CELL C. See L for a description of how to increase logging verbosity of the load routine. =head1 CAVEATS =head2 Internal parameters L stores its own parameters (mostly meta and core, but also one site param) in a separate directory, but when loaded they end up in the same namespaces as the application's meta, core, and site parameters. The names of these internal parameters are always prefixed with C. Therefore, the application programmer should avoid using parameters starting with C. =head2 Mutable and immutable parameters It is important to realize that, although core parameters can be overriden by site parameters, internally the values of both are immutable. Although it is possible to change them by cheating, the 'set' method of C<$core> and C<$site> will refuse to change the value of an existing core/site parameter. Therefore, use C<$meta> to store mutable values. =head2 Taint mode Since it imports configuration data at runtime from files supplied by the user, L should not be run under taint mode. The C<< load >> routine checks this and will refuse to do anything if running with C<-T>. To recapitulate: don't run L in taint mode. =head2 Installation issues with CELL internal sharedir The easiest way to install L is to use a package manager (e.g. C). Another way to install directly from CPAN using, e.g., C). The former way installs to the C tree, while the latter installs to the C tree. If you install two different versions of L, one via package manager and another directly from CPAN, a conflict can arise, and it may be necessary to examine CELL's log to determine which one is being used. Even after running, e.g., C, to uninstall from C, I found that CELL's internal sharedir remained intact in the C tree and had to be wiped manually. As long as you always install either one way or other other (i.e. package manager or direct from CPAN), you won't get bitten by this. =head1 COMPONENTS =head2 L This top-level module exports a singleton, C<$CELL>, which is all the application programmer needs to gain access to the CELL's key functions. =head2 C This module provides CELL's Configuration functionality. =head2 C This guide. =head2 C This module hides all the complexity of loading messages and config params from files in two directories: (1) the App::CELL distro sharedir containing App::CELL's own configuration, and (2) the site configuration directory, if present. =head2 C Logging is accomplished by using and extending L. =head2 C Localization is on the wish-list of many software projects. With CELL, the programmer can easily design and write my application to be localizable from the very beginning, without having to invest much effort. =head2 C Provides CELL's error-handling functionality. Since status objects inherit from message objects, the application programmer can instruct CELL to generate localized status messages (errors, warnings, notices) if desired. =head2 C Some routines used by CELL's test suite. =head2 C Some generalized utility routines. =head1 RATIONALE In the author's experience, applications written for "users" (however that term may be defined) frequently need to: =over =item 1. be configurable by the user or site administrator =item 2. handle errors robustly, without hangs and crashes =item 3. potentially display messages in various languages =item 4. log various types of messages to syslog =back Since these basic functions seem to work well together, CELL is designed to provide them in an integrated, well-documented, straightforward, and reusable package. =cut 1; App-CELL-0.222/lib/App/CELL/Load.pm000444001750000144 7060712766160463 16712 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015, SUSE LLC # # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions are met: # # 1. Redistributions of source code must retain the above copyright notice, # this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # 3. Neither the name of SUSE LLC nor the names of its contributors may be # used to endorse or promote products derived from this software without # specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # ************************************************************************* package App::CELL::Load; use strict; use warnings; use 5.012; use App::CELL::Config qw( $meta $core $site ); use App::CELL::Log qw( $log ); use App::CELL::Message; use App::CELL::Status; use App::CELL::Test qw( cmp_arrays ); use App::CELL::Util qw( stringify_args is_directory_viable ); use Data::Dumper; use File::Next; use File::ShareDir; use Params::Validate qw( :all ); =head1 NAME App::CELL::Load -- find and load message files and config files =head1 SYNOPSIS use App::CELL::Load; # Load App::CELL's internal messages and config params and then # attempt to load the application's messages and config params $status = App::CELL::Load::init(); return $status if $status->not_ok; # attempt to determine the site configuration directory my $resulthash = App::CELL::Load::get_sitedir(); # get a reference to a list of configuration files (full paths) of a # given type under a given directory my $metafiles = App::CELL::Load::find_files( '/etc/CELL', 'meta' ); # load messages from all message file in a given directory and all its # subdirectories $status = message_files( '/etc/CELL' ); # load meta, core, and site params from all meta, core, and site # configuration files in a given directory and all its subdirectories $status = meta_core_site_files( '/etc/CELL' ); =head1 DESCRIPTION The purpose of the App::CELL::Load module is to provide message and config file finding and loading functionality to the App::CELL::Message and App::CELL::Config modules. =head1 PACKAGE VARIABLES This module provides the following package variables =over =item C<$sharedir> - the full path of the sharedir =item C<$sharedir_loaded> - whether it has been loaded or not =item C<@sitedir> - the full path of the site configuration directory =back =cut our $sharedir = ''; our $sharedir_loaded = 0; our @sitedir = (); =head1 MODULES =head2 init Idempotent initialization function. Optionally takes a PARAMHASH. The following arguments are recognized: =over =item C -- full path to the/a site dir =item C -- name of environment variable containing sitedir path =item C -- increase logging verbosity of the load routine =back E.g.: my $status = App::CELL::Load::init( sitedir => '/etc/foo', verbose => 1 ); See L for details. =cut sub init { my @ARGS = @_; # process args return App::CELL::Status->new( level => 'err', code => 'Odd number of arguments provided to load routine', ) if ( @ARGS % 2 ); my %ARGS = @ARGS; # determine verbosity level my $args_string; if ( @ARGS ) { $args_string = "with arguments: " . stringify_args( \%ARGS ); } else { $args_string = "without arguments"; } $meta->set('CELL_META_LOAD_VERBOSE', $ARGS{'verbose'} || 0); $log->info( "Entering App::CELL::Load::init " . "from " . (caller)[0] . " $args_string", cell => 1) if $meta->CELL_META_LOAD_VERBOSE; # check for taint mode if ( ${^TAINT} != 0 ) { return App::CELL::Status->new( level => "FATAL", code => "Attempt to load while in taint mode (-T)" ); } # look up sharedir if ( not $sharedir ) { my $tmp_sharedir = File::ShareDir::dist_dir('App-CELL'); if ( ! is_directory_viable( $tmp_sharedir ) ) { return App::CELL::Status->new( level => 'ERR', code => 'CELL_SHAREDIR_NOT_VIABLE', args => [ $tmp_sharedir, $App::CELL::Util::not_viable_reason ], ); } $log->info( "Found viable CELL configuration directory " . $tmp_sharedir . " in App::CELL distro", cell => 1 ) if $meta->CELL_META_LOAD_VERBOSE; $site->set( 'CELL_SHAREDIR_FULLPATH', $tmp_sharedir ); $sharedir = $tmp_sharedir; } # walk sharedir if ( $sharedir and not $sharedir_loaded ) { my $status = message_files( $sharedir ); my $load_status = _report_load_status( $sharedir, 'sharedir', 'message', $status ); return $load_status if $load_status->not_ok; $status = meta_core_site_files( $sharedir ); $load_status = _report_load_status( $sharedir, 'sharedir', 'config params', $status ); return $load_status if $load_status->not_ok; $site->set( 'CELL_SHAREDIR_LOADED', 1 ); $sharedir_loaded = 1; } if ( $meta->CELL_META_LOAD_VERBOSE ) { if ( @sitedir ) { $log->debug( "sitedir package variable contains ->" . join( ':', @sitedir ) . "<-", cell => 1 ); } else { $log->debug( "sitedir package variable is empty", cell => 1 ); } } # get sitedir from args or environment my $status = get_sitedir( %ARGS ); return $status unless $status->ok; my $sitedir_candidate = $status->payload; # walk sitedir if ( $sitedir_candidate ) { my $status = message_files( $sitedir_candidate ); my $messages_loaded = _report_load_status( $sitedir_candidate, 'sitedir', 'message', $status ); $status = meta_core_site_files( $sitedir_candidate ); my $params_loaded = _report_load_status( $sitedir_candidate, 'sitedir', 'config params', $status ); # # sitedir candidate is accepted only if something is actually # loaded # if ( $messages_loaded->ok or $params_loaded->ok ) { $meta->set( 'CELL_META_SITEDIR_LOADED', ( $meta->CELL_META_SITEDIR_LOADED + 1 ) ); push @sitedir, $sitedir_candidate; $meta->set( 'CELL_META_SITEDIR_LIST', \@sitedir ); } } # check that at least sharedir has really been loaded SANITY: { my $results = []; # remember, message constructor returns a status object my $status = App::CELL::Message->new( code => 'CELL_LOAD_SANITY_MESSAGE' ); if ( $status->ok ) { my $msgobj = $status->payload; push @$results, ( $meta->CELL_LOAD_SANITY_META, $core->CELL_LOAD_SANITY_CORE, $site->CELL_LOAD_SANITY_SITE, $msgobj->text(), ); my $cmp_arrays_result = cmp_arrays( $results, [ 'Baz', 'Bar', 'Foo', 'This is a sanity testing message' ], ); last SANITY if $cmp_arrays_result; } return App::CELL::Status->new( level => 'ERR', code => 'CELL_LOAD_FAILED_SANITY', ); } $log->debug( "Leaving App::CELL::Load::init", cell => 1 ) if $meta->CELL_META_LOAD_VERBOSE; return App::CELL::Status->ok; } sub _report_load_status { my ( $dir_path, $dir_desc, $what, $status ) = @_; my $return_status = App::CELL::Status->ok; my $quantitems = ${ $status->payload }{quantitems} || 0; my $quantfiles = ${ $status->payload }{quantfiles} || 0; if ( $quantitems == 0 ) { $return_status = App::CELL::Status->new( level => 'WARN', code => 'CELL_DIR_WALKED_NOTHING_FOUND', args => [ $what, $dir_desc, $dir_path, $quantfiles ], caller => [ caller ], cell => 1, ); } # trigger a log message: note that we can't use an OK status here # because log messages for those are suppressed App::CELL::Status->new ( level => 'INFO', code => 'CELL_DIR_WALKED_ITEMS_LOADED', args => [ $quantitems, $what, $quantfiles, $dir_desc, $dir_path ], caller => [ caller ], cell => 1, ) if ( $dir_desc eq 'sitedir' ) or ( $dir_desc eq 'sharedir' and $meta->CELL_META_LOAD_VERBOSE ); return $return_status; } =head2 message_files Loads message files from the given directory. Takes: full path to configuration directory. Returns: result hash containing 'quantfiles' (total number of files processed) and 'count' (total number of messages loaded). =cut sub message_files { my $confdir = shift; my %reshash; $reshash{quantfiles} = 0; $reshash{quantitems} = 0; my $file_list = find_files( 'message', $confdir ); if ( @$file_list ) { $log->info( "Found message files: " . join( ',', @$file_list ), cell => 1 ) if $meta->CELL_META_LOAD_VERBOSE; } else { $log->warn( "No message files found in $confdir", cell => 1 ) if $meta->CELL_META_LOAD_VERBOSE; } foreach my $file ( @$file_list ) { $reshash{quantfiles} += 1; die "INTERNAL ERROR (App::CELL::Message::mesg is not a reference)" if not ref( $App::CELL::Message::mesg ); $reshash{quantitems} += parse_message_file( File => $file, Dest => $App::CELL::Message::mesg, ); } return App::CELL::Status->new( level => 'OK', payload => \%reshash, ); } =head2 meta_core_site_files Loads meta, core, and site config files from the given directory. Takes: full path to configuration directory. Returns: result hash containing 'quantfiles' (total number of files processed) and 'count' (total number of configuration parameters loaded). =cut sub meta_core_site_files { my $confdir = shift; my %reshash; $reshash{quantfiles} = 0; $reshash{quantitems} = 0; foreach my $type ( 'meta', 'core', 'site' ) { my $fulltype = 'App::CELL::Config::' . $type; #$log->debug( "\$fulltype is $fulltype"); my $file_list = find_files( $type, $confdir ); foreach my $file ( @$file_list ) { no strict 'refs'; $reshash{quantfiles} += 1; $reshash{quantitems} += parse_config_file( File => $file, Dest => $$fulltype, ); } } return App::CELL::Status->new( level => 'OK', payload => \%reshash, ); } =head2 get_sitedir This function implements the algorithm described in L to find a sitedir candidate. configuration directory. On success -- i.e., as soon as the algorithm finds a viable sitedir candidate -- the sitedir (full path) is added to CELL_META_SITEDIR_LIST and an OK status object is returned, with the sitedir in the payload. On failure, the function returns an ERR or WARN status object containing a description of what went wrong. =cut sub get_sitedir { my %paramhash = @_; my $reason; my ( $sitedir, $log_message, $status ); GET_CANDIDATE_DIR: { # look in paramhash for sitedir $log->debug( "SITEDIR SEARCH, ROUND 1 (sitedir parameter):", cell => 1 ); if ( $sitedir = $paramhash{sitedir} ) { $log_message = "Viable sitedir passed as argument"; last GET_CANDIDATE_DIR if is_directory_viable( $sitedir ); $reason = "CELL load routine received 'sitedir' argument ->$sitedir<- " . "but this is not a viable directory ($App::CELL::Util::not_viable_reason)"; $log->err( $reason, cell => 1 ); return App::CELL::Status->new( level => 'ERR', code => $reason ); } $log->debug( "looked at function arguments but they do not " . "contain a literal site dir path", cell => 1 ); # look in paramhash for name of environment variable $log->debug( "SITEDIR SEARCH, ROUND 2 (enviro parameter):", cell => 1 ); if ( $paramhash{enviro} ) { if ( $sitedir = $ENV{ $paramhash{enviro} } ) { $log_message = "Found viable sitedir in " . $paramhash{enviro} . " environment variable"; last GET_CANDIDATE_DIR if is_directory_viable( $sitedir ); $reason = "CELL load routine received 'enviro' argument ->$paramhash{enviro}<- " . "which expanded to ->$sitedir<- but this is not a viable directory " . "($App::CELL::Util::not_viable_reason)"; return App::CELL::Status->new( level => 'ERR', code => $reason ); } else { $reason = "CELL load routine: enviro argument contained ->$paramhash{enviro}<- " . "but no such variable found in the environment"; return App::CELL::Status->new( level => 'ERR', code => $reason ); } } # fall back to hard-coded environment variable $log->debug( "SITEDIR SEARCH, ROUND 3 (fallback to CELL_SITEDIR " . "environment variable):", cell => 1 ); $sitedir = undef; if ( $sitedir = $ENV{ 'CELL_SITEDIR' } ) { $log_message = "Found viable sitedir in CELL_SITEDIR environment variable"; last GET_CANDIDATE_DIR if is_directory_viable( $sitedir ); $reason = "CELL load routine: no 'sitedir', 'enviro' arguments specified; " . "fell back to CELL_SITEDIR environment variable, which exists " . "with value ->$sitedir<- but this is not a viable directory" . "($App::CELL::Util::not_viable_reason)"; if ( $meta->CELL_META_SITEDIR_LOADED ) { $log->warn( $reason, cell => 1 ); $log->notice( "The following sitedirs have been loaded already " . join( ' ', @{ $meta->CELL_META_SITEDIR_LIST }), cell => 1 ); return App::CELL::Status->ok; } return App::CELL::Status->new( level => 'WARN', code => $reason ); } # failed to find a sitedir $reason = "CELL load routine gave up (no sitedir argument, no enviro " . "argument, no CELL_SITEDIR environment variable)"; if ( $meta->CELL_META_SITEDIR_LOADED ) { $log->warn( $reason, cell => 1 ); $log->notice( "The following sitedirs have been loaded already " . join( ' ', @{ $meta->CELL_META_SITEDIR_LIST } ), cell => 1 ); return App::CELL::Status->ok; } return App::CELL::Status->new( level => 'WARN', code => $reason ); } # SUCCEED $log->info( $log_message, cell => 1 ); return App::CELL::Status->ok( $sitedir ); } =head2 find_files Takes two arguments: full directory path and config file type. Always returns an array reference. On "failure", the array reference will be empty. How it works: first, the function checks a state variable to see if the "work" of walking the configuration directory has already been done. If so, then the function simply returns the corresponding array reference from its cache (the state hash C<%resultlist>). If this is the first invocation for this directory, the function walks the directory (and all its subdirectories) to find files matching one of the four regular expressions corresponding to the four types of configuration files('meta', 'core', 'site', 'message'). For each matching file, the full path is pushed onto the corresponding array in the cache. Note that there is a ceiling on the number of files that will be considered while walking the directory tree. This ceiling is defined in the package variable C<$max_files> (see below). =cut # regular expressions for each file type our $typeregex = { 'meta' => qr/^.+_MetaConfig.pm$/ , 'core' => qr/^.+_Config.pm$/ , 'site' => qr/^.+_SiteConfig.pm$/ , 'message' => qr/^.+_Message(_[^_]+){0,1}.conf$/ , }; # C<$max_files> puts a limit on how many files we will look at in our directory # tree walk our $max_files = 1000; sub find_files { my ( $type, $dirpath ) = @_; # # FIXME: convert $dirpath into an absolute path so it's always the same # # re-entrant function use feature "state"; state $resultcache = {}; # If $dirpath key exists in %resultcache, we are re-entering. # In other words, $dirpath has already been walked and all the # filepaths are already in the array stored within %resultcache if ( exists $resultcache->{ $dirpath } ) { $log->debug( "Re-entering find_files for $dirpath (type '$type')", cell => 1) if $meta->CELL_META_LOAD_VERBOSE; return $resultcache->{ $dirpath }->{ $type }; } else { # create it $resultcache->{ $dirpath } = { 'meta' => [], 'core' => [], 'site' => [], 'message' => [], }; } # walk the directory (do we need some error checking here?) $log->debug( "Preparing to walk $dirpath", cell => 1 ); my $iter = File::Next::files( $dirpath ); # while we are walking, go ahead and populate the result cache for _all # four_ types (even though we were asked for just one type) my $walk_counter = 0; ITER_LOOP: while ( defined ( my $file = $iter->() ) ) { $log->debug( "Now considering $file", cell => 1 ); $walk_counter += 1; if ( $walk_counter > $max_files ) { App::CELL::Status->new ( level => 'ERROR', code => 'Maximum number of configuration file candidates ->%s<- exceeded in %s', args => [ $max_files, $dirpath ], ); last ITER_LOOP; # stop looping if there are so many files } if ( not -r $file ) { App::CELL::Status->new ( level => 'WARN', code => 'Load operation passed over file ->%s<- (not readable)', args => [ $file ], ); next ITER_LOOP; # jump to next file } # $file is now a "candidate" my $counter = 0; foreach my $type ( 'meta', 'core', 'site', 'message' ) { if ( $file =~ /${ $typeregex }{ $type }/ ) { push @{ $resultcache->{ $dirpath}->{ $type } }, $file; $counter += 1; next ITER_LOOP; } } $log->info( "Load operation passed over file $file (type not " . "recognized)", cell => 1 ) if not $counter and $meta->CELL_META_LOAD_VERBOSE; } $log->debug( "Returning " . join( ',', @{ $resultcache->{ $dirpath }->{ $type } } ), cell => 1 ) if $meta->CELL_META_LOAD_VERBOSE; return $resultcache->{ $dirpath }->{ $type }; } =head2 parse_message_file This function is where message files are parsed. It takes a PARAMHASH consisting of: =over =item C - filename (full path) =item C - hash reference (where to store the message templates). =back Returns: number of stanzas successfully parsed and loaded =cut sub parse_message_file { my @ARGS = @_; my %ARGS = ( 'File' => undef, 'Dest' => undef, @ARGS, ); my $process_stanza_sub = sub { # get arguments my ( $file, $line, $lang, $stanza, $destref ) = @_; # put first token on first line into $code my ( $code ) = $stanza->[0] =~ m/^\s*(\S+)/; if ( not $code ) { $log->info( "ERROR: Could not process stanza ->" . join( " ", @$stanza ) . "<- in $file" ); return 0; } # The rest of the lines are the message template my $text = ''; foreach ( @$stanza[1 .. $#{ $stanza }] ) { chomp; $text = $text . " " . $_; } $text =~ s/^\s+//g; if ( $code and $lang and $text ) { $log->debug( "Parsed message CODE ->$code<- LANG ->$lang<- TEXT ->$text<-" ); # we have a candidate, but we don't want to overwrite # an existing entry with the same $code-$lang pair if ( $destref->{ $code }->{ $lang } ) { my $existing_text = $destref->{ $code }->{ $lang }->{ 'Text' }; $log->error( "ERROR: not loading code-lang pair ->$code" . "/$lang<- with text ->$text<- because this would" . " overwrite existing pair from " . $destref->{$code}->{$lang}->{'File'} ); return 0; } else { $log->debug( "OK: loading code-lang pair ->$code/$lang<- with text ->$text<-" ) if $meta->CELL_META_LOAD_VERBOSE; $destref->{ $code }->{ $lang } = { 'Text' => $text, 'File' => $file, 'Line' => $line, }; return 1; } } $log->error( "Parsed " . ( $code || "" ) . " but something missing!!" ); return 0; }; # determine language from file name my ( $lang ) = $ARGS{'File'} =~ m/_Message_([^_]+).conf$/; if ( not $lang ) { $log->warn( "Could not determine language from filename " . "$ARGS{'File'} -- reverting to default language " . "->en<-" ); $lang = 'en'; } # open the file for reading open( my $fh, "<", $ARGS{'File'} ) or die "cannot open < $ARGS{'File'}: $!"; my @stanza = (); my $index = 0; my $count = 0; my $line = 0; while ( <$fh> ) { chomp( $_ ); $line += 1; #$log->debug( "Read line =>$_<= from $ARGS{'File'}" ); $_ = '' if /^\s+$/; if ( $_ ) { if ( ! /^\s*#/ ) { s/^\s*//g; s/\s*$//g; $stanza[ $index++ ] = $_; } } else { $count += &$process_stanza_sub( $ARGS{'File'}, $line, $lang, \@stanza, $ARGS{'Dest'} ) if @stanza; @stanza = (); $index = 0; } } # There might be one stanza left at the end $count += &$process_stanza_sub( $ARGS{'File'}, $line, $lang, \@stanza, $ARGS{'Dest'} ) if @stanza; close $fh; # $log->info( "Parsed and loaded $count configuration stanzas " # . "from $ARGS{'File'}" ); # $log->info( Dumper( $ARGS{'Dest'} ) ); return $count; }; =head2 parse_config_file Parses a configuration file and adds the parameters found to the hashref provided. If a parameter already exists in the hashref, a warning is generated, the existing parameter is not overwritten, and processing continues. This function doesn't care what type of configuration parameters are in the file, except that they must be scalar values. Since the configuration files are actually Perl modules, the value can even be a reference (to an array, a hash, or a subroutine, or any other complex data structure). The technique used in the C, derived from Request Tracker, can be described as follows: a local typeglob "set" is defined, containing a reference to an anonymous subroutine. Subsequently, a config file (Perl module) consisting of calls to this "set" subroutine is Cd. Note: If even one call to C fails to compile, the entire file will be rejected and no configuration parameters from that file will be loaded. The C function takes a PARAMHASH consisting of: =over =item C - filename (full path) =item C - hash reference (where to store the config params). =back Returns: number of configuration parameters parsed/loaded (IMPORTANT NOTE: If even one call to C fails to compile, the entire file will be rejected and no configuration parameters from that file will be loaded.) =cut sub parse_config_file { my %ARGS = ( 'File' => undef, 'Dest' => undef, @_, ); # This is so we can use the C<$self> variable (in the C # statement, below) to reach the C<_conf_from_config> functions from # the configuration file. my $self = {}; bless $self, 'App::CELL::Load'; my $count = 0; # ideally this should be 'debug' for sharedir and 'info' for sitedir # but in this routine I have no easy way of telling one from the other $log->debug( "Loading =>$ARGS{'File'}<=" ); if ( not ref( $ARGS{'Dest'} ) ) { $log->warn("Something strange happened: destination is not a reference?!?"); } { use Try::Tiny; try { local *set = sub($$) { my ( $param, $value ) = @_; my ( undef, $file, $line ) = caller; $count += $self->_conf_from_config( 'Dest' => $ARGS{'Dest'}, 'Param' => $param, 'Value' => $value, 'File' => $file, 'Line' => $line, ); }; require $ARGS{'File'}; } catch { my $errmsg = $_; $errmsg =~ s/\012/ -- /g; $log->err("CELL_CONFIG_LOAD_FAIL on file $ARGS{File} with error message: $errmsg"); $log->debug( "The count is $count" ); return $count; }; } #$log->info( "Successfully loaded $count configuration parameters " # . "from $ARGS{'File'}" ); return $count; } =head2 _conf_from_config This function takes a target hashref (which points to one of the 'meta', 'core', or 'site' package hashes in C), a config parameter (i.e. a string), config value, config file name, and line number. Let's imagine that the configuration parameter is "FOO_BAR". The function first checks if a key named "FOO_BAR" already exists in the package hash (which is passed into the function as C<%ARGS{'Dest'}>). If there isn't one, it creates that key. If there is one, it leaves it untouched and triggers a warning. Although the arguments are passed to the function in the form of a PARAMHASH, the function converts them into ordinary private variables. This was necessary to avoid extreme notational ugliness. =cut sub _conf_from_config { my $self = shift; my ( %ARGS ) = validate( @_, { Dest => { type => HASHREF }, Param => { type => SCALAR }, Value => { type => SCALAR|SCALARREF|ARRAYREF|HASHREF|CODEREF|UNDEF }, File => { type => SCALAR }, Line => { type => SCALAR }, } ); # convert PARAMHASH into private variables my $desthash = $ARGS{'Dest'}; my $param = $ARGS{'Param'}; my $value = $ARGS{'Value'}; my $file = $ARGS{'File'}; my $line = $ARGS{'Line'}; if ( keys( %{ $desthash->{ $param } } ) ) { $log->warn( "ignoring duplicate definition of config " . "parameter $param in line $line of config file $file " . "because it conflicts with a similar parameter in " . $desthash->{ $param }->{'File'} ); return 0; } else { $desthash->{ $param } = { 'Value' => $value, 'File' => $file, 'Line' => $line, }; $log->debug( "Parsed parameter $param " . "from $file, line $line", suppress_caller => 1 ) if $meta->CELL_META_LOAD_VERBOSE; return 1; } } 1; App-CELL-0.222/lib/App/CELL/Config.pm000444001750000144 2122512766160463 17230 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015, SUSE LLC # # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions are met: # # 1. Redistributions of source code must retain the above copyright notice, # this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # 3. Neither the name of SUSE LLC nor the names of its contributors may be # used to endorse or promote products derived from this software without # specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # ************************************************************************* package App::CELL::Config; use strict; use warnings; use 5.012; use App::CELL::Log qw( $log ); use App::CELL::Status; #use Data::Dumper; use Scalar::Util qw( blessed ); =head1 NAME App::CELL::Config -- load, store, and dispense meta parameters, core parameters, and site parameters =head1 SYNOPSIS use App::CELL::Config qw( $meta $core $site ); # get a parameter value (returns value or undef) my $value; $value = $meta->MY_PARAM; $value = $core->MY_PARAM; $value = $site->MY_PARAM; # set a meta parameter $meta->set( 'MY_PARAM', 42 ); # set an as-yet undefined core/site parameter $core->set( 'MY_PARAM', 42 ); $site->set( 'MY_PARAM', 42 ); =head1 DESCRIPTION The purpose of the L module is to maintain and provide access to three package variables, C<$meta>, C<$core>, and C<$site>, which are actually singleton objects, containing configuration parameters loaded by L from files in the distro sharedir and the site configuration directory, if any. For details, read L. =head1 EXPORTS This module exports three scalars: the 'singleton' objects C<$meta>, C<$core>, and C<$site>. =cut use Exporter qw( import ); our @EXPORT_OK = qw( $meta $core $site ); our $meta = bless { CELL_CONFTYPE => 'meta' }, __PACKAGE__; our $core = bless { CELL_CONFTYPE => 'core' }, __PACKAGE__; our $site = bless { CELL_CONFTYPE => 'site' }, __PACKAGE__; =head1 SUBROUTINES =head2 AUTOLOAD The C routine handles calls that look like this: $meta->MY_PARAM $core->MY_PARAM $site->MY_PARAM =cut our $AUTOLOAD; sub AUTOLOAD { my $self = shift; ( my $param ) = $AUTOLOAD =~ m/.*::(.*)$/; return SUPER->DESTROY if $param eq 'DESTROY'; # for Perl <= 5.012 my ( undef, $file, $line ) = caller; die "Bad call to Config.pm \$$param at $file line $line!" if not blessed $self; return _retrieve_param( $self->{'CELL_CONFTYPE'}, $param ); } sub _retrieve_param { my ( $type, $param ) = @_; if ( $type eq 'meta' ) { return (exists $meta->{$param}) ? $meta->{$param}->{Value} : undef; } elsif ( $type eq 'core' ) { return (exists $core->{$param}) ? $core->{$param}->{Value} : undef; } elsif ( $type eq 'site' ) { if (exists $site->{$param}) { return $site->{$param}->{Value}; } elsif (exists $core->{$param}) { return $core->{$param}->{Value}; } } return; } =head2 DESTROY For some reason, Perl 5.012 seems to want a DESTROY method =cut sub DESTROY { my $self = shift; $self->SUPER::DESTROY if $self->can("SUPER::DESTROY"); } =head2 exists Determine parameter existence. =cut sub exists { my ( $self, $param ) = @_; my $type = $self->{'CELL_CONFTYPE'}; my $bool; if ( $type eq 'meta' ) { $bool = exists $meta->{ $param }; } elsif ( $type eq 'core' ) { $bool = exists $core->{ $param }; } elsif ( $type eq 'site' ) { $bool = exists $site->{ $param }; if ( ! $bool ) { $bool = exists $core->{ $param }; } } else { die "AAAAAAAAAAGGAHHAGHHG! improper param type in exists routine"; } return $bool; } =head2 get Wrapper for get_param =cut sub get { my ( $self, $param ) = @_; return $self->get_param( $param ); } =head2 get_param Get value of config param provided in the argument. =cut sub get_param { my ( $self, $param ) = @_; my ( undef, $file, $line ) = caller; die "Bad call to Config.pm \$$param at $file line $line!" if not blessed $self; return _retrieve_param( $self->{'CELL_CONFTYPE'}, $param ); } =head2 get_param_metadata Routine to provide access not only to the value, but also to the metadata (file and line number where parameter was defined) associated with a given parameter. Takes: parameter name. Returns: reference to the hash associated with the given parameter, or undef if no parameter found. =cut sub get_param_metadata { my ( $self, $param ) = @_; my ( undef, $file, $line ) = caller; die "Bad call to Config.pm \$$param at $file line $line!" if not blessed $self; my $type = $self->{'CELL_CONFTYPE'}; if ( $type eq 'meta' ) { return (exists $meta->{$param}) ? $meta->{$param} : undef; } elsif ( $type eq 'core' ) { return (exists $core->{$param}) ? $core->{$param} : undef; } elsif ( $type eq 'site' ) { if (exists $site->{$param}) { return $site->{$param}; } elsif (exists $core->{$param}) { return $core->{$param}; } } return; } =head2 set Use this function to set new params (meta/core/site) or change existing ones (meta only). Takes two arguments: parameter name and new value. Returns a status object. =cut sub set { my ( $self, $param, $value ) = @_; return App::CELL::Status->not_ok if not blessed $self; my %ARGS = ( level => 'OK', caller => [ caller ], ); if ( $self->{'CELL_CONFTYPE'} eq 'meta' ) { if ( exists $meta->{$param} ) { %ARGS = ( %ARGS, code => 'CELL_OVERWRITE_META_PARAM', args => [ $param, ( defined( $value ) ? $value : 'undef' ) ], ); #$log->debug( "Overwriting \$meta->$param with ->$value<-", cell => 1 ); } else { #$log->debug( "Setting new \$meta->$param to ->$value<-", cell => 1 ); } $meta->{$param} = { 'File' => (caller)[1], 'Line' => (caller)[2], 'Value' => $value, }; #$log->debug( Dumper $meta ); } elsif ( $self->{'CELL_CONFTYPE'} eq 'core' ) { if ( exists $core->{$param} ) { %ARGS = ( %ARGS, level => 'ERR', code => 'CELL_PARAM_EXISTS_IMMUTABLE', args => [ 'Core', $param ], ); } else { $core->{$param} = { 'File' => (caller)[1], 'Line' => (caller)[2], 'Value' => $value, }; } } elsif ( $self->{'CELL_CONFTYPE'} eq 'site' ) { if ( exists $site->{$param} ) { %ARGS = ( %ARGS, level => 'ERR', code => 'CELL_PARAM_EXISTS_IMMUTABLE', args => [ 'Site', $param ], ); } else { $site->{$param} = { 'File' => (caller)[1], 'Line' => (caller)[2], 'Value' => $value, }; } } return App::CELL::Status->new( %ARGS ); } # END OF App::CELL::Config MODULE 1; App-CELL-0.222/lib/App/CELL/Util.pm000444001750000144 772212766160463 16726 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015, SUSE LLC # # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions are met: # # 1. Redistributions of source code must retain the above copyright notice, # this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # 3. Neither the name of SUSE LLC nor the names of its contributors may be # used to endorse or promote products derived from this software without # specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # ************************************************************************* package App::CELL::Util; use strict; use warnings; use 5.012; use Data::Dumper; use Date::Format; =head1 NAME App::CELL::Util - generalized, reuseable functions =head1 SYNOPSIS use App::CELL::Util qw( utc_timestamp is_directory_viable ); # utc_timestamp print "UTC time is " . utc_timestamp() . "\n"; # is_directory_viable my $status = is_directory_viable( $dir_foo ); print "$dir_foo is a viable directory" if $status->ok; if ( $status->not_ok ) { my $problem = $status->payload; print "$dir_foo is not viable because $problem\n"; } =cut =head1 EXPORTS This module provides the following public functions: =over =item C =item C =back =cut use Exporter qw( import ); our @EXPORT_OK = qw( utc_timestamp is_directory_viable stringify_args ); =head1 PACKAGE VARIABLES =cut our $not_viable_reason = ''; =head1 FUNCTIONS =head2 utc_timestamp =cut sub utc_timestamp { return uc time2str("%Y-%m-%d %H:%M %Z", time, 'GMT'); } =head2 is_directory_viable Run viability checks on a directory. Takes: full path to directory. Returns true (directory viable) or false (directory not viable). If the directory is not viable, it sets the package variable C<< $App::CELL::Util::not_viable_reason >>. =cut sub is_directory_viable { my $confdir = shift; my $problem = ''; CRIT_CHECK: { if ( not -e $confdir ) { $problem = "does not exist"; last CRIT_CHECK; } if ( not -d $confdir ) { $problem = "exists but not a directory"; last CRIT_CHECK; } if ( not -r $confdir or not -x $confdir ) { $problem = "directory exists but insufficient permissions"; last CRIT_CHECK; } } # CRIT_CHECK if ( $problem ) { $not_viable_reason = $problem; return 0; } return 1; } =head2 stringify_args Convert args (or any data structure) into a string -- useful for error reporting. =cut sub stringify_args { my $args = shift; local $Data::Dumper::Indent = 0; local $Data::Dumper::Terse = 1; my $args_as_string; if ( ref $args ) { $args_as_string = Dumper( $args ); } else { $args_as_string = $args; } return $args_as_string; } # END OF App::CELL::Util.pm 1; App-CELL-0.222/lib/App/CELL/Status.pm000444001750000144 2232112766160463 17304 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015, SUSE LLC # # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions are met: # # 1. Redistributions of source code must retain the above copyright notice, # this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # 3. Neither the name of SUSE LLC nor the names of its contributors may be # used to endorse or promote products derived from this software without # specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # ************************************************************************* package App::CELL::Status; use strict; use warnings; use 5.012; use App::CELL::Log qw( $log ); use App::CELL::Util qw( stringify_args ); use Storable qw( dclone ); use Scalar::Util qw( blessed ); use Try::Tiny; =head1 NAME App::CELL::Status - class for return value objects =head1 SYNOPSIS use App::CELL::Status; # simplest usage my $status = App::CELL::Status->ok; print "ok" if ( $status->ok ); $status = App::CELL::Status->not_ok; print "NOT ok" if ( $status->not_ok ); # as a return value: in the caller my $status = $XYZ( ... ); return $status if not $status->ok; # handle failure my $payload = $status->payload; # handle success =head1 INHERITANCE This module inherits from C =cut use parent qw( App::CELL::Message ); =head1 DESCRIPTION An App::CELL::Status object is a reference to a hash containing some or all of the following keys (attributes): =over =item C - the status level (see L, below) =item C - message explaining the status =item C - an array reference containing the three-item list generated by the C function =back The typical use cases for this object are: =over =item As a return value from a function call =item To trigger a higher-severity log message =back All calls to C<< App::CELL::Status->new >> with a status other than OK trigger a log message. =head1 PUBLIC METHODS This module provides the following public methods: =head2 new Construct a status object and trigger a log message if the level is anything other than "OK". Always returns a status object. If no level is specified, the level will be 'ERR'. If no code is given, the code will be undefined (I think). =cut sub new { my ( $class, @ARGS ) = @_; my %ARGS = @ARGS; my $self; # default to ERR level unless ( defined $ARGS{level} and grep { $ARGS{level} eq $_ } $log->permitted_levels ) { $ARGS{level} = 'ERR'; } # if caller array not given, create it if ( not $ARGS{caller} ) { $ARGS{caller} = [ caller ]; } $ARGS{args} = [] if not defined( $ARGS{args} ); $ARGS{called_from_status} = 1; if ( $ARGS{code} ) { # App::CELL::Message->new returns a status object my $status = $class->SUPER::new( %ARGS ); if ( $status->ok ) { my $parent = $status->payload; $ARGS{msgobj} = $parent; $ARGS{code} = $parent->code; $ARGS{text} = $parent->text; } else { $ARGS{code} = $status->code; if ( $ARGS{args} ) { $ARGS{text} = $status->text . stringify_args( $ARGS{args} ); } else { $ARGS{text} = $status->text; } } } # bless into objecthood $self = bless \%ARGS, 'App::CELL::Status'; # Log the message $log->status_obj( $self, cell => ( $ARGS{cell} || 0 ) ) if ( $ARGS{level} ne 'OK' and $ARGS{level} ne 'NOT_OK' ); # return the created object return $self; } #=head2 dump # #Dump an existing status object. Takes: PARAMHASH. Parameter 'to' determines #destination, which can be 'string' (default), 'log' or 'fd'. # # # dump object to string # my $dump_str = $status->dump(); # $dump_str = $status->dump( to => 'string' ); # # # dump object to log # $status->dump( to => 'log' ); # # # dump object to file descriptor # $status->dump( fd => STDOUT ); # $status->dump( to => 'fd', fd => STDOUT ); # #Always returns a true value. # #=cut # #sub dump { # my ( $self, %ARGS ) = shift; # if ( not %ARGS ) { # $log->status_obj( $self ); # } else { # if ( exists $ARGS{fd} ) { # $log->debug( "Future dump-to-fd code goes here" ); # } else { # $log->debug( "Doing nothing" ); # } # } # # return 1; #} =head2 ok If the first argument is blessed, assume we're being called as an instance method: return true if status is OK, false otherwise. Otherwise, assume we're being called as a class method: return a new OK status object with optional payload (optional parameter to the method call, must be a scalar). =cut sub ok { my ( $self, $payload ) = @_; my $ARGS = {}; if ( blessed $self ) { # instance method return 1 if ( $self->level eq 'OK' ); return 0; } $ARGS->{level} = 'OK'; $ARGS->{payload} = $payload if $payload; $ARGS->{caller} = [ caller ]; return bless $ARGS, __PACKAGE__; } =head2 not_ok Similar method to 'ok', except it handles 'NOT_OK' status. When called as an instance method, returns a true value if the status level is anything other than 'OK'. Otherwise false. When called as a class method, returns a 'NOT_OK' status object. Optionally, a payload can be supplied as an argument. =cut sub not_ok { my ( $self, $payload ) = @_; my $ARGS = {}; if ( blessed $self ) { # instance method return 1 if $self->{level} ne 'OK'; return 0; } $ARGS->{level} = 'NOT_OK'; $ARGS->{payload} = $payload if $payload; $ARGS->{caller} = [ caller ]; return bless $ARGS, __PACKAGE__; } =head2 level Accessor method, returns level of status object in ALL-CAPS. All status objects must have a level attribute. =cut sub level { my $self = shift; $self->{'level'} = $_[0] if @_; return $self->{'level'}; } =head2 code Accesor method, returns code of status object, or "C<< >>" if none present. =cut sub code { my $self = shift; $self->{'code'} = $_[0] if @_; return $self->{'code'} || ""; } =head2 args Accessor method - returns value of the 'args' property. =cut sub args { my $self = shift; $self->{'args'} = $_[0] if @_; return $self->{'args'}; } =head2 text Accessor method, returns text of status object, or the code if no text present. If neither code nor text are present, returns "C<< >>" =cut sub text { return $_[0]->{text} if $_[0]->{text}; return $_[0]->code; } =head2 caller Accessor method. Returns array reference containing output of C function associated with this status object, or C<[]> if not present. =cut sub caller { return $_[0]->{caller} || []; } =head2 payload When called with no arguments, acts like an accessor method. When called with a scalar argument, either adds that as the payload or changes the payload to that. Logs a warning if an existing payload is changed. Returns the (new) payload or undef. =cut sub payload { my ( $self, $new_payload ) = @_; if ( defined $new_payload ) { $log->warn( "Changing payload of status object. Old payload was " . "->$self->{payload}<-", cell => 1 ) if $self->{payload}; $self->{payload} = $new_payload; } return $self->{payload}; } =head2 msgobj Accessor method (returns the parent message object) =cut sub msgobj { my $self = $_[0]; return $self->{msgobj} if exists $self->{msgobj}; return; # returns undef in scalar context } =head2 expurgate Make a deep copy of the status object, unbless it, and remove certain attributes deemed "extraneous". =cut sub expurgate { my ( $self ) = @_; return unless blessed( $self ); my ( $clone, $status ); try { $clone = dclone( $self ); } catch { $status = __PACKAGE__->new( level => 'CRIT', code => $_, ); }; return $status->expurgate if $status; my $udc; foreach my $key ( keys %$clone ) { next if grep { $key eq $_ } ( 'args', 'called_from_status', 'caller', 'msgobj' ); $udc->{$key} = $clone->{$key}; } return $udc; } 1; App-CELL-0.222/lib/App/CELL/Test.pm000444001750000144 1464312766160463 16750 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015, SUSE LLC # # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions are met: # # 1. Redistributions of source code must retain the above copyright notice, # this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # 3. Neither the name of SUSE LLC nor the names of its contributors may be # used to endorse or promote products derived from this software without # specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # ************************************************************************* package App::CELL::Test; use strict; use warnings; use 5.012; use App::CELL::Log qw( $log ); use File::Spec; =head1 NAME App::CELL::Test - functions for unit testing =head1 SYNOPSIS use App::CELL::Test; App::CELL::Test::cleartmpdir(); my $tmpdir = App::CELL::Test::mktmpdir(); App::CELL::Test::touch_files( $tmpdir, 'foo', 'bar', 'baz' ); my $booltrue = App::CELL::Test::cmp_arrays( [ 0, 1, 2 ], [ 0, 1, 2 ] ); my $boolfalse = App::CELL::Test::cmp_arrays( [ 0, 1, 2 ], [ 'foo', 'bar', 'baz' ] ); =head1 DESCRIPTION The C module provides a number of special-purpose functions for use in CELL's test suite. =head1 EXPORTS This module exports the following routines: cleartmpdir cmp_arrays mktmpdir populate_file touch_files =cut use Exporter qw( import ); our @EXPORT_OK = qw( cleartmpdir cmp_arrays mktmpdir populate_file touch_files _touch ); =head1 PACKAGE VARIABLES =cut our $tdo; # temporary directory object =head1 FUNCTIONS =head2 mktmpdir Creates the App::CELL testing directory in a temporary directory (obtained using L) and returns the path to this directory in the payload of a status object. =cut sub mktmpdir { use Try::Tiny; try { use File::Temp; $tdo = File::Temp->newdir(); } catch { my $errmsg = $_ || ''; $errmsg =~ s/\n//g; $errmsg =~ s/\012/ -- /g; return App::CELL::Status->new( level => 'ERR', code => 'CELL_CREATE_TMPDIR_FAIL', args => [ $errmsg ], ); }; $log->debug( "Created temporary directory" . $tdo ); return App::CELL::Status->ok( $tdo->dirname ); } =head2 cleartmpdir DESTROYs the temporary directory object (see L). =cut sub cleartmpdir { $tdo->DESTROY if defined $tdo; return App::CELL::Status->ok; } =head3 _touch Touch a file =cut sub _touch { my ( $file ) = @_; my $now = time; local (*TMP); utime ($now, $now, $file) || open (TMP, ">>$file") || warn ("Couldn't touch file: $!\n"); } =head2 touch_files "Touch" some files. Takes: directory path and list of files to "touch" in that directory. Returns number of files successfully touched. =cut sub touch_files { my ( $dirspec, @file_list ) = @_; use Try::Tiny; my $count = @file_list; try { foreach my $file ( map { File::Spec->catfile( $dirspec, $_ ); } @file_list ) { _touch( $file ); } } catch { my $errmsg = $_; $errmsg =~ s/\n//g; $errmsg =~ s/\012/ -- /g; $errmsg = "Attempting to 'touch' $count files in $dirspec . . . failure: $errmsg"; $log->debug( $errmsg ); print STDERR $errmsg, "\n"; return 0; }; $log->debug( "Attempting to 'touch' $count files in $dirspec . . . success" ); return $count; } =head2 populate_file Takes filename (full path) and contents (as a string, potentially containing newlines) to write to it. If the file exists, it is first unlinked. Then the routine creates the file and populates it with the contents. Returns true if something was written, or false if not. =cut sub populate_file { my ( $full_path, $contents ) = @_; unlink $full_path; { _touch( $full_path ) or die "Could not touch $full_path"; } return 0 unless -f $full_path and -W $full_path; return 0 unless $contents; open(my $fh, '>', $full_path ) or die "Could not open file: $!"; print $fh $contents; close $fh; return length $contents; } =head2 cmp_arrays Compare two arrays of unique elements, order doesn't matter. Takes: two array references Returns: true (they have the same elements) or false (they differ). =cut sub cmp_arrays { my ( $ref1, $ref2 ) = @_; $log->debug( "cmp_arrays: we were asked to compare two arrays:"); $log->debug( "ARRAY #1: " . join( ',', @$ref1 ) ); $log->debug( "ARRAY #2: " . join( ',', @$ref2 ) ); # convert them into hashes my ( %ref1, %ref2 ); map { $ref1{ $_ } = ''; } @$ref1; map { $ref2{ $_ } = ''; } @$ref2; # make a copy of ref1 my %ref1_copy = %ref1; # for each element of ref1, if it matches an element in ref2, delete # the element from _BOTH_ foreach ( keys( %ref1_copy ) ) { if ( exists( $ref2{ $_ } ) ) { delete $ref1{ $_ }; delete $ref2{ $_ }; } } # if the two arrays are the same, the number of keys in both hashes should # be zero $log->debug( "cmp_arrays: after comparison, hash #1 has " . keys( %ref1 ) . " elements and hash #2 has " . keys ( %ref2 ) . " elements" ); if ( keys( %ref1 ) == 0 and keys( %ref2 ) == 0 ) { return 1; } else { return 0; } } 1; App-CELL-0.222/lib/App/CELL/Test000755001750000144 012766160463 16225 5ustar00smithfarmusers000000000000App-CELL-0.222/lib/App/CELL/Test/LogToFile.pm000444001750000144 444412766160463 20552 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015, SUSE LLC # # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions are met: # # 1. Redistributions of source code must retain the above copyright notice, # this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # 3. Neither the name of SUSE LLC nor the names of its contributors may be # used to endorse or promote products derived from this software without # specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # ************************************************************************* package App::CELL::Test::LogToFile; use strict; use warnings; use 5.010; use Test::More; =pod =head1 NAME App::CELL::Test::LogToFile - really activate logging (for use within unit tests) =head1 SYNOPSIS use App::CELL::Test::LogToFile; =head1 DESCRIPTION The C module provides an easy way to activate log-to-temporary-file for a given unit test. Just 'use' and be happy. It would probably work outside of unit tests, too, if it weren't for the call to C. =cut BEGIN { use File::Temp; my $tf; use Log::Any::Adapter ('File', $tf = File::Temp->new->filename ); diag( "Logging to $tf" ); } 1; App-CELL-0.222/config000755001750000144 012766160463 14546 5ustar00smithfarmusers000000000000App-CELL-0.222/config/CELL_Message_en.conf000444001750000144 1006212766160463 20436 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015, SUSE LLC # # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions are met: # # 1. Redistributions of source code must retain the above copyright notice, # this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # 3. Neither the name of SUSE LLC nor the names of its contributors may be # used to endorse or promote products derived from this software without # specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # ************************************************************************* #-------------------------------------------------------------# # CELL_Message_en.pm # # App::CELL's own internal messages. This file # is stored in the "distro sharedir" and is always loaded # before the files in the application sitedir. # # In addition to being used by App::CELL, the files in the # distro sharedir (CELL_MetaConfig.pm, CELL_Config.pm, and # CELL_SiteConfig.pm along with CELL_Message_en.conf, # CELL_Message_cz.conf, etc.) can be used as models for # populating the application sitedir. # # See App::CELL::Guide for details. #-------------------------------------------------------------# CELL_TEST_MESSAGE This is a test message CELL_TEST_MESSAGE_WITH_ARGUMENT This a test message with a %s argument. CELL_BAD_PARAMHASH Function expects PARAMHASH but there is an odd number of arguments. CELL_SITEDIR_NOT_FOUND Site configuration directory %s (specified by %s) not found or not viable for reason: %s # App::CELL::Test CELL_CREATE_TMPDIR_FAIL Attempt to create temporary directory produced this error: %s CELL_UNKNOWN_MESSAGE_CODE Unknown system message ->%s<- CELL_CONFIG_LOAD_FAIL Failed to load ->%s<- because of %s CELL_BAD_PARAM_TYPE Bad param type ->%s<- passed to %s in module %s CELL_CONFIG_PARAM_UNKNOWN Attempt to access unknown %s param ->%s<- CELL_OVERWRITE_META_PARAM Overwriting existing meta parameter %s with new value ->%s<- CELL_MESSAGE_ARGUMENT_MISMATCH Arguments given to message ->%s<- do not match message template (sprintf said ->%s<-) CELL_MESSAGE_NO_CODE No message code was given in call to App::CELL::Message->new (args: ->%s<-) CELL_MESSAGE_CODE_UNDEFINED Undefined message code was given in call to App::CELL::Message->new (args: ->%s<-) CELL_MESSAGE_CODE_UNKNOWN Unknown message code ->%s<- was given CELL_PARAM_EXISTS_IMMUTABLE %s param ->%s<- already exists and is immutable CELL_SHAREDIR_NOT_VIABLE App::CELL distro sharedir ->%s<- is not viable (%s) # used for both sharedir and sitedir CELL_DIR_WALKED_NOTHING_FOUND No %s files found in %s ->%s<- (%s files examined) # used for both sharedir and sitedir CELL_DIR_WALKED_ITEMS_LOADED Loaded ->%s<- %s from %s files in %s %s #CELL_ALREADY_INITIALIZED #App::CELL has already been initialized # CELL_ODD_ARGS Odd number of args passed to function %s (%s) # App::CELL::Load::init CELL_LOAD_SANITY_MESSAGE This is a sanity testing message # App::CELL::Load::init CELL_LOAD_FAILED_SANITY App::CELL::Load->init failed its sanity checks App-CELL-0.222/config/CELL_SiteConfig.pm000444001750000144 532412766160463 20076 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015, SUSE LLC # # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions are met: # # 1. Redistributions of source code must retain the above copyright notice, # this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # 3. Neither the name of SUSE LLC nor the names of its contributors may be # used to endorse or promote products derived from this software without # specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # ************************************************************************* #-------------------------------------------------------------# # CELL_SiteConfig.pm # # App::CELL's own site configuration parameters. This file # is stored in the "distro sharedir" and is always loaded # before the files in the application sitedir. # # In addition to being used by App::CELL, the files in the # distro sharedir (CELL_MetaConfig.pm, CELL_Config.pm, and # CELL_SiteConfig.pm along with CELL_Message_en.conf, # CELL_Message_cz.conf, etc.) can be used as models for # populating the application sitedir. # # See App::CELL::Guide for details. #-------------------------------------------------------------# # CELL_SITE_UNIT_TESTING # used only for App::CELL unit tests set('CELL_SITE_UNIT_TESTING', [ 'Om mane padme hum' ] ); # CELL_LOAD_SANITY_SITE # used by App::CELL::Load::init sanity check set('CELL_LOAD_SANITY_SITE', 'Foo'); #-------------------------------------------------------------# # DO NOT EDIT ANYTHING BELOW THIS LINE # #-------------------------------------------------------------# use strict; use warnings; 1; App-CELL-0.222/config/CELL_Config.pm000444001750000144 750712766160463 17256 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015, SUSE LLC # # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions are met: # # 1. Redistributions of source code must retain the above copyright notice, # this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # 3. Neither the name of SUSE LLC nor the names of its contributors may be # used to endorse or promote products derived from this software without # specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # ************************************************************************* #-------------------------------------------------------------# # CELL_Config.pm # # App::CELL's own core configuration parameters. This file # is stored in the "distro sharedir" and is always loaded # before the files in the application sitedir. # # In addition to being used by App::CELL, the files in the # distro sharedir (CELL_MetaConfig.pm, CELL_Config.pm, and # CELL_SiteConfig.pm along with CELL_Message_en.conf, # CELL_Message_cz.conf, etc.) can be used as models for # populating the application sitedir. # # See App::CELL::Guide for details. #-------------------------------------------------------------# # CELL_DEBUG_MODE # debug mode means that calls to $log->trace and $log->debug # won't be suppressed - off by default set('CELL_DEBUG_MODE', 0); # boolean value expressing whether sharedir has been loaded # (defaults to 1 since the param is initialized only when distro sharedir # is loaded) set('CELL_SHAREDIR_LOADED', 1); # CELL_SHAREDIR_FULLPATH # full path of App::CELL distro sharedir # overrided by site param when sharedir is loaded set('CELL_SHAREDIR_FULLPATH', ''); # CELL_SUPP_LANG # reference to a list of supported language tags # (i.e. languages for which we have _all_ messages # translated) set( 'CELL_SUPP_LANG', [ 'en' ] ); # CELL_DEF_LANG # the language that messages will be displayed in by default, # when no language is specified by other means set('CELL_DEF_LANG', 'en'); # CELL_CORE_UNIT_TESTING # used only for App::CELL unit tests set('CELL_CORE_UNIT_TESTING', [ 'nothing special' ] ); # CELL_LOAD_SANITY_CORE # used by App::CELL::Load::init sanity check set('CELL_LOAD_SANITY_CORE', 'Bar'); # CELL_CORE_SAMPLE # sample core variable (for demo purposes) set('CELL_CORE_SAMPLE', 'layers of sediments' ); # CELL_LOG_SHOW_CALLER # determine whether App::CELL::Log appends file and line number of # caller to log messages set( 'CELL_LOG_SHOW_CALLER', 1 ); #-------------------------------------------------------------# # DO NOT EDIT ANYTHING BELOW THIS LINE # #-------------------------------------------------------------# use strict; use warnings; 1; App-CELL-0.222/config/CELL_MetaConfig.pm000444001750000144 614412766160463 20061 0ustar00smithfarmusers000000000000# ************************************************************************* # Copyright (c) 2014-2015, SUSE LLC # # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions are met: # # 1. Redistributions of source code must retain the above copyright notice, # this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # 3. Neither the name of SUSE LLC nor the names of its contributors may be # used to endorse or promote products derived from this software without # specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # ************************************************************************* #-------------------------------------------------------------# # CELL_MetaConfig.pm # # App::CELL's own site configuration parameters. This file # is stored in the "distro sharedir" and is always loaded # before the files in the application sitedir. # # In addition to being used by App::CELL, the files in the # distro sharedir (CELL_MetaConfig.pm, CELL_Config.pm, and # CELL_SiteConfig.pm along with CELL_Message_en.conf, # CELL_Message_cz.conf, etc.) can be used as models for # populating the application sitedir. # # See App::CELL::Guide for details. #-------------------------------------------------------------# # unique value used by App::CELL::Load::init routine sanity check set('CELL_LOAD_SANITY_META', 'Baz'); # boolean value expressing whether _any_ sitedir has been loaded this is # incremented on every sitedir load, so it also expresses how many sitedirs # have been loaded set('CELL_META_SITEDIR_LOADED', 0); # list of sitedirs found and loaded set('CELL_META_SITEDIR_LIST', []); # boolean value whether App::CELL has been initialized set('CELL_META_INIT_STATUS_BOOL', 0); # date and time when App::CELL was initialized set('CELL_META_START_DATETIME', ''); # for unit testing set( 'CELL_META_UNIT_TESTING', [ 1, 2, 3, 'a', 'b', 'c' ] ); #-------------------------------------------------------------# # DO NOT EDIT ANYTHING BELOW THIS LINE # #-------------------------------------------------------------# use strict; use warnings; 1; App-CELL-0.222/config/README000444001750000144 45512766160463 15547 0ustar00smithfarmusers000000000000This is the "sharedir", where App::CELL stores its own internal configuration information. It can serve as a model for populating the application's site configuration directory. For more information, do: $ perldoc App::CELL::Guide or point your browser at https://metacpan.org/pod/App::CELL::Guide