Log-Contextual-0.009001/000755 000766 000024 00000000000 14625531523 015100 5ustar00gknopstaff000000 000000 Log-Contextual-0.009001/LICENSE000644 000766 000024 00000046501 14625531523 016113 0ustar00gknopstaff000000 000000 This software is copyright (c) 2024 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2024 by Arthur Axel "fREW" Schmidt. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Perl Artistic License 1.0 --- This software is Copyright (c) 2024 by Arthur Axel "fREW" Schmidt. This is free software, licensed under: The Perl Artistic License 1.0 The "Artistic License" Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder as specified below. "Copyright Holder" is whoever is named in the copyright or copyrights for the package. "You" is you, if you're thinking about copying or distributing this Package. "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as uunet.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) give non-standard executables non-standard names, and clearly document the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. You may embed this Package's interpreter within an executable of yours (by linking); this shall be construed as a mere form of aggregation, provided that the complete Standard Version of the interpreter is so embedded. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whoever generated them, and may be sold commercially, and may be aggregated with this Package. If such scripts or library files are aggregated with this Package via the so-called "undump" or "unexec" methods of producing a binary executable image, then distribution of such an image shall neither be construed as a distribution of this Package nor shall it fall under the restrictions of Paragraphs 3 and 4, provided that you do not represent such an executable image as a Standard Version of this Package. 7. C subroutines (or comparably compiled subroutines in other languages) supplied by you and linked into this Package in order to emulate subroutines and variables of the language defined by this Package shall not be considered part of this Package, but are the equivalent of input as in Paragraph 6, provided these subroutines do not change the language in any way that would cause it to fail the regression tests for the language. 8. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Log-Contextual-0.009001/cpanfile000644 000766 000024 00000000540 14625531523 016603 0ustar00gknopstaff000000 000000 requires 'Data::Dumper::Concise' => 0; requires 'Carp' => 0; requires 'Scalar::Util' => 0; requires 'Moo' => '1.003000'; requires 'perl' => '5.008001'; on test => sub { requires 'Test::More' => '0.88'; requires 'Test::Needs'; requires 'Test::Fatal'; }; on develop => sub { requires 'Test::Pod::Coverage::TrustMe'; requires 'Test::Vars'; }; Log-Contextual-0.009001/CONTRIBUTING000644 000766 000024 00000000140 14625531523 016725 0ustar00gknopstaff000000 000000 Before submitting patches please run perltidy with the .perltidyrc included in this repository. Log-Contextual-0.009001/Changes000644 000766 000024 00000011321 14625531523 016371 0ustar00gknopstaff000000 000000 Revision history for Log-Contextual 0.009001 2024-05-29 - fix log4perl test when run with unexpected path or directory seperator - add basic docs showing what each role represents - rename some internal methods to be prefixed with underscores - test cleanups - code formatting cleanups 0.009000 2024-05-15 - drop dependency on Exporter::Declare - add the importing package as an argument when calling subclass methods rather than expecting them to use caller - various packaging tweaks and improvements - Documentation fixes and formatting improvements 0.008001 2018-01-19 09:14:55-08:00 America/Los_Angeles - Ensure new slog functions are exportable (Thanks Dan Book!) 0.008000 2017-11-24 08:40:15-08:00 America/Los_Angeles - Add slog for logging strings without a code block (Thanks Christian Walde!) - Fix exporting into classes that subclass from users of Log::Contextual. (Thanks Graham Knop!) 0.007001 2017-05-21 07:49:18-07:00 America/Los_Angeles - Stop testing exact bytes produced by Data::Dumper::Concise (Thanks for reporting Errietta Kostal) (Fixes GH#11) - Add some documentation about exceptions (Thanks Kent Fredric!) 0.007000 2016-04-11 21:35:41-07:00 America/Los_Angeles - Add `has_logger` predicate to avoid setting logger twice (Thanks Wes Malone! Thwes!) 0.006005 2015-03-14 12:54:46-05:00 America/Chicago - Fix performance (and arguably duplicate side effects!) in multilogger setups (Good catch and fix Christian Walde!) - Fix warning introduced in 5.21.x 0.006004 2014-07-15 21:50:41-05:00 America/Chicago - Various POD fixes (Karent Etheridge, Florian Schlichting) 0.006003 2014-02-22 09:41:29CST-0600 America/Chicago - Stop depending on XS module Sub::Identify 0.006002 2014-02-20 16:05:20CST-0600 America/Chicago - Fix missing POD 0.006001 2014-02-20 15:51:29CST-0600 America/Chicago - Fix warnings caused by importing more than once 0.006000 2013-09-05 - Add Log::Contextual::Easy::Default for simple LC usage (Jakob Voß) - Add Log::Contextual::Easy::Package for more different simple LC usage 0.005005 2013-08-08 - Fix minimum version of Exporter::Declare 0.005004 2013-08-08 - Dep on a newer version of Moo for multiple role composition 0.005003 2013-03-21 - Yell loudly if a user tries to use Log::Contextual::set_logger() or Log::Contextual::with_logger() (aka internals that don't work anymore) directly 0.005002 2013-02-14 (♥) - Fix RT#83267 (Tyler Riddle) 0.005001 2013-02-07 - No changes from previous dev release 0.005000_03 2013-01-16 - merge unpushed 0.004300 into master (frew--, Tyler Riddle++) 0.005000_02 2013-01-15 - add missing changelog entry (derp) 0.005000_01 2013-01-11 - significant changes in the way Log::Contexual works, but the upshot of it is that Log::Contextual is now much less global than before, and applications using Log::Contextual can guard against modules using set_logger (or something like that) and changing their logger. See the new Log::Contextual::Role::Router for more information 0.004300 2012-10-03 - add a way to set default import tags 0.004202 2012-08-04 - correct the caller_level passed into coderef, and document "both" uses of caller_level 0.004201 2012-07-21 - The smallest pod fix ever 0.004200 2012-07-20 - Improve information passed to logger coderef - Significant doc improvements - Fix warning in test suite in Perl 5.16 0.004100 2012-03-29 - Log::Contextual::WarnLogger now supports customized log levels via the 'levels' constructor argument (Karen Etheridge) 0.004001 2011-08-15 - Fix version of Exporter::Declare that we dep on 0.004000 2011-08-06 - Support Log::Contextual subclasses for default import options - Allow custom log levels 0.00305 2011-07-27 - Fix regression that caused D* subs to dumper even if the log level was off 0.00304 2010-07-31 - Add $package_UPTO environment variable for WarnLogger 0.00303 2010-07-10 - Fix broken Log::Log4perl test 0.00302 2010-07-08 - Add Log::Contextual::TeeLogger - Add levels_upto (RT58558) - Use Log::Log4perl 1.29 to clean up caller stuff 0.00301 2010-07-08 [deleted due to missing the TeeLogger] 0.00300 2010-06-03 - Add -package_logger import option 0.00202 2010-05-23 - Fix a bug that caused Dlog and friends not to work with a default 0.00201 2010-03-04 - I left a needed file for testing out of the MANIFEST; fixing :-/ 0.00200 2010-03-03 - add example for Log::Dispatchouli since it works nicely now - make Log::Log4perl work out of the box - Added WarnLogger for libraries - Warn if set_logger is called more than once - Fix tiny POD errors 0.00101 2010-02-21 - Fix tests to not need use lib (incorrect test failures) 0.00100 2010-02-20 - initial release Log-Contextual-0.009001/MANIFEST000644 000766 000024 00000002631 14625531523 016233 0ustar00gknopstaff000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.031. .mailmap .perlcriticrc CONTRIBUTING Changes LICENSE MANIFEST META.json META.yml Makefile.PL README cpanfile dist.ini lib/Log/Contextual.pm lib/Log/Contextual/Easy/Default.pm lib/Log/Contextual/Easy/Package.pm lib/Log/Contextual/Role/Router.pm lib/Log/Contextual/Role/Router/HasLogger.pm lib/Log/Contextual/Role/Router/SetLogger.pm lib/Log/Contextual/Role/Router/WithLogger.pm lib/Log/Contextual/Router.pm lib/Log/Contextual/SimpleLogger.pm lib/Log/Contextual/TeeLogger.pm lib/Log/Contextual/WarnLogger.pm t/00-compile.t t/00-report-prereqs.dd t/00-report-prereqs.t t/arg.t t/base.t t/caller.t t/default_import.t t/default_logger.t t/dlog.t t/easy.t t/eg.t t/has_logger.t t/inherit.t t/lib/BaseLogger.pm t/lib/DefaultImportLogger.pm t/lib/My/Module.pm t/lib/My/Module2.pm t/lib/TestExporter.pm t/lib/TestRouter.pm t/log-with-levels.t t/log.t t/log4perl.t t/package_logger.t t/router_api.t t/rt83267-begin.t t/rt83267.t t/simplelogger.t t/warnlogger-with-levels.t t/warnlogger.t t/yell-loudly.t weaver.ini xt/author/critic.t xt/author/distmeta.t xt/author/eol.t xt/author/minimum-version.t xt/author/mojibake.t xt/author/no-tabs.t xt/author/pod-coverage.t xt/author/pod-spell.t xt/author/pod-syntax.t xt/author/portability.t xt/author/test-vars.t xt/author/test-version.t xt/release/changes_has_content.t xt/release/cpan-changes.t xt/release/meta-json.t Log-Contextual-0.009001/t/000755 000766 000024 00000000000 14625531523 015343 5ustar00gknopstaff000000 000000 Log-Contextual-0.009001/xt/000755 000766 000024 00000000000 14625531523 015533 5ustar00gknopstaff000000 000000 Log-Contextual-0.009001/README000644 000766 000024 00000046460 14625531523 015772 0ustar00gknopstaff000000 000000 NAME Log::Contextual - Simple logging interface with a contextual log VERSION version 0.009001 SYNOPSIS use Log::Contextual qw( :log :dlog set_logger with_logger ); use Log::Contextual::SimpleLogger; use Log::Log4perl ':easy'; Log::Log4perl->easy_init($DEBUG); my $logger = Log::Log4perl->get_logger; set_logger $logger; log_debug { 'program started' }; sub foo { my $minilogger = Log::Contextual::SimpleLogger->new({ levels => [qw( trace debug )] }); my @args = @_; with_logger $minilogger => sub { log_trace { 'foo entered' }; my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @args; # ... slog_trace 'foo left'; }; } foo(); Beginning with version 1.008 Log::Dispatchouli also works out of the box with "Log::Contextual": use Log::Contextual qw( :log :dlog set_logger ); use Log::Dispatchouli; my $ld = Log::Dispatchouli->new({ ident => 'slrtbrfst', to_stderr => 1, debug => 1, }); set_logger $ld; log_debug { 'program started' }; DESCRIPTION Major benefits: * Efficient The default logging functions take blocks, so if a log level is disabled, the block will not run: # the following won't run if debug is off log_debug { "the new count in the database is " . $rs->count }; Similarly, the "D" prefixed methods only "Dumper" the input if the level is enabled. * Handy The logging functions return their arguments, so you can stick them in the middle of expressions: for (log_debug { "downloading:\n" . join qq(\n), @_ } @urls) { ... } * Generic "Log::Contextual" is an interface for all major loggers. If you log through "Log::Contextual" you will be able to swap underlying loggers later. * Powerful "Log::Contextual" chooses which logger to use based on user defined "CodeRef"s. Normally you don't need to know this, but you can take advantage of it when you need to later. * Scalable If you just want to add logging to your basic application, start with Log::Contextual::SimpleLogger and then as your needs grow you can switch to Log::Dispatchouli or Log::Dispatch or Log::Log4perl or whatever else. This module is a simple interface to extensible logging. It exists to abstract your logging interface so that logging is as painless as possible, while still allowing you to switch from one logger to another. It is bundled with a really basic logger, Log::Contextual::SimpleLogger, but in general you should use a real logger instead. For something more serious but not overly complicated, try Log::Dispatchouli (see "SYNOPSIS" for example.) A WORK IN PROGRESS This module is certainly not complete, but we will not break the interface lightly, so I would say it's safe to use in production code. The main result from that at this point is that doing: use Log::Contextual; will die as we do not yet know what the defaults should be. If it turns out that nearly everyone uses the ":log" tag and ":dlog" is really rare, we'll probably make ":log" the default. But only time and usage will tell. IMPORT OPTIONS See "SETTING DEFAULT IMPORT OPTIONS" for information on setting these project wide. -logger When you import this module you may use "-logger" as a shortcut for "set_logger", for example: use Log::Contextual::SimpleLogger; use Log::Contextual qw( :dlog ), -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )] }); sometimes you might want to have the logger handy for other stuff, in which case you might try something like the following: my $var_log; BEGIN { $var_log = VarLogger->new } use Log::Contextual qw( :dlog ), -logger => $var_log; -levels The "-levels" import option allows you to define exactly which levels your logger supports. So the default, "[qw(debug trace warn info error fatal)]", works great for Log::Log4perl, but it doesn't support the levels for Log::Dispatch. But supporting those levels is as easy as doing use Log::Contextual -levels => [qw( debug info notice warning error critical alert emergency )]; -package_logger The "-package_logger" import option is similar to the "-logger" import option except "-package_logger" sets the logger for the current package. Unlike "-default_logger", "-package_logger" cannot be overridden with "set_logger" or "with_logger". package My::Package; use Log::Contextual::SimpleLogger; use Log::Contextual qw( :log ), -package_logger => Log::Contextual::WarnLogger->new({ env_prefix => 'MY_PACKAGE' }); If you are interested in using this package for a module you are putting on CPAN we recommend Log::Contextual::WarnLogger for your package logger. -default_logger The "-default_logger" import option is similar to the "-logger" import option except "-default_logger" sets the default logger for the current package. Basically it sets the logger to be used if "set_logger" is never called; so package My::Package; use Log::Contextual::SimpleLogger; use Log::Contextual qw( :log ), -default_logger => Log::Contextual::WarnLogger->new({ env_prefix => 'MY_PACKAGE' }); SETTING DEFAULT IMPORT OPTIONS Eventually you will get tired of writing the following in every single one of your packages: use Log::Log4perl; use Log::Log4perl ':easy'; BEGIN { Log::Log4perl->easy_init($DEBUG) } use Log::Contextual -logger => Log::Log4perl->get_logger; You can set any of the import options for your whole project if you define your own "Log::Contextual" subclass as follows: package MyApp::Log::Contextual; use parent 'Log::Contextual'; use Log::Log4perl ':easy'; Log::Log4perl->easy_init($DEBUG) sub arg_default_logger { $_[1] || Log::Log4perl->get_logger } sub arg_levels { [qw(debug trace warn info error fatal custom_level)] } sub default_import { ':log' } # or maybe instead of default_logger sub arg_package_logger { $_[1] } # and almost definitely not this, which is only here for completeness sub arg_logger { $_[1] } Note the "$_[1] ||" in "arg_default_logger". All of these methods are passed the values passed in from the arguments to the subclass, so you can either throw them away, honor them, die on usage, etc. To be clear, if you define your subclass, and someone uses it as follows: use MyApp::Log::Contextual -default_logger => $foo, -levels => [qw(bar baz biff)]; Your "arg_default_logger" method will get $foo and your "arg_levels" will get "[qw(bar baz biff)]"; Additionally, the "default_import" method is what happens if a user tries to use your subclass with no arguments. The default just dies, but if you'd like to change the default to import a tag merely return the tags you'd like to import. So the following will all work: sub default_import { ':log' } sub default_import { ':dlog' } sub default_import { qw(:dlog :log ) } See Log::Contextual::Easy::Default for an example of a subclass of "Log::Contextual" that makes use of default import options. FUNCTIONS set_logger my $logger = WarnLogger->new; set_logger $logger; Arguments: "LOGGER CODEREF" "set_logger" will just set the current logger to whatever you pass it. It expects a "CodeRef", but if you pass it something else it will wrap it in a "CodeRef" for you. "set_logger" is really meant only to be called from a top-level script. To avoid foot-shooting the function will warn if you call it more than once. with_logger my $logger = WarnLogger->new; with_logger $logger => sub { if (1 == 0) { log_fatal { 'Non Logical Universe Detected' }; } else { log_info { 'All is good' }; } }; Arguments: "LOGGER CODEREF", "CodeRef $to_execute" "with_logger" sets the logger for the scope of the "CodeRef" $to_execute. As with "set_logger", "with_logger" will wrap $returning_logger with a "CodeRef" if needed. has_logger my $logger = WarnLogger->new; set_logger $logger unless has_logger; Arguments: none "has_logger" will return true if a logger has been set. log_$level Import Tag: ":log" Arguments: "CodeRef $returning_message, @args" "log_$level" functions all work the same except that a different method is called on the underlying $logger object. The basic pattern is: sub log_$level (&@) { if ($logger->is_$level) { $logger->$level(shift->(@_)); } @_ } Note that the function returns its arguments. This can be used in a number of ways, but often it's convenient just for partial inspection of passthrough data my @friends = log_trace { 'friends list being generated, data from first friend: ' . Dumper($_[0]->TO_JSON) } generate_friend_list(); If you want complete inspection of passthrough data, take a look at the "Dlog_$level" functions. Which functions are exported depends on what was passed to "-levels". The default (no "-levels" option passed) would export: log_trace log_debug log_info log_warn log_error log_fatal Note: "log_fatal" does not call "die" for you, see "EXCEPTIONS AND ERROR HANDLING" slog_$level Mostly the same as "log_$level", but expects a string as first argument, not a block. Arguments are passed through just the same, but since it's just a string, interpolation of arguments into it must be done manually. my @friends = slog_trace 'friends list being generated.', generate_friend_list(); logS_$level Import Tag: ":log" Arguments: "CodeRef $returning_message, Item $arg" This is really just a special case of the "log_$level" functions. It forces scalar context when that is what you need. Other than that it works exactly same: my $friend = logS_trace { 'I only have one friend: ' . Dumper($_[0]->TO_JSON) } friend(); See also: "DlogS_$level". slogS_$level Mostly the same as "logS_$level", but expects a string as first argument, not a block. Arguments are passed through just the same, but since it's just a string, interpolation of arguments into it must be done manually. my $friend = slogS_trace 'I only have one friend.', friend(); Dlog_$level Import Tag: ":dlog" Arguments: "CodeRef $returning_message, @args" All of the following six functions work the same as their "log_$level" brethren, except they return what is passed into them and put the stringified (with Data::Dumper::Concise) version of their args into $_. This means you can do cool things like the following: my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all; and the output might look something like: names: "fREW" "fRIOUX" "fROOH" "fRUE" "fiSMBoC" Which functions are exported depends on what was passed to "-levels". The default (no "-levels" option passed) would export: Dlog_trace Dlog_debug Dlog_info Dlog_warn Dlog_error Dlog_fatal Note: "Dlog_fatal" does not call "die" for you, see "EXCEPTIONS AND ERROR HANDLING" Dslog_$level Mostly the same as "Dlog_$level", but expects a string as first argument, not a block. Arguments are passed through just the same, but since it's just a string, no interpolation point can be used, instead the Dumper output is appended. my @nicks = Dslog_debug "names: ", map $_->value, $frew->names->all; DlogS_$level Import Tag: ":dlog" Arguments: "CodeRef $returning_message, Item $arg" Like "logS_$level", these functions are a special case of "Dlog_$level". They only take a single scalar after the $returning_message instead of slurping up (and also setting "wantarray") all the @args my $pals_rs = DlogS_debug { "pals resultset: $_" } $schema->resultset('Pals')->search({ perlers => 1 }); DslogS_$level Mostly the same as "DlogS_$level", but expects a string as first argument, not a block. Arguments are passed through just the same, but since it's just a string, no interpolation point can be used, instead the Dumper output is appended. my $pals_rs = DslogS_debug "pals resultset: ", $schema->resultset('Pals')->search({ perlers => 1 }); LOGGER CODEREF Anywhere a logger object can be passed, a coderef is accepted. This is so that the user can use different logger objects based on runtime information. The logger coderef is passed the package of the caller, and the caller level the coderef needs to use if it wants more caller information. The latter is in a hashref to allow for more options in the future. Here is a basic example of a logger that exploits "caller" to reproduce the output of "warn" with a logger: my @caller_info; my $var_log = Log::Contextual::SimpleLogger->new({ levels => [qw(trace debug info warn error fatal)], coderef => sub { chomp($_[0]); warn "$_[0] at $caller_info[1] line $caller_info[2].\n" } }); my $warn_faker = sub { my ($package, $args) = @_; @caller_info = caller($args->{caller_level}); $var_log }; set_logger($warn_faker); log_debug { 'test' }; The following is an example that uses the information passed to the logger coderef. It sets the global logger to $l3, the logger for the "A1" package to $l1, except the "lol" method in "A1" which uses the $l2 logger and lastly the logger for the "A2" package to $l2. Note that it increases the caller level as it dispatches based on where the caller of the log function, not the log function itself. my $complex_dispatcher = do { my $l1 = ...; my $l2 = ...; my $l3 = ...; my %registry = ( -logger => $l3, A1 => { -logger => $l1, lol => $l2, }, A2 => { -logger => $l2 }, ); sub { my ( $package, $info ) = @_; my $logger = $registry{'-logger'}; if (my $r = $registry{$package}) { $logger = $r->{'-logger'} if $r->{'-logger'}; my (undef, undef, undef, $sub) = caller($info->{caller_level} + 1); $sub =~ s/^\Q$package\E:://g; $logger = $r->{$sub} if $r->{$sub}; } return $logger; } }; set_logger $complex_dispatcher; LOGGER INTERFACE Because this module is ultimately pretty looking glue (glittery?) with the awesome benefit of the Contextual part, users will often want to make their favorite logger work with it. The following are the methods that should be implemented in the logger: is_trace is_debug is_info is_warn is_error is_fatal trace debug info warn error fatal The first six merely need to return true if that level is enabled. The latter six take the results of whatever the user returned from their coderef and log them. For a basic example see Log::Contextual::SimpleLogger. LOG ROUTING In between the loggers and the log functions is a log router that is responsible for finding a logger to handle the log event and passing the log information to the logger. This relationship is described in the documentation for "Log::Contextual::Role::Router". "Log::Contextual" and packages that extend it will by default share a router singleton that implements the with_logger() and set_logger() functions and also respects the -logger, -package_logger, and -default_logger import options with their associated default value functions. The router singleton is available as the return value of the router() function. Users of Log::Contextual may overload router() to return instances of custom log routers that could for example work with loggers that use a different interface. EXCEPTIONS AND ERROR HANDLING "Log::Contextual", by design, does not intentionally invoke "die" on your behalf(*see footnote*) for "log_fatal". Logging events are characterized as information, not flow control, and conflating the two results in negative design anti-patterns. As such, "log_fatal" would at be better used to communicate information about a *future* failure, for example: if ( condition ) { log_fatal { "Bad Condition is true" }; die My::Exception->new(); } This has a number of benefits: * You're more likely to want to use useful Exception Objects and flow control instead of cheating with log messages. * You're less likely to run a risk of losing what the actual problem was when some error occurs in your creation of the Exception Object * You're less likely to run the risk of losing important log context due to exceptions occurring mid way through "die" unwinding and "exit" global destruction. If you're still too lazy to use exceptions, then you can do what you probably want as follows: if ( ... ) { log_fatal { "Bad condition is true" }; die "Bad condtion is true"; } Or for ":dlog" style: use Data::Dumper::Consise qw( Dumper ); if ( ... ) { # Dlog_fatal but not my $reason = "Bad condtion is true because: " . Dumper($thing); log_fatal { $reason }; die $reason; } footnote The underlying behaviour of "log_fatal" is dependent on the backing library. All the Loggers shipping with "Log::Contextual" behave this way, as do many of the supported loggers, like "Log::Log4perl". However, not all loggers work this way, and one must be careful. "Log::Dispatch" doesn't support implementing "log_fatal" at all "Log::Dispatchouli" implements "log_fatal" using "die" ( via Carp ) DESIGNER mst - Matt S. Trout BUGS Please report any bugs or feature requests on the bugtracker website When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. CONTRIBUTORS * Christian Walde * Dan Book * Florian Schlichtin * Graham Knop * Jakob Voss * Karen Etheridge * Kent Fredric * Matt S Trout * Peter Rabbitson * Philippe Bruhat (BooK) * Tyler Riddle * Wes Malone AUTHOR Arthur Axel "fREW" Schmidt COPYRIGHT AND LICENSE This software is copyright (c) 2024 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Log-Contextual-0.009001/META.yml000644 000766 000024 00000005075 14625531523 016360 0ustar00gknopstaff000000 000000 --- abstract: 'Simple logging interface with a contextual log' author: - 'Arthur Axel "fREW" Schmidt ' build_requires: ExtUtils::MakeMaker: '0' File::Spec: '0' IO::Handle: '0' IPC::Open3: '0' Test::Fatal: '0' Test::More: '0.88' Test::Needs: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.031, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Log-Contextual provides: Log::Contextual: file: lib/Log/Contextual.pm version: '0.009001' Log::Contextual::Easy::Default: file: lib/Log/Contextual/Easy/Default.pm version: '0.009001' Log::Contextual::Easy::Package: file: lib/Log/Contextual/Easy/Package.pm version: '0.009001' Log::Contextual::Role::Router: file: lib/Log/Contextual/Role/Router.pm version: '0.009001' Log::Contextual::Role::Router::HasLogger: file: lib/Log/Contextual/Role/Router/HasLogger.pm version: '0.009001' Log::Contextual::Role::Router::SetLogger: file: lib/Log/Contextual/Role/Router/SetLogger.pm version: '0.009001' Log::Contextual::Role::Router::WithLogger: file: lib/Log/Contextual/Role/Router/WithLogger.pm version: '0.009001' Log::Contextual::Router: file: lib/Log/Contextual/Router.pm version: '0.009001' Log::Contextual::SimpleLogger: file: lib/Log/Contextual/SimpleLogger.pm version: '0.009001' Log::Contextual::TeeLogger: file: lib/Log/Contextual/TeeLogger.pm version: '0.009001' Log::Contextual::WarnLogger: file: lib/Log/Contextual/WarnLogger.pm version: '0.009001' requires: Carp: '0' Data::Dumper::Concise: '0' Moo: '1.003000' Scalar::Util: '0' perl: '5.008001' resources: bugtracker: https://github.com/haarg/Log-Contextual/issues repository: https://github.com/haarg/Log-Contextual.git version: '0.009001' x_contributors: - 'Christian Walde ' - 'Dan Book ' - 'Florian Schlichtin ' - 'Graham Knop ' - 'Jakob Voss ' - 'Karen Etheridge ' - 'Kent Fredric ' - 'Matt S Trout ' - 'Peter Rabbitson ' - 'Philippe Bruhat (BooK) ' - 'Tyler Riddle ' - 'Wes Malone ' x_generated_by_perl: v5.38.2 x_serialization_backend: 'YAML::Tiny version 1.74' x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later' x_use_unsafe_inc: 0 Log-Contextual-0.009001/lib/000755 000766 000024 00000000000 14625531523 015646 5ustar00gknopstaff000000 000000 Log-Contextual-0.009001/Makefile.PL000644 000766 000024 00000002767 14625531523 017066 0ustar00gknopstaff000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.031. use strict; use warnings; use 5.008001; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Simple logging interface with a contextual log", "AUTHOR" => "Arthur Axel \"fREW\" Schmidt ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Log-Contextual", "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.008001", "NAME" => "Log::Contextual", "PREREQ_PM" => { "Carp" => 0, "Data::Dumper::Concise" => 0, "Moo" => "1.003000", "Scalar::Util" => 0 }, "TEST_REQUIRES" => { "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "IO::Handle" => 0, "IPC::Open3" => 0, "Test::Fatal" => 0, "Test::More" => "0.88", "Test::Needs" => 0 }, "VERSION" => "0.009001", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Carp" => 0, "Data::Dumper::Concise" => 0, "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "IO::Handle" => 0, "IPC::Open3" => 0, "Moo" => "1.003000", "Scalar::Util" => 0, "Test::Fatal" => 0, "Test::More" => "0.88", "Test::Needs" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); Log-Contextual-0.009001/.mailmap000644 000766 000024 00000000462 14625531523 016523 0ustar00gknopstaff000000 000000 Christian Walde Florian Schlichtin Florian Schlichtin Matt S Trout Log-Contextual-0.009001/weaver.ini000644 000766 000024 00000000204 14625531523 017066 0ustar00gknopstaff000000 000000 [@CorePrep] [-SingleEncoding] [-StopWords] [Generic / NAME] [ReplaceVersion] [Leftovers] [Bugs] [Contributors] [Authors] [Legal] Log-Contextual-0.009001/.perlcriticrc000644 000766 000024 00000006562 14625531523 017577 0ustar00gknopstaff000000 000000 severity = 1 verbose = 9 only = 1 [BuiltinFunctions::ProhibitComplexMappings] [BuiltinFunctions::ProhibitLvalueSubstr] [BuiltinFunctions::ProhibitShiftRef] [BuiltinFunctions::ProhibitSleepViaSelect] [BuiltinFunctions::ProhibitStringyEval] [BuiltinFunctions::ProhibitUniversalCan] [BuiltinFunctions::ProhibitUniversalIsa] [BuiltinFunctions::ProhibitVoidGrep] [BuiltinFunctions::ProhibitVoidMap] [BuiltinFunctions::RequireGlobFunction] [BuiltinFunctions::RequireSimpleSortBlock] [ClassHierarchies::ProhibitOneArgBless] [CodeLayout::ProhibitHardTabs] [CodeLayout::RequireConsistentNewlines] [ControlStructures::ProhibitCascadingIfElse] [ControlStructures::ProhibitDeepNests] [ControlStructures::ProhibitLabelsWithSpecialBlockNames] [ControlStructures::ProhibitMutatingListFunctions] [ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions] [ControlStructures::ProhibitUnreachableCode] [ControlStructures::ProhibitYadaOperator] [ErrorHandling::RequireCheckingReturnValueOfEval] [InputOutput::ProhibitBacktickOperators] [InputOutput::ProhibitBarewordFileHandles] [InputOutput::ProhibitExplicitStdin] [InputOutput::ProhibitInteractiveTest] [InputOutput::ProhibitJoinedReadline] [InputOutput::ProhibitOneArgSelect] [InputOutput::ProhibitReadlineInForLoop] [InputOutput::ProhibitTwoArgOpen] [InputOutput::RequireBriefOpen] [InputOutput::RequireCheckedOpen] [InputOutput::RequireEncodingWithUTF8Layer] [Miscellanea::ProhibitFormats] [Miscellanea::ProhibitUnrestrictedNoCritic] [Modules::ProhibitAutomaticExportation] [Modules::ProhibitConditionalUseStatements] [Modules::ProhibitEvilModules] [Modules::ProhibitExcessMainComplexity] [Modules::RequireBarewordIncludes] [Modules::RequireEndWithOne] [Modules::RequireExplicitPackage] [Modules::RequireFilenameMatchesPackage] [NamingConventions::ProhibitAmbiguousNames] [Objects::ProhibitIndirectSyntax] [RegularExpressions::ProhibitCaptureWithoutTest] [RegularExpressions::ProhibitComplexRegexes] [RegularExpressions::ProhibitUnusedCapture] [Subroutines::ProhibitBuiltinHomonyms] [Subroutines::ProhibitExcessComplexity] max_mccabe = 30 [Subroutines::ProhibitExplicitReturnUndef] [Subroutines::ProhibitManyArgs] [Subroutines::ProhibitNestedSubs] [Subroutines::ProhibitReturnSort] [Subroutines::ProhibitSubroutinePrototypes] [Subroutines::ProhibitUnusedPrivateSubroutines] [Subroutines::ProtectPrivateSubs] [TestingAndDebugging::ProhibitProlongedStrictureOverride] [TestingAndDebugging::RequireTestLabels] [TestingAndDebugging::RequireUseStrict] [TestingAndDebugging::RequireUseWarnings] [ValuesAndExpressions::ProhibitCommaSeparatedStatements] [ValuesAndExpressions::ProhibitComplexVersion] [ValuesAndExpressions::ProhibitImplicitNewlines] [ValuesAndExpressions::ProhibitLeadingZeros] [ValuesAndExpressions::ProhibitMismatchedOperators] [ValuesAndExpressions::ProhibitQuotesAsQuotelikeOperatorDelimiters] [ValuesAndExpressions::ProhibitSpecialLiteralHeredocTerminator] [ValuesAndExpressions::ProhibitVersionStrings] [ValuesAndExpressions::RequireQuotedHeredocTerminator] [Variables::ProhibitAugmentedAssignmentInDeclaration] allow_our = 1 [Variables::ProhibitConditionalDeclarations] [Variables::ProhibitMatchVars] [Variables::ProhibitReusedNames] [Variables::ProhibitUnusedVariables] [Variables::ProtectPrivateVars] [Variables::RequireInitializationForLocalVars] [Variables::RequireLexicalLoopIterators] [Variables::RequireLocalizedPunctuationVars] [Variables::RequireNegativeIndices] Log-Contextual-0.009001/META.json000644 000766 000024 00000010620 14625531523 016520 0ustar00gknopstaff000000 000000 { "abstract" : "Simple logging interface with a contextual log", "author" : [ "Arthur Axel \"fREW\" Schmidt " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.031, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Log-Contextual", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Test::CPAN::Changes" : "0.19", "Test::CPAN::Meta" : "0", "Test::CPAN::Meta::JSON" : "0.16", "Test::EOL" : "0", "Test::MinimumVersion" : "0", "Test::Mojibake" : "0", "Test::More" : "0.88", "Test::NoTabs" : "0", "Test::Perl::Critic" : "0", "Test::Pod" : "1.41", "Test::Pod::Coverage::TrustMe" : "0", "Test::Portability::Files" : "0", "Test::Spelling" : "0.12", "Test::Vars" : "0", "Test::Version" : "1" } }, "runtime" : { "requires" : { "Carp" : "0", "Data::Dumper::Concise" : "0", "Moo" : "1.003000", "Scalar::Util" : "0", "perl" : "5.008001" } }, "test" : { "recommends" : { "CPAN::Meta" : "2.120900" }, "requires" : { "ExtUtils::MakeMaker" : "0", "File::Spec" : "0", "IO::Handle" : "0", "IPC::Open3" : "0", "Test::Fatal" : "0", "Test::More" : "0.88", "Test::Needs" : "0" } } }, "provides" : { "Log::Contextual" : { "file" : "lib/Log/Contextual.pm", "version" : "0.009001" }, "Log::Contextual::Easy::Default" : { "file" : "lib/Log/Contextual/Easy/Default.pm", "version" : "0.009001" }, "Log::Contextual::Easy::Package" : { "file" : "lib/Log/Contextual/Easy/Package.pm", "version" : "0.009001" }, "Log::Contextual::Role::Router" : { "file" : "lib/Log/Contextual/Role/Router.pm", "version" : "0.009001" }, "Log::Contextual::Role::Router::HasLogger" : { "file" : "lib/Log/Contextual/Role/Router/HasLogger.pm", "version" : "0.009001" }, "Log::Contextual::Role::Router::SetLogger" : { "file" : "lib/Log/Contextual/Role/Router/SetLogger.pm", "version" : "0.009001" }, "Log::Contextual::Role::Router::WithLogger" : { "file" : "lib/Log/Contextual/Role/Router/WithLogger.pm", "version" : "0.009001" }, "Log::Contextual::Router" : { "file" : "lib/Log/Contextual/Router.pm", "version" : "0.009001" }, "Log::Contextual::SimpleLogger" : { "file" : "lib/Log/Contextual/SimpleLogger.pm", "version" : "0.009001" }, "Log::Contextual::TeeLogger" : { "file" : "lib/Log/Contextual/TeeLogger.pm", "version" : "0.009001" }, "Log::Contextual::WarnLogger" : { "file" : "lib/Log/Contextual/WarnLogger.pm", "version" : "0.009001" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/haarg/Log-Contextual/issues" }, "repository" : { "type" : "git", "url" : "https://github.com/haarg/Log-Contextual.git", "web" : "https://github.com/haarg/Log-Contextual" } }, "version" : "0.009001", "x_contributors" : [ "Christian Walde ", "Dan Book ", "Florian Schlichtin ", "Graham Knop ", "Jakob Voss ", "Karen Etheridge ", "Kent Fredric ", "Matt S Trout ", "Peter Rabbitson ", "Philippe Bruhat (BooK) ", "Tyler Riddle ", "Wes Malone " ], "x_generated_by_perl" : "v5.38.2", "x_serialization_backend" : "Cpanel::JSON::XS version 4.37", "x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later", "x_use_unsafe_inc" : 0 } Log-Contextual-0.009001/dist.ini000644 000766 000024 00000002624 14625531523 016550 0ustar00gknopstaff000000 000000 name = Log-Contextual author = Arthur Axel "fREW" Schmidt license = Perl_5 copyright_holder = Arthur Axel "fREW" Schmidt ;;; Gather [Git::GatherDir] include_dotfiles = 1 exclude_match = ^\.git ;;; Metadata [Git::Contributors] [MetaProvides::Package] [MetaResources] bugtracker.web = https://github.com/haarg/Log-Contextual/issues repository.url = https://github.com/haarg/Log-Contextual.git repository.web = https://github.com/haarg/Log-Contextual repository.type = git [Prereqs::FromCPANfile] [UseUnsafeInc] dot_in_INC = 0 ;;; Modification [PodWeaver] ; authordep Pod::Weaver::Section::Contributors ; authordep Pod::Weaver::Section::ReplaceVersion ; authordep Pod::Weaver::Plugin::StopWords ;;; Extra Files [License] [MetaJSON] [MetaYAML] [Manifest] [Pod2Readme] ;;; Installer [MakeMaker] ;;; Release [TestRelease] [RunExtraTests] [ConfirmRelease] [UploadToCPAN] [Git::Check] [Git::Remote::Check] branch = main [@Git::VersionManager] -remove = Prereqs NextRelease.format = %-8v %{yyyy-MM-dd}d%{ (TRIAL RELEASE)}T [Git::Push] ;;; Tests [MetaTests] [MojibakeTests] [PodSyntaxTests] [Test::CPAN::Changes] [Test::CPAN::Meta::JSON] [Test::ChangesHasContent] [Test::Compile] [Test::EOL] [Test::MinimumVersion] [Test::NoTabs] [Test::Perl::Critic] critic_config = .perlcriticrc [Test::PodSpelling] [Test::Portability] [Test::ReportPrereqs] [Test::Version] Log-Contextual-0.009001/lib/Log/000755 000766 000024 00000000000 14625531523 016367 5ustar00gknopstaff000000 000000 Log-Contextual-0.009001/lib/Log/Contextual/000755 000766 000024 00000000000 14625531523 020515 5ustar00gknopstaff000000 000000 Log-Contextual-0.009001/lib/Log/Contextual.pm000644 000766 000024 00000067153 14625531523 021067 0ustar00gknopstaff000000 000000 package Log::Contextual; use strict; use warnings; our $VERSION = '0.009001'; use Data::Dumper::Concise; use B qw(svref_2object); sub _stash_name { my ($coderef) = @_; ref $coderef or return; my $cv = B::svref_2object($coderef); $cv->isa('B::CV') or return; # bail out if GV is undefined $cv->GV->isa('B::SPECIAL') and return; return $cv->GV->STASH->NAME; } eval { ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval) require Log::Log4perl; die if $Log::Log4perl::VERSION < 1.29; Log::Log4perl->wrapper_register(__PACKAGE__) }; sub router { our $Router_Instance ||= do { require Log::Contextual::Router; Log::Contextual::Router->new } } sub default_import { my ($class) = shift; die 'Log::Contextual does not have a default import list'; } my @all_levels = qw(debug trace warn info error fatal); sub arg_logger { $_[1] } sub arg_levels { $_[1] || [@all_levels] } sub arg_package_logger { $_[1] } sub arg_default_logger { $_[1] } my %exports; for my $level (@all_levels) { $exports{$_.'_'.$level} = { type => $_, level => $level } for qw(Dlog DlogS Dslog DslogS); $exports{$_.'_'.$level} = { type => $_, level => $level } for qw(log logS slog slogS); } $exports{$_} = {} for qw( set_logger with_logger has_logger ); my %import_arguments = map +($_ => $_), qw(logger package_logger default_logger levels); my %allowed_tags = map +($_ => $_), qw(log dlog); sub import { my ($class, @args) = @_; my $target = caller; my %options; my @tags; my @imports; @args = qw(:default) if !@args; while (@args) { my $arg = shift @args; if ($arg =~ /\A[-:](.*)/s) { my $name = $1; if ($import_arguments{$name}) { my $option_args = shift @args; $options{$name} = $option_args; } elsif ($name eq 'default') { my @tag_args = ref $args[0] ? shift @args : (); push @args, map +($_ => @tag_args), $class->default_import; } elsif (defined $allowed_tags{$name}) { my $tag_args = ref $args[0] ? shift @args : undef; push @tags, { tag => $name, args => $tag_args }; } else { die "Invalid argument $arg!"; } } else { $arg =~ s/\A&//; my $export_config = $exports{$arg} or die "Invalid import $arg!"; my $import_args = ref $args[0] ? shift @args : undef; push @imports, { import => $arg, args => $import_args, %$export_config }; } } my @levels = @{$class->arg_levels($options{levels})}; for my $tag (@tags) { my @want = $tag->{tag} eq 'log' ? qw(log logS slog slogS) : $tag->{tag} eq 'dlog' ? qw(Dlog DlogS Dslog DslogS) : die "Invalid tag $tag->{tag}"; for my $want (@want) { push @imports, map +{ import => "${want}_$_", args => $tag->{args}, type => $want, level => $_ }, @levels; } } my %router_args = ( exporter => $class, target => $target, arguments => \%options, ); my $router = $class->router; # wrapped in an extra sub so that caller levels match what they were when # using Exporter::Declare sub { $router->before_import(%router_args) }->(); for my $import (@imports) { $class->_maybe_export($target, $import, $router); } sub { $router->after_import(%router_args) }->(); } sub _maybe_export { my ($class, $target, $import, $router) = @_; my $name = $import->{import}; my $import_args = $import->{args} || {}; my $as = $import_args->{-as}; my $prefix = $import_args->{-prefix}; my $suffix = $import_args->{-suffix}; my $target_name = defined $as ? $as : ( (defined $prefix ? $prefix : '') . $name . (defined $suffix ? $suffix : '') ); my $full_target = "${target}::${target_name}"; my $method = '_gen_' . ($import->{type} || $name); my $level = $import->{level}; my $sub = $class->$method($router, defined $level ? $level : ()); no strict 'refs'; if (defined &$full_target) { return if _stash_name(\&full_target) eq __PACKAGE__; # reexport will warn } *$full_target = $sub; } sub _gen_set_logger { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) my ($class, $router) = @_; die ref($router) . " does not support set_logger()" unless $router->does('Log::Contextual::Role::Router::SetLogger'); sub { $router->set_logger(@_) }, } sub _gen_with_logger { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) my ($class, $router) = @_; die ref($router) . " does not support with_logger()" unless $router->does('Log::Contextual::Role::Router::WithLogger'); sub { $router->with_logger(@_) }, } sub _gen_has_logger { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) my ($class, $router) = @_; die ref($router) . " does not support has_logger()" unless $router->does('Log::Contextual::Role::Router::HasLogger'); sub { $router->has_logger(@_) }, } sub _gen_log { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) my ($class, $router, $level) = @_; sub (&@) { my ($code, @args) = @_; $router->handle_log_request( exporter => $class, caller_level => 1, message_level => $level, caller_package => scalar(caller), message_sub => $code, message_args => \@args, ); return @args; }; } sub _gen_slog { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) my ($class, $router, $level) = @_; sub { my ($text, @args) = @_; $router->handle_log_request( exporter => $class, caller_level => 1, message_level => $level, caller_package => scalar(caller), message_text => $text, message_args => \@args, ); return @args; }; } sub _gen_logS { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) my ($class, $router, $level) = @_; sub (&@) { my ($code, @args) = @_; $router->handle_log_request( exporter => $class, caller_level => 1, message_level => $level, caller_package => scalar(caller), message_sub => $code, message_args => \@args, ); return $args[0]; }; } sub _gen_slogS { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) my ($class, $router, $level) = @_; sub { my ($text, @args) = @_; $router->handle_log_request( exporter => $class, caller_level => 1, message_level => $level, caller_package => scalar(caller), message_text => $text, message_args => \@args, ); return $args[0]; }; } sub _gen_Dlog { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) my ($class, $router, $level) = @_; sub (&@) { my ($code, @args) = @_; my $wrapped = sub { local $_ = (@_ ? Data::Dumper::Concise::Dumper @_ : '()'); &$code; }; $router->handle_log_request( exporter => $class, caller_level => 1, message_level => $level, caller_package => scalar(caller), message_sub => $wrapped, message_args => \@args, ); return @args; }; } sub _gen_Dslog { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) my ($class, $router, $level) = @_; sub { my ($text, @args) = @_; my $wrapped = sub { $text . (@_ ? Data::Dumper::Concise::Dumper @_ : '()'); }; $router->handle_log_request( exporter => $class, caller_level => 1, message_level => $level, caller_package => scalar(caller), message_sub => $wrapped, message_args => \@args, ); return @args; }; } sub _gen_DlogS { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) my ($class, $router, $level) = @_; sub (&$) { my ($code, $ref) = @_; my $wrapped = sub { local $_ = Data::Dumper::Concise::Dumper($_[0]); &$code; }; $router->handle_log_request( exporter => $class, caller_level => 1, message_level => $level, caller_package => scalar(caller), message_sub => $wrapped, message_args => [$ref], ); return $ref; }; } sub _gen_DslogS { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) my ($class, $router, $level) = @_; sub { my ($text, $ref) = @_; my $wrapped = sub { $text . Data::Dumper::Concise::Dumper($_[0]); }; $router->handle_log_request( exporter => $class, caller_level => 1, message_level => $level, caller_package => scalar(caller), message_sub => $wrapped, message_args => [$ref], ); return $ref; }; } for (qw(set with)) { no strict 'refs'; my $sub = "${_}_logger"; *{"Log::Contextual::$sub"} = sub { die "$sub is no longer a direct sub in Log::Contextual. " . 'Note that this feature was never tested nor documented. ' . "Please fix your code to import $sub instead of trying to use it directly"; } } 1; __END__ =pod =encoding UTF-8 =for :stopwords Arthur Axel "fREW" Schmidt Scalable passthrough =head1 NAME Log::Contextual - Simple logging interface with a contextual log =head1 VERSION version 0.009001 =head1 SYNOPSIS use Log::Contextual qw( :log :dlog set_logger with_logger ); use Log::Contextual::SimpleLogger; use Log::Log4perl ':easy'; Log::Log4perl->easy_init($DEBUG); my $logger = Log::Log4perl->get_logger; set_logger $logger; log_debug { 'program started' }; sub foo { my $minilogger = Log::Contextual::SimpleLogger->new({ levels => [qw( trace debug )] }); my @args = @_; with_logger $minilogger => sub { log_trace { 'foo entered' }; my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @args; # ... slog_trace 'foo left'; }; } foo(); Beginning with version 1.008 L also works out of the box with C: use Log::Contextual qw( :log :dlog set_logger ); use Log::Dispatchouli; my $ld = Log::Dispatchouli->new({ ident => 'slrtbrfst', to_stderr => 1, debug => 1, }); set_logger $ld; log_debug { 'program started' }; =head1 DESCRIPTION Major benefits: =over 2 =item * Efficient The default logging functions take blocks, so if a log level is disabled, the block will not run: # the following won't run if debug is off log_debug { "the new count in the database is " . $rs->count }; Similarly, the C prefixed methods only C the input if the level is enabled. =item * Handy The logging functions return their arguments, so you can stick them in the middle of expressions: for (log_debug { "downloading:\n" . join qq(\n), @_ } @urls) { ... } =item * Generic C is an interface for all major loggers. If you log through C you will be able to swap underlying loggers later. =item * Powerful C chooses which logger to use based on L<< user defined Cs|/LOGGER CODEREF >>. Normally you don't need to know this, but you can take advantage of it when you need to later. =item * Scalable If you just want to add logging to your basic application, start with L and then as your needs grow you can switch to L or L or L or whatever else. =back This module is a simple interface to extensible logging. It exists to abstract your logging interface so that logging is as painless as possible, while still allowing you to switch from one logger to another. It is bundled with a really basic logger, L, but in general you should use a real logger instead. For something more serious but not overly complicated, try L (see L for example.) =head1 A WORK IN PROGRESS This module is certainly not complete, but we will not break the interface lightly, so I would say it's safe to use in production code. The main result from that at this point is that doing: use Log::Contextual; will die as we do not yet know what the defaults should be. If it turns out that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll probably make C<:log> the default. But only time and usage will tell. =head1 IMPORT OPTIONS See L for information on setting these project wide. =head2 -logger When you import this module you may use C<-logger> as a shortcut for L, for example: use Log::Contextual::SimpleLogger; use Log::Contextual qw( :dlog ), -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )] }); sometimes you might want to have the logger handy for other stuff, in which case you might try something like the following: my $var_log; BEGIN { $var_log = VarLogger->new } use Log::Contextual qw( :dlog ), -logger => $var_log; =head2 -levels The C<-levels> import option allows you to define exactly which levels your logger supports. So the default, C<< [qw(debug trace warn info error fatal)] >>, works great for L, but it doesn't support the levels for L. But supporting those levels is as easy as doing use Log::Contextual -levels => [qw( debug info notice warning error critical alert emergency )]; =head2 -package_logger The C<-package_logger> import option is similar to the C<-logger> import option except C<-package_logger> sets the logger for the current package. Unlike L, C<-package_logger> cannot be overridden with L or L. package My::Package; use Log::Contextual::SimpleLogger; use Log::Contextual qw( :log ), -package_logger => Log::Contextual::WarnLogger->new({ env_prefix => 'MY_PACKAGE' }); If you are interested in using this package for a module you are putting on CPAN we recommend L for your package logger. =head2 -default_logger The C<-default_logger> import option is similar to the C<-logger> import option except C<-default_logger> sets the B logger for the current package. Basically it sets the logger to be used if C is never called; so package My::Package; use Log::Contextual::SimpleLogger; use Log::Contextual qw( :log ), -default_logger => Log::Contextual::WarnLogger->new({ env_prefix => 'MY_PACKAGE' }); =head1 SETTING DEFAULT IMPORT OPTIONS =for Pod::Coverage arg_default_logger default_import arg_package_logger arg_levels arg_logger Eventually you will get tired of writing the following in every single one of your packages: use Log::Log4perl; use Log::Log4perl ':easy'; BEGIN { Log::Log4perl->easy_init($DEBUG) } use Log::Contextual -logger => Log::Log4perl->get_logger; You can set any of the import options for your whole project if you define your own C subclass as follows: package MyApp::Log::Contextual; use parent 'Log::Contextual'; use Log::Log4perl ':easy'; Log::Log4perl->easy_init($DEBUG) sub arg_default_logger { $_[1] || Log::Log4perl->get_logger } sub arg_levels { [qw(debug trace warn info error fatal custom_level)] } sub default_import { ':log' } # or maybe instead of default_logger sub arg_package_logger { $_[1] } # and almost definitely not this, which is only here for completeness sub arg_logger { $_[1] } Note the C<< $_[1] || >> in C. All of these methods are passed the values passed in from the arguments to the subclass, so you can either throw them away, honor them, die on usage, etc. To be clear, if you define your subclass, and someone uses it as follows: use MyApp::Log::Contextual -default_logger => $foo, -levels => [qw(bar baz biff)]; Your C method will get C<$foo> and your C will get C<[qw(bar baz biff)]>; Additionally, the C method is what happens if a user tries to use your subclass with no arguments. The default just dies, but if you'd like to change the default to import a tag merely return the tags you'd like to import. So the following will all work: sub default_import { ':log' } sub default_import { ':dlog' } sub default_import { qw(:dlog :log ) } See L for an example of a subclass of C that makes use of default import options. =head1 FUNCTIONS =head2 set_logger my $logger = WarnLogger->new; set_logger $logger; Arguments: L C will just set the current logger to whatever you pass it. It expects a C, but if you pass it something else it will wrap it in a C for you. C is really meant only to be called from a top-level script. To avoid foot-shooting the function will warn if you call it more than once. =head2 with_logger my $logger = WarnLogger->new; with_logger $logger => sub { if (1 == 0) { log_fatal { 'Non Logical Universe Detected' }; } else { log_info { 'All is good' }; } }; Arguments: L, C C sets the logger for the scope of the C C<$to_execute>. As with L, C will wrap C<$returning_logger> with a C if needed. =head2 has_logger my $logger = WarnLogger->new; set_logger $logger unless has_logger; Arguments: none C will return true if a logger has been set. =head2 log_$level Import Tag: C<:log> Arguments: C C functions all work the same except that a different method is called on the underlying C<$logger> object. The basic pattern is: sub log_$level (&@) { if ($logger->is_$level) { $logger->$level(shift->(@_)); } @_ } Note that the function returns its arguments. This can be used in a number of ways, but often it's convenient just for partial inspection of passthrough data my @friends = log_trace { 'friends list being generated, data from first friend: ' . Dumper($_[0]->TO_JSON) } generate_friend_list(); If you want complete inspection of passthrough data, take a look at the L functions. Which functions are exported depends on what was passed to L. The default (no C<-levels> option passed) would export: =over 2 =item log_trace =item log_debug =item log_info =item log_warn =item log_error =item log_fatal B C does not call C for you, see L =back =head2 slog_$level Mostly the same as L, but expects a string as first argument, not a block. Arguments are passed through just the same, but since it's just a string, interpolation of arguments into it must be done manually. my @friends = slog_trace 'friends list being generated.', generate_friend_list(); =head2 logS_$level Import Tag: C<:log> Arguments: C This is really just a special case of the L functions. It forces scalar context when that is what you need. Other than that it works exactly same: my $friend = logS_trace { 'I only have one friend: ' . Dumper($_[0]->TO_JSON) } friend(); See also: L. =head2 slogS_$level Mostly the same as L, but expects a string as first argument, not a block. Arguments are passed through just the same, but since it's just a string, interpolation of arguments into it must be done manually. my $friend = slogS_trace 'I only have one friend.', friend(); =head2 Dlog_$level Import Tag: C<:dlog> Arguments: C All of the following six functions work the same as their L brethren, except they return what is passed into them and put the stringified (with L) version of their args into C<$_>. This means you can do cool things like the following: my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all; and the output might look something like: names: "fREW" "fRIOUX" "fROOH" "fRUE" "fiSMBoC" Which functions are exported depends on what was passed to L. The default (no C<-levels> option passed) would export: =over 2 =item Dlog_trace =item Dlog_debug =item Dlog_info =item Dlog_warn =item Dlog_error =item Dlog_fatal B C does not call C for you, see L =back =head2 Dslog_$level Mostly the same as L, but expects a string as first argument, not a block. Arguments are passed through just the same, but since it's just a string, no interpolation point can be used, instead the Dumper output is appended. my @nicks = Dslog_debug "names: ", map $_->value, $frew->names->all; =head2 DlogS_$level Import Tag: C<:dlog> Arguments: C Like L, these functions are a special case of L. They only take a single scalar after the C<$returning_message> instead of slurping up (and also setting C) all the C<@args> my $pals_rs = DlogS_debug { "pals resultset: $_" } $schema->resultset('Pals')->search({ perlers => 1 }); =head2 DslogS_$level Mostly the same as L, but expects a string as first argument, not a block. Arguments are passed through just the same, but since it's just a string, no interpolation point can be used, instead the Dumper output is appended. my $pals_rs = DslogS_debug "pals resultset: ", $schema->resultset('Pals')->search({ perlers => 1 }); =head1 LOGGER CODEREF Anywhere a logger object can be passed, a coderef is accepted. This is so that the user can use different logger objects based on runtime information. The logger coderef is passed the package of the caller, and the caller level the coderef needs to use if it wants more caller information. The latter is in a hashref to allow for more options in the future. Here is a basic example of a logger that exploits C to reproduce the output of C with a logger: my @caller_info; my $var_log = Log::Contextual::SimpleLogger->new({ levels => [qw(trace debug info warn error fatal)], coderef => sub { chomp($_[0]); warn "$_[0] at $caller_info[1] line $caller_info[2].\n" } }); my $warn_faker = sub { my ($package, $args) = @_; @caller_info = caller($args->{caller_level}); $var_log }; set_logger($warn_faker); log_debug { 'test' }; The following is an example that uses the information passed to the logger coderef. It sets the global logger to C<$l3>, the logger for the C package to C<$l1>, except the C method in C which uses the C<$l2> logger and lastly the logger for the C package to C<$l2>. Note that it increases the caller level as it dispatches based on where the caller of the log function, not the log function itself. my $complex_dispatcher = do { my $l1 = ...; my $l2 = ...; my $l3 = ...; my %registry = ( -logger => $l3, A1 => { -logger => $l1, lol => $l2, }, A2 => { -logger => $l2 }, ); sub { my ( $package, $info ) = @_; my $logger = $registry{'-logger'}; if (my $r = $registry{$package}) { $logger = $r->{'-logger'} if $r->{'-logger'}; my (undef, undef, undef, $sub) = caller($info->{caller_level} + 1); $sub =~ s/^\Q$package\E:://g; $logger = $r->{$sub} if $r->{$sub}; } return $logger; } }; set_logger $complex_dispatcher; =head1 LOGGER INTERFACE Because this module is ultimately pretty looking glue (glittery?) with the awesome benefit of the Contextual part, users will often want to make their favorite logger work with it. The following are the methods that should be implemented in the logger: is_trace is_debug is_info is_warn is_error is_fatal trace debug info warn error fatal The first six merely need to return true if that level is enabled. The latter six take the results of whatever the user returned from their coderef and log them. For a basic example see L. =head1 LOG ROUTING =for Pod::Coverage router In between the loggers and the log functions is a log router that is responsible for finding a logger to handle the log event and passing the log information to the logger. This relationship is described in the documentation for C. C and packages that extend it will by default share a router singleton that implements the with_logger() and set_logger() functions and also respects the -logger, -package_logger, and -default_logger import options with their associated default value functions. The router singleton is available as the return value of the router() function. Users of Log::Contextual may overload router() to return instances of custom log routers that could for example work with loggers that use a different interface. =head1 EXCEPTIONS AND ERROR HANDLING C, by design, does not B invoke C on your behalf(L<*see footnote*|/footnote>) for C. Logging events are characterized as information, not flow control, and conflating the two results in negative design anti-patterns. As such, C would at be better used to communicate information about a I failure, for example: if ( condition ) { log_fatal { "Bad Condition is true" }; die My::Exception->new(); } This has a number of benefits: =over 4 =item * You're more likely to want to use useful Exception Objects and flow control instead of cheating with log messages. =item * You're less likely to run a risk of losing what the actual problem was when some error occurs in your creation of the Exception Object =item * You're less likely to run the risk of losing important log context due to exceptions occurring mid way through C unwinding and C global destruction. =back If you're still too lazy to use exceptions, then you can do what you probably want as follows: if ( ... ) { log_fatal { "Bad condition is true" }; die "Bad condtion is true"; } Or for C<:dlog> style: use Data::Dumper::Consise qw( Dumper ); if ( ... ) { # Dlog_fatal but not my $reason = "Bad condtion is true because: " . Dumper($thing); log_fatal { $reason }; die $reason; } =head2 footnote The underlying behaviour of C is dependent on the backing library. All the Loggers shipping with C behave this way, as do many of the supported loggers, like C. However, not all loggers work this way, and one must be careful. C doesn't support implementing C L C implements C using C ( via Carp ) =head1 DESIGNER mst - Matt S. Trout =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 CONTRIBUTORS =for stopwords Christian Walde Dan Book Florian Schlichtin Graham Knop Jakob Voss Karen Etheridge Kent Fredric Matt S Trout Peter Rabbitson Philippe Bruhat (BooK) Tyler Riddle Wes Malone =over 4 =item * Christian Walde =item * Dan Book =item * Florian Schlichtin =item * Graham Knop =item * Jakob Voss =item * Karen Etheridge =item * Kent Fredric =item * Matt S Trout =item * Peter Rabbitson =item * Philippe Bruhat (BooK) =item * Tyler Riddle =item * Wes Malone =back =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2024 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Log-Contextual-0.009001/lib/Log/Contextual/Easy/000755 000766 000024 00000000000 14625531523 021416 5ustar00gknopstaff000000 000000 Log-Contextual-0.009001/lib/Log/Contextual/Role/000755 000766 000024 00000000000 14625531523 021416 5ustar00gknopstaff000000 000000 Log-Contextual-0.009001/lib/Log/Contextual/SimpleLogger.pm000644 000766 000024 00000010272 14625531523 023446 0ustar00gknopstaff000000 000000 package Log::Contextual::SimpleLogger; use strict; use warnings; our $VERSION = '0.009001'; { for my $name (qw( trace debug info warn error fatal )) { no strict 'refs'; *{$name} = sub { my $self = shift; $self->_log($name, @_) if ($self->{$name}); }; *{"is_$name"} = sub { my $self = shift; return $self->{$name}; }; } } sub new { my ($class, $args) = @_; my $self = bless {}, $class; $self->{$_} = 1 for @{$args->{levels}}; $self->{coderef} = $args->{coderef} || sub { print STDERR @_ }; if (my $upto = $args->{levels_upto}) { my @levels = (qw( trace debug info warn error fatal )); my $i = 0; for (@levels) { last if $upto eq $_; $i++ } for ($i .. $#levels) { $self->{$levels[$_]} = 1 } } return $self; } sub _log { my $self = shift; my $level = shift; my $message = join("\n", @_); $message .= "\n" unless $message =~ /\n$/; $self->{coderef}->(sprintf("[%s] %s", $level, $message)); } 1; __END__ =pod =encoding UTF-8 =for :stopwords Arthur Axel "fREW" Schmidt =head1 NAME Log::Contextual::SimpleLogger - Super simple logger made for playing with Log::Contextual =head1 VERSION version 0.009001 =head1 SYNOPSIS use Log::Contextual::SimpleLogger; use Log::Contextual qw( :log ), -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )]}); log_info { 'program started' }; # no-op because info is not in levels sub foo { log_debug { 'entered foo' }; ... } =head1 DESCRIPTION This module is a simple logger made mostly for demonstration and initial experimentation with L. We recommend you use a real logger instead. For something more serious but not overly complicated, take a look at L. =head1 METHODS =head2 new Arguments: C<< Dict[ levels => Optional[ArrayRef[Str]], levels_upto => Level, coderef => Optional[CodeRef], ] $conf >> my $l = Log::Contextual::SimpleLogger->new({ levels => [qw( info warn )], coderef => sub { print @_ }, # the default prints to STDERR }); or my $l = Log::Contextual::SimpleLogger->new({ levels_upto => 'debug', coderef => sub { print @_ }, # the default prints to STDERR }); Creates a new SimpleLogger object with the passed levels enabled and optionally a C may be passed to modify how the logs are output/stored. C enables all the levels up to and including the level passed. Levels may contain: trace debug info warn error fatal =head2 $level Arguments: C<@anything> All of the following six methods work the same. The basic pattern is: sub $level { my $self = shift; print STDERR "[$level] " . join qq{\n}, @_; if $self->is_$level; } =head3 trace $l->trace( 'entered method foo with args ' join q{,}, @args ); =head3 debug $l->debug( 'entered method foo' ); =head3 info $l->info( 'started process foo' ); =head3 warn $l->warn( 'possible misconfiguration at line 10' ); =head3 error $l->error( 'non-numeric user input!' ); =head3 fatal $l->fatal( '1 is never equal to 0!' ); B C does not call C for you, see L =head2 is_$level All of the following six functions just return true if their respective level is enabled. =head3 is_trace say 'tracing' if $l->is_trace; =head3 is_debug say 'debuging' if $l->is_debug; =head3 is_info say q{info'ing} if $l->is_info; =head3 is_warn say 'warning' if $l->is_warn; =head3 is_error say 'erroring' if $l->is_error; =head3 is_fatal say q{fatal'ing} if $l->is_fatal; =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2024 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Log-Contextual-0.009001/lib/Log/Contextual/TeeLogger.pm000644 000766 000024 00000007504 14625531523 022736 0ustar00gknopstaff000000 000000 package Log::Contextual::TeeLogger; use strict; use warnings; our $VERSION = '0.009001'; { for my $name (qw( trace debug info warn error fatal )) { no strict 'refs'; *{$name} = sub { my $self = shift; foreach my $logger (@{$self->{loggers}}) { $logger->$name(@_); } }; my $is_name = "is_${name}"; *{$is_name} = sub { my $self = shift; foreach my $logger (@{$self->{loggers}}) { return 1 if $logger->$is_name(@_); } return 0; }; } } sub new { my ($class, $args) = @_; my $self = bless {}, $class; ref($self->{loggers} = $args->{loggers}) eq 'ARRAY' or die "No loggers passed to tee logger"; return $self; } 1; __END__ =pod =encoding UTF-8 =for :stopwords Arthur Axel "fREW" Schmidt =head1 NAME Log::Contextual::TeeLogger - Output to more than one logger =head1 VERSION version 0.009001 =head1 SYNOPSIS use Log::Contextual::SimpleLogger; use Log::Contextual::TeeLogger; use Log::Contextual qw( :log ), -logger => Log::Contextual::TeeLogger->new({ loggers => [ Log::Contextual::SimpleLogger->new({ levels => [ 'debug' ] }), Log::Contextual::SimpleLogger->new({ levels => [ 'info' ], coderef => sub { print @_ }, }), ]}); ## docs below here not yet edited log_info { 'program started' }; # no-op because info is not in levels sub foo { log_debug { 'entered foo' }; ... } =head1 DESCRIPTION This module is a simple logger made mostly for demonstration and initial experimentation with L. We recommend you use a real logger instead. For something more serious but not overly complicated, take a look at L. =head1 METHODS =head2 new Arguments: C<< Dict[ levels => ArrayRef[Str], coderef => Optional[CodeRef] ] $conf >> my $l = Log::Contextual::SimpleLogger->new({ levels => [qw( info warn )], coderef => sub { print @_ }, # the default prints to STDERR }); Creates a new SimpleLogger object with the passed levels enabled and optionally a C may be passed to modify how the logs are output/stored. Levels may contain: trace debug info warn error fatal =head2 $level Arguments: C<@anything> All of the following six methods work the same. The basic pattern is: sub $level { my $self = shift; print STDERR "[$level] " . join qq{\n}, @_; if $self->is_$level; } =head3 trace $l->trace( 'entered method foo with args ' join q{,}, @args ); =head3 debug $l->debug( 'entered method foo' ); =head3 info $l->info( 'started process foo' ); =head3 warn $l->warn( 'possible misconfiguration at line 10' ); =head3 error $l->error( 'non-numeric user input!' ); =head3 fatal $l->fatal( '1 is never equal to 0!' ); B C does not call C for you, see L =head2 is_$level All of the following six functions just return true if their respective level is enabled. =head3 is_trace say 'tracing' if $l->is_trace; =head3 is_debug say 'debuging' if $l->is_debug; =head3 is_info say q{info'ing} if $l->is_info; =head3 is_warn say 'warning' if $l->is_warn; =head3 is_error say 'erroring' if $l->is_error; =head3 is_fatal say q{fatal'ing} if $l->is_fatal; =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2024 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Log-Contextual-0.009001/lib/Log/Contextual/WarnLogger.pm000644 000766 000024 00000015103 14625531523 023122 0ustar00gknopstaff000000 000000 package Log::Contextual::WarnLogger; use strict; use warnings; our $VERSION = '0.009001'; use Carp 'croak'; my @default_levels = qw( trace debug info warn error fatal ); # generate subs to handle the default levels # anything else will have to be handled by AUTOLOAD at runtime { for my $level (@default_levels) { no strict 'refs'; my $is_name = "is_$level"; *{$level} = sub { my $self = shift; $self->_log($level, @_) if $self->$is_name; }; *{$is_name} = sub { my $self = shift; return 1 if $ENV{$self->{env_prefix} . '_' . uc $level}; my $upto = $ENV{$self->{env_prefix} . '_UPTO'}; return unless $upto; $upto = lc $upto; return $self->{level_num}{$level} >= $self->{level_num}{$upto}; }; } } our $AUTOLOAD; sub AUTOLOAD { my $self = $_[0]; (my $name = our $AUTOLOAD) =~ s/.*:://; return if $name eq 'DESTROY'; # extract the log level from the sub name my ($is, $level) = $name =~ m/^(is_)?(.+)$/; my $is_name = "is_$level"; no strict 'refs'; *{$level} = sub { my $self = shift; $self->_log($level, @_) if $self->$is_name; }; *{$is_name} = sub { my $self = shift; my $prefix_field = $self->{env_prefix} . '_' . uc $level; return 1 if $ENV{$prefix_field}; # don't log if the variable specifically says not to return 0 if defined $ENV{$prefix_field} and not $ENV{$prefix_field}; my $upto_field = $self->{env_prefix} . '_UPTO'; my $upto = $ENV{$upto_field}; if ($upto) { $upto = lc $upto; croak "Unrecognized log level '$upto' in \$ENV{$upto_field}" if not defined $self->{level_num}{$upto}; return $self->{level_num}{$level} >= $self->{level_num}{$upto}; } # if we don't recognize this level and nothing says otherwise, log! return 1 if not $self->{custom_levels}; }; goto &$AUTOLOAD; } sub new { my ($class, $args) = @_; my $levels = $args->{levels}; croak 'invalid levels specification: must be non-empty arrayref' if defined $levels and (ref $levels ne 'ARRAY' or !@$levels); my $custom_levels = defined $levels; $levels ||= [@default_levels]; my %level_num; @level_num{@$levels} = (0 .. $#{$levels}); my $self = bless { levels => $levels, level_num => \%level_num, custom_levels => $custom_levels, }, $class; $self->{env_prefix} = $args->{env_prefix} or die 'no env_prefix passed to Log::Contextual::WarnLogger->new'; return $self; } sub _log { my $self = shift; my $level = shift; my $message = join("\n", @_); $message .= "\n" unless $message =~ /\n$/; warn "[$level] $message"; } 1; __END__ =pod =encoding UTF-8 =for :stopwords Arthur Axel "fREW" Schmidt =head1 NAME Log::Contextual::WarnLogger - logger for libraries using Log::Contextual =head1 VERSION version 0.009001 =head1 SYNOPSIS package My::Package; use Log::Contextual::WarnLogger; use Log::Contextual qw( :log ), -default_logger => Log::Contextual::WarnLogger->new({ env_prefix => 'MY_PACKAGE', levels => [ qw(debug info notice warning error critical alert emergency) ], }); # warns '[info] program started' if $ENV{MY_PACKAGE_TRACE} is set log_info { 'program started' }; # no-op because info is not in levels sub foo { # warns '[debug] entered foo' if $ENV{MY_PACKAGE_DEBUG} is set log_debug { 'entered foo' }; ... } =head1 DESCRIPTION This module is a simple logger made for libraries using L. We recommend the use of this logger as your default logger as it is simple and useful for most users, yet users can use L to override your choice of logger in their own code thanks to the way L works. =head1 METHODS =head2 new Arguments: C<< Dict[ env_prefix => Str, levels => List ] $conf >> my $l = Log::Contextual::WarnLogger->new({ env_prefix => 'BAR' }); or: my $l = Log::Contextual::WarnLogger->new({ env_prefix => 'BAR', levels => [ 'level1', 'level2' ], }); Creates a new logger object where C defines what the prefix is for the environment variables that will be checked for the log levels. The log levels may be customized, but if not defined, these are used: =over 4 =item trace =item debug =item info =item warn =item error =item fatal =back For example, if C is set to C the following environment variables will be used: FREWS_PACKAGE_UPTO FREWS_PACKAGE_TRACE FREWS_PACKAGE_DEBUG FREWS_PACKAGE_INFO FREWS_PACKAGE_WARN FREWS_PACKAGE_ERROR FREWS_PACKAGE_FATAL Note that C is a convenience variable. If you set C<< FOO_UPTO=TRACE >> it will enable all log levels. Similarly, if you set it to C only fatal will be enabled. =head2 $level Arguments: C<@anything> All of the following six methods work the same. The basic pattern is: sub $level { my $self = shift; warn "[$level] " . join qq{\n}, @_; if $self->is_$level; } =head3 trace $l->trace( 'entered method foo with args ' join q{,}, @args ); =head3 debug $l->debug( 'entered method foo' ); =head3 info $l->info( 'started process foo' ); =head3 warn $l->warn( 'possible misconfiguration at line 10' ); =head3 error $l->error( 'non-numeric user input!' ); =head3 fatal $l->fatal( '1 is never equal to 0!' ); If different levels are specified, appropriate functions named for your custom levels work as you expect. B C does not call C for you, see L =head2 is_$level All of the following six functions just return true if their respective environment variable is enabled. =head3 is_trace say 'tracing' if $l->is_trace; =head3 is_debug say 'debuging' if $l->is_debug; =head3 is_info say q{info'ing} if $l->is_info; =head3 is_warn say 'warning' if $l->is_warn; =head3 is_error say 'erroring' if $l->is_error; =head3 is_fatal say q{fatal'ing} if $l->is_fatal; If different levels are specified, appropriate is_$level functions work as you would expect. =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2024 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Log-Contextual-0.009001/lib/Log/Contextual/Router.pm000644 000766 000024 00000011100 14625531523 022324 0ustar00gknopstaff000000 000000 package Log::Contextual::Router; use strict; use warnings; our $VERSION = '0.009001'; use Scalar::Util 'blessed'; use Moo; with 'Log::Contextual::Role::Router', 'Log::Contextual::Role::Router::SetLogger', 'Log::Contextual::Role::Router::WithLogger', 'Log::Contextual::Role::Router::HasLogger'; eval { ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval) require Log::Log4perl; die if $Log::Log4perl::VERSION < 1.29; Log::Log4perl->wrapper_register(__PACKAGE__) }; has _default_logger => ( is => 'ro', default => sub { {} }, init_arg => undef, ); has _package_logger => ( is => 'ro', default => sub { {} }, init_arg => undef, ); has _get_logger => ( is => 'ro', default => sub { {} }, init_arg => undef, ); sub before_import { } sub after_import { my ($self, %import_info) = @_; my $exporter = $import_info{exporter}; my $target = $import_info{target}; my $config = $import_info{arguments}; if (my $l = $exporter->arg_logger($config->{logger}, $target)) { $self->set_logger($l); } if (my $l = $exporter->arg_package_logger($config->{package_logger}, $target)) { $self->_set_package_logger_for($target, $l); } if (my $l = $exporter->arg_default_logger($config->{default_logger}, $target)) { $self->_set_default_logger_for($target, $l); } } sub with_logger { my $logger = $_[1]; if (ref $logger ne 'CODE') { die 'logger was not a CodeRef or a logger object. Please try again.' unless blessed($logger); $logger = do { my $l = $logger; sub { $l } }; } local $_[0]->_get_logger->{l} = $logger; $_[2]->(); } sub set_logger { my $logger = $_[1]; if (ref $logger ne 'CODE') { die 'logger was not a CodeRef or a logger object. Please try again.' unless blessed($logger); $logger = do { my $l = $logger; sub { $l } }; } warn 'set_logger (or -logger) called more than once! This is a bad idea!' if $_[0]->_get_logger->{l}; $_[0]->_get_logger->{l} = $logger; } sub has_logger { !!$_[0]->_get_logger->{l} } sub _set_default_logger_for { my $logger = $_[2]; if (ref $logger ne 'CODE') { die 'logger was not a CodeRef or a logger object. Please try again.' unless blessed($logger); $logger = do { my $l = $logger; sub { $l } }; } $_[0]->_default_logger->{$_[1]} = $logger } sub _set_package_logger_for { my $logger = $_[2]; if (ref $logger ne 'CODE') { die 'logger was not a CodeRef or a logger object. Please try again.' unless blessed($logger); $logger = do { my $l = $logger; sub { $l } }; } $_[0]->_package_logger->{$_[1]} = $logger } sub _get_loggers { my ($self, %info) = @_; my $package = $info{caller_package}; my $log_level = $info{message_level}; my $logger = $_[0]->_package_logger->{$package} || $_[0]->_get_logger->{l} || $_[0]->_default_logger->{$package} || die q( no logger set! you can't try to log something without a logger! ); $info{caller_level}++; $logger = $logger->($package, \%info); return $logger if $logger->${\"is_${log_level}"}; return (); } sub handle_log_request { my ($self, %message_info) = @_; my $generator = $message_info{message_sub}; my $text = $message_info{message_text}; my $args = $message_info{message_args}; my $log_level = $message_info{message_level}; $message_info{caller_level}++; my @loggers = $self->_get_loggers(%message_info) or return; my @log = defined $text ? ($text) : ($generator->(@$args)); $_->$log_level(@log) for @loggers; } 1; __END__ =pod =encoding UTF-8 =for :stopwords Arthur Axel "fREW" Schmidt =head1 NAME Log::Contextual::Router - Route messages to loggers =head1 VERSION version 0.009001 =head1 DESCRIPTION This is the default log router used by L. It fulfills the roles L, L, L, and L. =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2024 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Log-Contextual-0.009001/lib/Log/Contextual/Role/Router.pm000644 000766 000024 00000013526 14625531523 023243 0ustar00gknopstaff000000 000000 package Log::Contextual::Role::Router; use strict; use warnings; our $VERSION = '0.009001'; use Moo::Role; requires 'before_import'; requires 'after_import'; requires 'handle_log_request'; 1; __END__ =pod =encoding UTF-8 =for :stopwords Arthur Axel "fREW" Schmidt =head1 NAME Log::Contextual::Role::Router - Abstract interface between loggers and logging code blocks =head1 VERSION version 0.009001 =head1 SYNOPSIS package MyApp::Log::Router; use Moo; use Log::Contextual::SimpleLogger; with 'Log::Contextual::Role::Router'; has logger => (is => 'lazy'); sub _build_logger { return Log::Contextual::SimpleLogger->new({ levels_upto => 'debug' }); } sub before_import { my ($self, %export_info) = @_; my $exporter = $export_info{exporter}; my $target = $export_info{target}; print STDERR "Package '$target' will import from '$exporter'\n"; } sub after_import { my ($self, %export_info) = @_; my $exporter = $export_info{exporter}; my $target = $export_info{target}; print STDERR "Package '$target' has imported from '$exporter'\n"; } sub handle_log_request { my ($self, %message_info) = @_; my $log_code_block = $message_info{message_sub}; my $args = $message_info{message_args}; my $log_level_name = $message_info{message_level}; my $logger = $self->logger; my $is_active = $logger->can("is_${log_level_name}"); return unless defined $is_active && $logger->$is_active; my $log_message = $log_code_block->(@$args); $logger->$log_level_name($log_message); } package MyApp::Log::Contextual; use Moo; use MyApp::Log::Router; extends 'Log::Contextual'; #This example router is a singleton sub router { our $Router ||= MyApp::Log::Router->new } package main; use strict; use warnings; use MyApp::Log::Contextual qw(:log); log_info { "Hello there" }; =head1 DESCRIPTION Log::Contextual has three parts =over 4 =item Export manager and logging method generator These tasks are handled by the C package. =item Logger selection and invocation The logging functions generated and exported by Log::Contextual call a method on an instance of a log router object which is responsible for invoking any loggers that should get an opportunity to receive the log message. The C class implements the set_logger() and with_logger() functions as well as uses the arg_ prefixed functions to configure itself and provide the standard C logger selection API. =item Log message formatting and output The logger objects themselves accept or reject a log message at a certain log level with a guard method per level. If the logger is going to accept the log message the router is then responsible for executing the log message code block and passing the generated message to the logging object's log method. =back =head1 METHODS =over 4 =item before_import($self, %import_info) =item after_import($self, %import_info) These two required methods are called with identical arguments at two different places during the import process. The before_import() method is invoked prior to the logging subroutines being exported into the target package and after_import() is called when the export is completed but before control returns to the package that imported the API. The arguments are passed as a hash with the following keys: =over 4 =item exporter This is the name of the package that has been imported. It can also be 'Log::Contextual' itself. In the case of the synopsis the value for exporter would be 'MyApp::Log::Contextual'. =item target This is the package name that is importing the logging API. In the case of the synopsis the value would be 'main'. =item arguments This is a hash reference containing the configuration values that were provided for the import. The key is the name of the configuration item that was specified without the leading hyphen ('-'). For instance if the logging API is imported as follows use Log::Contextual qw( :log ), -logger => Custom::Logger->new({ levels => [qw( debug )] }); then $import_info{arguments}->{logger} would contain that instance of Custom::Logger. =back =item handle_log_request($self, %message_info) This method is called by C when a log event happens. The arguments are passed as a hash with the following keys =over 4 =item exporter This is the name of the package that created the logging methods used to generate the log event. =item caller_package This is the name of the package that the log event has happened inside of. =item caller_level This is an integer that contains the value to pass to caller() that will provide information about the location the log event was created at. =item log_level This is the name of the log level associated with the log event. =item message_sub This is the message generating code block associated with the log event passed as a code reference. If the logger accepts the log request the router should execute the code reference to create the log message and then pass the message as a string to the logger. =item message_args This is an array reference that contains the arguments given to the message generating code block. When invoking the message generator it will almost certainly be expecting these argument values as well. =back =back =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2024 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Log-Contextual-0.009001/lib/Log/Contextual/Role/Router/000755 000766 000024 00000000000 14625531523 022676 5ustar00gknopstaff000000 000000 Log-Contextual-0.009001/lib/Log/Contextual/Role/Router/SetLogger.pm000644 000766 000024 00000001766 14625531523 025141 0ustar00gknopstaff000000 000000 package Log::Contextual::Role::Router::SetLogger; use strict; use warnings; our $VERSION = '0.009001'; use Moo::Role; requires 'set_logger'; 1; __END__ =pod =encoding UTF-8 =for :stopwords Arthur Axel "fREW" Schmidt =head1 NAME Log::Contextual::Role::Router::SetLogger - Abstract interface between loggers and logging code blocks =head1 VERSION version 0.009001 =head1 REQUIRED METHODS =over =item set_logger =back =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2024 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Log-Contextual-0.009001/lib/Log/Contextual/Role/Router/WithLogger.pm000644 000766 000024 00000001772 14625531523 025316 0ustar00gknopstaff000000 000000 package Log::Contextual::Role::Router::WithLogger; use strict; use warnings; our $VERSION = '0.009001'; use Moo::Role; requires 'with_logger'; 1; __END__ =pod =encoding UTF-8 =for :stopwords Arthur Axel "fREW" Schmidt =head1 NAME Log::Contextual::Role::Router::WithLogger - Abstract interface between loggers and logging code blocks =head1 VERSION version 0.009001 =head1 REQUIRED METHODS =over =item with_logger =back =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2024 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Log-Contextual-0.009001/lib/Log/Contextual/Role/Router/HasLogger.pm000644 000766 000024 00000001766 14625531523 025121 0ustar00gknopstaff000000 000000 package Log::Contextual::Role::Router::HasLogger; use strict; use warnings; our $VERSION = '0.009001'; use Moo::Role; requires 'has_logger'; 1; __END__ =pod =encoding UTF-8 =for :stopwords Arthur Axel "fREW" Schmidt =head1 NAME Log::Contextual::Role::Router::HasLogger - Abstract interface between loggers and logging code blocks =head1 VERSION version 0.009001 =head1 REQUIRED METHODS =over =item has_logger =back =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2024 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Log-Contextual-0.009001/lib/Log/Contextual/Easy/Package.pm000644 000766 000024 00000004250 14625531523 023310 0ustar00gknopstaff000000 000000 package Log::Contextual::Easy::Package; use strict; use warnings; our $VERSION = '0.009001'; use Log::Contextual (); BEGIN { our @ISA = qw(Log::Contextual); } sub arg_package_logger { if ($_[1]) { return $_[1]; } else { require Log::Contextual::WarnLogger; my $package = uc $_[2]; $package =~ s/::/_/g; return Log::Contextual::WarnLogger->new({env_prefix => $package}); } } sub default_import { qw(:dlog :log ) } 1; __END__ =pod =encoding UTF-8 =for :stopwords Arthur Axel "fREW" Schmidt =head1 NAME Log::Contextual::Easy::Package - Import all logging methods with WarnLogger as default package logger =head1 VERSION version 0.009001 =head1 SYNOPSIS In your module: package My::Module; use Log::Contextual::Easy::Package; log_debug { "your message" }; Dlog_trace { $_ } @vars; In your program: use My::Module; # enable warnings $ENV{MY_MODULE_UPTO}="TRACE"; # or use a specific logger with set_logger / with_logger =head1 DESCRIPTION By default, this module enables a L with C based on the module's name that uses Log::Contextual::Easy. The logging levels are set to C C, C, C, C, and C (in this order) and all logging functions (L, L<< C|Log::Contextual/"logS_$level" >>, L<< C|Log::Contextual/"Dlog_$level" >>, and L<< C|Log::Contextual/"DlogS_$level" >>) are exported. For what C<::Package> implies, see L. =head1 SEE ALSO =over 4 =item L =back =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2024 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Log-Contextual-0.009001/lib/Log/Contextual/Easy/Default.pm000644 000766 000024 00000004237 14625531523 023346 0ustar00gknopstaff000000 000000 package Log::Contextual::Easy::Default; use strict; use warnings; our $VERSION = '0.009001'; use Log::Contextual (); BEGIN { our @ISA = qw(Log::Contextual) } sub arg_default_logger { if ($_[1]) { return $_[1]; } else { require Log::Contextual::WarnLogger; my $package = uc $_[2]; $package =~ s/::/_/g; return Log::Contextual::WarnLogger->new({env_prefix => $package}); } } sub default_import { qw(:dlog :log ) } 1; __END__ =pod =encoding UTF-8 =for :stopwords Arthur Axel "fREW" Schmidt =head1 NAME Log::Contextual::Easy::Default - Import all logging methods with WarnLogger as default =head1 VERSION version 0.009001 =head1 SYNOPSIS In your module: package My::Module; use Log::Contextual::Easy::Default; log_debug { "your message" }; Dlog_trace { $_ } @vars; In your program: use My::Module; # enable warnings $ENV{MY_MODULE_UPTO}="TRACE"; # or use a specific logger with set_logger / with_logger =head1 DESCRIPTION By default, this module enables a L with C based on the module's name that uses Log::Contextual::Easy. The logging levels are set to C C, C, C, C, and C (in this order) and all logging functions (L<< C|Log::Contextual/"log_$level" >>, L<< C|Log::Contextual/"logS_$level" >>, L<< C|Log::Contextual/"Dlog_$level" >>, and L<< C|Log::Contextual/"DlogS_$level" >>) are exported. For what C<::Default> implies, see L. =head1 SEE ALSO =over 4 =item L =back =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHOR Arthur Axel "fREW" Schmidt =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2024 by Arthur Axel "fREW" Schmidt. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Log-Contextual-0.009001/xt/author/000755 000766 000024 00000000000 14625531523 017035 5ustar00gknopstaff000000 000000 Log-Contextual-0.009001/xt/release/000755 000766 000024 00000000000 14625531523 017153 5ustar00gknopstaff000000 000000 Log-Contextual-0.009001/xt/release/meta-json.t000644 000766 000024 00000000064 14625531523 021235 0ustar00gknopstaff000000 000000 #!perl use Test::CPAN::Meta::JSON; meta_json_ok(); Log-Contextual-0.009001/xt/release/changes_has_content.t000644 000766 000024 00000002104 14625531523 023332 0ustar00gknopstaff000000 000000 use Test::More tests => 2; note 'Checking Changes'; my $changes_file = 'Changes'; my $newver = '0.009001'; my $trial_token = '-TRIAL'; my $encoding = 'UTF-8'; SKIP: { ok(-e $changes_file, "$changes_file file exists") or skip 'Changes is missing', 1; ok(_get_changes($newver), "$changes_file has content for $newver"); } done_testing; sub _get_changes { my $newver = shift; # parse changelog to find commit message open(my $fh, '<', $changes_file) or die "cannot open $changes_file: $!"; my $changelog = join('', <$fh>); if ($encoding) { require Encode; $changelog = Encode::decode($encoding, $changelog, Encode::FB_CROAK()); } close $fh; my @content = grep { /^$newver(?:$trial_token)?(?:\s+|$)/ ... /^\S/ } # from newver to un-indented split /\n/, $changelog; shift @content; # drop the version line # drop unindented last line and trailing blank lines pop @content while ( @content && $content[-1] =~ /^(?:\S|\s*$)/ ); # return number of non-blank lines return scalar @content; } Log-Contextual-0.009001/xt/release/cpan-changes.t000644 000766 000024 00000000344 14625531523 021670 0ustar00gknopstaff000000 000000 use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::CPAN::Changes 0.012 use Test::More 0.96 tests => 1; use Test::CPAN::Changes; subtest 'changes_ok' => sub { changes_file_ok('Changes'); }; Log-Contextual-0.009001/xt/author/mojibake.t000644 000766 000024 00000000151 14625531523 021000 0ustar00gknopstaff000000 000000 #!perl use strict; use warnings qw(all); use Test::More; use Test::Mojibake; all_files_encoding_ok(); Log-Contextual-0.009001/xt/author/test-vars.t000644 000766 000024 00000000413 14625531523 021150 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use Test::Vars; use Test::Pod::Coverage::TrustMe qw(all_modules); my @modules = all_modules(); plan tests => scalar @modules; for my $file (@modules) { vars_ok($file, ignore_vars => ['$class'], ); } done_testing; Log-Contextual-0.009001/xt/author/no-tabs.t000644 000766 000024 00000002522 14625531523 020566 0ustar00gknopstaff000000 000000 use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::NoTabs 0.15 use Test::More 0.88; use Test::NoTabs; my @files = ( 'lib/Log/Contextual.pm', 'lib/Log/Contextual/Easy/Default.pm', 'lib/Log/Contextual/Easy/Package.pm', 'lib/Log/Contextual/Role/Router.pm', 'lib/Log/Contextual/Role/Router/HasLogger.pm', 'lib/Log/Contextual/Role/Router/SetLogger.pm', 'lib/Log/Contextual/Role/Router/WithLogger.pm', 'lib/Log/Contextual/Router.pm', 'lib/Log/Contextual/SimpleLogger.pm', 'lib/Log/Contextual/TeeLogger.pm', 'lib/Log/Contextual/WarnLogger.pm', 't/00-compile.t', 't/00-report-prereqs.dd', 't/00-report-prereqs.t', 't/arg.t', 't/base.t', 't/caller.t', 't/default_import.t', 't/default_logger.t', 't/dlog.t', 't/easy.t', 't/eg.t', 't/has_logger.t', 't/inherit.t', 't/lib/BaseLogger.pm', 't/lib/DefaultImportLogger.pm', 't/lib/My/Module.pm', 't/lib/My/Module2.pm', 't/lib/TestExporter.pm', 't/lib/TestRouter.pm', 't/log-with-levels.t', 't/log.t', 't/log4perl.t', 't/package_logger.t', 't/router_api.t', 't/rt83267-begin.t', 't/rt83267.t', 't/simplelogger.t', 't/warnlogger-with-levels.t', 't/warnlogger.t', 't/yell-loudly.t' ); notabs_ok($_) foreach @files; done_testing; Log-Contextual-0.009001/xt/author/critic.t000644 000766 000024 00000000201 14625531523 020470 0ustar00gknopstaff000000 000000 #!perl use strict; use warnings; use Test::Perl::Critic (-profile => ".perlcriticrc") x!! -e ".perlcriticrc"; all_critic_ok(); Log-Contextual-0.009001/xt/author/minimum-version.t000644 000766 000024 00000000154 14625531523 022360 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use Test::MinimumVersion; all_minimum_version_from_metayml_ok(); Log-Contextual-0.009001/xt/author/test-version.t000644 000766 000024 00000000637 14625531523 021672 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; # generated by Dist::Zilla::Plugin::Test::Version 1.09 use Test::Version; my @imports = qw( version_all_ok ); my $params = { is_strict => 0, has_version => 1, multiple => 0, }; push @imports, $params if version->parse( $Test::Version::VERSION ) >= version->parse('1.002'); Test::Version->import(@imports); version_all_ok; done_testing; Log-Contextual-0.009001/xt/author/eol.t000644 000766 000024 00000002554 14625531523 020007 0ustar00gknopstaff000000 000000 use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::EOL 0.19 use Test::More 0.88; use Test::EOL; my @files = ( 'lib/Log/Contextual.pm', 'lib/Log/Contextual/Easy/Default.pm', 'lib/Log/Contextual/Easy/Package.pm', 'lib/Log/Contextual/Role/Router.pm', 'lib/Log/Contextual/Role/Router/HasLogger.pm', 'lib/Log/Contextual/Role/Router/SetLogger.pm', 'lib/Log/Contextual/Role/Router/WithLogger.pm', 'lib/Log/Contextual/Router.pm', 'lib/Log/Contextual/SimpleLogger.pm', 'lib/Log/Contextual/TeeLogger.pm', 'lib/Log/Contextual/WarnLogger.pm', 't/00-compile.t', 't/00-report-prereqs.dd', 't/00-report-prereqs.t', 't/arg.t', 't/base.t', 't/caller.t', 't/default_import.t', 't/default_logger.t', 't/dlog.t', 't/easy.t', 't/eg.t', 't/has_logger.t', 't/inherit.t', 't/lib/BaseLogger.pm', 't/lib/DefaultImportLogger.pm', 't/lib/My/Module.pm', 't/lib/My/Module2.pm', 't/lib/TestExporter.pm', 't/lib/TestRouter.pm', 't/log-with-levels.t', 't/log.t', 't/log4perl.t', 't/package_logger.t', 't/router_api.t', 't/rt83267-begin.t', 't/rt83267.t', 't/simplelogger.t', 't/warnlogger-with-levels.t', 't/warnlogger.t', 't/yell-loudly.t' ); eol_unix_ok($_, { trailing_whitespace => 1 }) foreach @files; done_testing; Log-Contextual-0.009001/xt/author/pod-syntax.t000644 000766 000024 00000000252 14625531523 021327 0ustar00gknopstaff000000 000000 #!perl # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); Log-Contextual-0.009001/xt/author/portability.t000644 000766 000024 00000000130 14625531523 021556 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use Test::Portability::Files; run_tests(); Log-Contextual-0.009001/xt/author/distmeta.t000644 000766 000024 00000000223 14625531523 021031 0ustar00gknopstaff000000 000000 #!perl # This file was automatically generated by Dist::Zilla::Plugin::MetaTests. use strict; use warnings; use Test::CPAN::Meta; meta_yaml_ok(); Log-Contextual-0.009001/xt/author/pod-spell.t000644 000766 000024 00000001156 14625531523 021124 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; # generated by Dist::Zilla::Plugin::Test::PodSpelling 2.007005 use Test::Spelling 0.12; use Pod::Wordlist; add_stopwords(); all_pod_files_spelling_ok( qw( bin lib ) ); __DATA__ Arthur Axel BooK Book Bruhat Christian Contextual Dan Default Easy Etheridge Florian Fredric Graham HasLogger Jakob Karen Kent Knop Log Malone Matt Package Peter Philippe Rabbitson Riddle Role Router Schlichtin Schmidt SetLogger SimpleLogger TeeLogger Trout Tyler Voss Walde WarnLogger Wes WithLogger book ether fREW frioux fsfs grinnz haarg kentfredric lib mst ribasushi riddle voss walde wes Log-Contextual-0.009001/xt/author/pod-coverage.t000644 000766 000024 00000000145 14625531523 021575 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use Test::Pod::Coverage::TrustMe; all_pod_coverage_ok(); Log-Contextual-0.009001/t/router_api.t000644 000766 000024 00000002473 14625531523 017707 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use lib 't/lib'; use TestExporter qw(:log), -logger => 'logger value', -default_logger => 'default logger value', -package_logger => 'package logger value'; my @test_args = qw( some argument values ); log_info { "Ignored value" } @test_args; my $results = TestExporter->router->captured; my %export_info = ( exporter => 'TestExporter', target => 'main', arguments => { logger => 'logger value', default_logger => 'default logger value', package_logger => 'package logger value' }, ); my %message_info = ( exporter => 'TestExporter', caller_package => 'main', caller_level => 1, message_level => 'info', message_args => \@test_args, ); is_deeply($results->{before_import}, \%export_info, 'before_import() values are correct'); is_deeply($results->{after_import}, \%export_info, 'after_import() values are correct'); #can't really compare the sub ref value so make sure it exists and is the right type #and remove it for the later result check my $message_block = delete $results->{message}->{message_sub}; is(ref $message_block, 'CODE', 'handle_log_request() got a sub ref for the message generator'); is_deeply($results->{message}, \%message_info, 'handle_log_request() other values are correct'); done_testing; Log-Contextual-0.009001/t/default_logger.t000644 000766 000024 00000002651 14625531523 020517 0ustar00gknopstaff000000 000000 use strict; use warnings; use Log::Contextual qw{:log with_logger set_logger}; use Log::Contextual::SimpleLogger; use Test::More; my $var1; my $var2; my $var3; my $var_logger1 = Log::Contextual::SimpleLogger->new({ levels => [qw(trace debug info warn error fatal)], coderef => sub { $var1 = shift }, }); my $var_logger2; BEGIN { $var_logger2 = Log::Contextual::SimpleLogger->new({ levels => [qw(trace debug info warn error fatal)], coderef => sub { $var2 = shift }, }) } my $var_logger3; BEGIN { $var_logger3 = Log::Contextual::SimpleLogger->new({ levels => [qw(trace debug info warn error fatal)], coderef => sub { $var3 = shift }, }) } { package J; use Log::Contextual qw{:dlog :log with_logger set_logger}, -default_logger => $var_logger3; sub foo { log_debug { 'bar' }; } sub bar { Dlog_debug { "bar: $_" } 'frew'; } } { package K; use Log::Contextual qw{:log with_logger set_logger}, -default_logger => $var_logger2; sub foo { log_debug { 'foo' }; } } J::foo; K::foo; is($var2, "[debug] foo\n", 'default_logger works for one package'); is($var3, "[debug] bar\n", 'default_logger works for both packages'); J::bar; is($var3, qq([debug] bar: "frew"\n), 'default_logger works for one package'); $var2 = ''; set_logger($var_logger1); K::foo; is($var2, q(), '... but set_logger wins'); is($var1, "[debug] foo\n", '... and gets the value'); done_testing; Log-Contextual-0.009001/t/default_import.t000644 000766 000024 00000001315 14625531523 020546 0ustar00gknopstaff000000 000000 use strict; use warnings; use lib 't/lib'; use DefaultImportLogger; use Test::More; my @levels = qw(lol wut zomg); for (@levels) { main->can("log_$_")->(sub { 'fiSMBoC' }); is($DumbLogger2::var, "[$_] fiSMBoC\n", "$_ works"); my @vars = main->can("log_$_")->(sub { 'fiSMBoC: ' . $_[1] }, qw{foo bar baz}); is($DumbLogger2::var, "[$_] fiSMBoC: bar\n", "log_$_ works with input"); ok( eq_array(\@vars, [qw{foo bar baz}]), "log_$_ passes data through correctly" ); my $val = main->can("logS_$_")->(sub { 'fiSMBoC: ' . $_[0] }, 'foo'); is($DumbLogger2::var, "[$_] fiSMBoC: foo\n", "logS_$_ works with input"); is($val, 'foo', "logS_$_ passes data through correctly"); } done_testing; Log-Contextual-0.009001/t/caller.t000644 000766 000024 00000002070 14625531523 016771 0ustar00gknopstaff000000 000000 use strict; use warnings; use Log::Contextual::SimpleLogger; use Test::More; use Log::Contextual qw(:log set_logger); my $var; my @caller_info; my $var_log = Log::Contextual::SimpleLogger->new({ levels => [qw(trace debug info warn error fatal)], coderef => sub { chomp($_[0]); $var = "$_[0] at $caller_info[1] line $caller_info[2].\n" } }); my $warn_faker = sub { my ($package, $args) = @_; @caller_info = caller($args->{caller_level}); $var_log }; set_logger($warn_faker); log_debug { 'test log_debug' }; is($var, "[debug] test log_debug at " . __FILE__ . " line " . (__LINE__- 2) . ".\n", 'fake warn', ); logS_debug { 'test logS_debug' }; is( $var, "[debug] test logS_debug at " . __FILE__ . " line " . (__LINE__- 3) . ".\n", 'fake warn' ); logS_debug { 'test Dlog_debug' }; is( $var, "[debug] test Dlog_debug at " . __FILE__ . " line " . (__LINE__- 3) . ".\n", 'fake warn' ); logS_debug { 'test DlogS_debug' }; is( $var, "[debug] test DlogS_debug at " . __FILE__ . " line " . (__LINE__- 3) . ".\n", 'fake warn' ); done_testing; Log-Contextual-0.009001/t/arg.t000644 000766 000024 00000001562 14625531523 016305 0ustar00gknopstaff000000 000000 use strict; use warnings; use Log::Contextual::SimpleLogger; use Test::More; my $var_log; my $var; my @levels = qw(debug trace warn info error fatal); BEGIN { $var_log = Log::Contextual::SimpleLogger->new({ levels => [qw(trace debug info warn error fatal)], coderef => sub { $var = shift } }) } use Log::Contextual qw{ :log :dlog}, -logger => $var_log; my @args = qw(fizz buzz fizzbuzz); for my $level (@levels) { for my $prefix (qw(log logS Dlog DlogS)) { my $original = local $_ = "don't tread on me"; my $method_name = "${prefix}_${level}"; my $ref = __PACKAGE__->can($method_name) or die "no ref found for method $method_name"; $ref->(sub { "$method_name" }, @args); ok($_ eq $original, "\$_ was not disturbed by $method_name"); ok($var eq "[$level] $method_name\n", "log argument was correct"); } } done_testing; Log-Contextual-0.009001/t/yell-loudly.t000644 000766 000024 00000000656 14625531523 020012 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use Test::Fatal; use Log::Contextual qw(:log); like( exception { Log::Contextual::set_logger() }, qr/set_logger is no longer a direct sub in Log::Contextual/, 'Log::Contextual::set_logger dies', ); like( exception { Log::Contextual::with_logger() }, qr/with_logger is no longer a direct sub in Log::Contextual/, 'Log::Contextual::with_logger dies', ); done_testing; Log-Contextual-0.009001/t/has_logger.t000644 000766 000024 00000000513 14625531523 017641 0ustar00gknopstaff000000 000000 use strict; use warnings; use Log::Contextual::SimpleLogger; use Test::More; use Log::Contextual qw(:log set_logger has_logger); my $log = Log::Contextual::SimpleLogger->new; ok(!has_logger, 'has_logger returns false when logger unset'); set_logger $log; ok(has_logger, 'has_logger returns true when logger set'); done_testing; Log-Contextual-0.009001/t/00-compile.t000644 000766 000024 00000003454 14625531523 017403 0ustar00gknopstaff000000 000000 use 5.006; use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::Compile 2.058 use Test::More; plan tests => 11 + ($ENV{AUTHOR_TESTING} ? 1 : 0); my @module_files = ( 'Log/Contextual.pm', 'Log/Contextual/Easy/Default.pm', 'Log/Contextual/Easy/Package.pm', 'Log/Contextual/Role/Router.pm', 'Log/Contextual/Role/Router/HasLogger.pm', 'Log/Contextual/Role/Router/SetLogger.pm', 'Log/Contextual/Role/Router/WithLogger.pm', 'Log/Contextual/Router.pm', 'Log/Contextual/SimpleLogger.pm', 'Log/Contextual/TeeLogger.pm', 'Log/Contextual/WarnLogger.pm' ); # no fake home requested my @switches = ( -d 'blib' ? '-Mblib' : '-Ilib', ); use File::Spec; use IPC::Open3; use IO::Handle; open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; my @warnings; for my $lib (@module_files) { # see L my $stderr = IO::Handle->new; diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} } $^X, @switches, '-e', "require q[$lib]")) if $ENV{PERL_COMPILE_TEST_DEBUG}; my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]"); binmode $stderr, ':crlf' if $^O eq 'MSWin32'; my @_warnings = <$stderr>; waitpid($pid, 0); is($?, 0, "$lib loaded ok"); shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/ and not eval { +require blib; blib->VERSION('1.01') }; if (@_warnings) { warn @_warnings; push @warnings, @_warnings; } } is(scalar(@warnings), 0, 'no warnings found') or diag 'got warnings: ', ( Test::More->can('explain') ? Test::More::explain(\@warnings) : join("\n", '', @warnings) ) if $ENV{AUTHOR_TESTING}; Log-Contextual-0.009001/t/inherit.t000644 000766 000024 00000001164 14625531523 017174 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use Test::Fatal; use Log::Contextual qw(set_logger); use Log::Contextual::SimpleLogger; BEGIN { package MySuperClass; use Log::Contextual qw(:log); } BEGIN { package MyChildClass; BEGIN { our @ISA = qw(MySuperClass) }; use Log::Contextual qw(:log); sub do_thing { log_error { "child class log" }; } } my $last_log; set_logger(Log::Contextual::SimpleLogger->new({ levels => [qw(error)], coderef => sub { $last_log = shift }, })); is exception { MyChildClass->do_thing; }, undef, 'log imports work in child class with exports in parent'; done_testing; Log-Contextual-0.009001/t/log.t000644 000766 000024 00000005130 14625531523 016310 0ustar00gknopstaff000000 000000 use strict; use warnings; use Log::Contextual qw{:log with_logger set_logger}; use Log::Contextual::SimpleLogger; use Test::More; my @levels = qw(debug trace warn info error fatal); my $var1; my $var2; my $var3; my $var_logger1 = Log::Contextual::SimpleLogger->new({ levels => [qw(trace debug info warn error fatal)], coderef => sub { $var1 = shift }, }); my $var_logger2 = Log::Contextual::SimpleLogger->new({ levels => [qw(trace debug info warn error fatal)], coderef => sub { $var2 = shift }, }); my $var_logger3 = Log::Contextual::SimpleLogger->new({ levels => [qw(trace debug info warn error fatal)], coderef => sub { $var3 = shift }, }); SETLOGGER: { set_logger(sub { $var_logger3 }); log_debug { 'set_logger' }; is($var3, "[debug] set_logger\n", 'set logger works'); } SETLOGGERTWICE: { my $foo; local $SIG{__WARN__} = sub { $foo = shift }; set_logger(sub { $var_logger3 }); like( $foo, qr/set_logger \(or -logger\) called more than once! This is a bad idea! at/, 'set_logger twice warns correctly' ); } WITHLOGGER: { with_logger sub { $var_logger2 } => sub { with_logger $var_logger1 => sub { log_debug { 'nothing!' } }; log_debug { 'frew!' }; }; is($var1, "[debug] nothing!\n", 'inner scoped logger works'); is($var2, "[debug] frew!\n", 'outer scoped logger works'); } SETWITHLOGGER: { with_logger $var_logger1 => sub { log_debug { 'nothing again!' }; # do this just so the following set_logger won't warn local $SIG{__WARN__} = sub { }; set_logger(sub { $var_logger3 }); log_debug { 'this is a set inside a with' }; }; is( $var1, "[debug] nothing again!\n", 'inner scoped logger works after using set_logger' ); is($var3, "[debug] this is a set inside a with\n", 'set inside with works'); log_debug { 'frioux!' }; is( $var3, "[debug] frioux!\n", q{set_logger's logger comes back after scoped logger} ); } VANILLA: { for (@levels) { main->can("log_$_")->(sub { 'fiSMBoC' }); is($var3, "[$_] fiSMBoC\n", "$_ works"); my @vars = main->can("log_$_")->(sub { 'fiSMBoC: ' . $_[1] }, qw{foo bar baz}); is($var3, "[$_] fiSMBoC: bar\n", "log_$_ works with input"); ok( eq_array(\@vars, [qw{foo bar baz}]), "log_$_ passes data through correctly" ); my $val = main->can("logS_$_")->(sub { 'fiSMBoC: ' . $_[0] }, 'foo'); is($var3, "[$_] fiSMBoC: foo\n", "logS_$_ works with input"); is($val, 'foo', "logS_$_ passes data through correctly"); } } ok(!eval { Log::Contextual->import; 1 }, 'Blank Log::Contextual import dies'); done_testing; Log-Contextual-0.009001/t/warnlogger-with-levels.t000644 000766 000024 00000006003 14625531523 022137 0ustar00gknopstaff000000 000000 use strict; use warnings; use Log::Contextual::WarnLogger; # -levels => [qw(custom1 custom2)]; use Log::Contextual qw{:log set_logger} => -logger => Log::Contextual::WarnLogger->new({env_prefix => 'FOO'}); use Test::More; use Test::Fatal; { my $l; like( exception { $l = Log::Contextual::WarnLogger->new({levels => ''}) }, qr/invalid levels specification: must be non-empty arrayref/, 'cannot pass empty string for levels', ); like( exception { $l = Log::Contextual::WarnLogger->new({levels => []}) }, qr/invalid levels specification: must be non-empty arrayref/, 'cannot pass empty list for levels', ); is( exception { $l = Log::Contextual::WarnLogger->new({ levels => undef, env_prefix => 'FOO' }); }, undef, 'ok to leave levels undefined', ); } { my $l = Log::Contextual::WarnLogger->new({ env_prefix => 'BAR', levels => [qw(custom1 custom2)], }); foreach my $sub (qw(is_custom1 is_custom2 custom1 custom2)) { is(exception { $l->$sub }, undef, $sub . ' is handled by AUTOLOAD',); } foreach my $sub (qw(is_foo foo)) { is( exception { $l->$sub }, undef, 'arbitrary sub ' . $sub . ' is handled by AUTOLOAD', ); } } { # levels is optional - most things should still work otherwise. my $l = Log::Contextual::WarnLogger->new({env_prefix => 'BAR',}); # if we don't know the level, and there are no environment variables set, # just log everything. { ok($l->is_custom1, 'is_custom1 defaults to true on WarnLogger'); ok($l->is_custom2, 'is_custom2 defaults to true on WarnLogger'); } # otherwise, go with what the variable says. { local $ENV{BAR_CUSTOM1} = 0; local $ENV{BAR_CUSTOM2} = 1; ok(!$l->is_custom1, 'is_custom1 is false on WarnLogger'); ok($l->is_custom2, 'is_custom2 is true on WarnLogger'); ok($l->is_foo, 'is_foo defaults to true on WarnLogger'); local $ENV{BAR_UPTO} = 'foo'; like( exception { $l->is_bar }, qr/Unrecognized log level 'foo' in \$ENV\{BAR_UPTO\}/, 'Cannot use an unrecognized log level in UPTO', ); } } # these tests taken from t/warnlogger.t my $l = Log::Contextual::WarnLogger->new({ env_prefix => 'BAR', levels => [qw(custom1 custom2)], }); { local $ENV{BAR_CUSTOM1} = 0; local $ENV{BAR_CUSTOM2} = 1; ok(!$l->is_custom1, 'is_custom1 is false on WarnLogger'); ok($l->is_custom2, 'is_custom2 is true on WarnLogger'); ok(!$l->is_foo, 'is_foo is false (custom levels supplied) on WarnLogger'); } { local $ENV{BAR_UPTO} = 'custom1'; ok($l->is_custom1, 'is_custom1 is true on WarnLogger'); ok($l->is_custom2, 'is_custom2 is true on WarnLogger'); } { local $ENV{BAR_UPTO} = 'custom2'; ok(!$l->is_custom1, 'is_custom1 is false on WarnLogger'); ok($l->is_custom2, 'is_custom2 is true on WarnLogger'); } { local $ENV{BAR_UPTO} = 'foo'; like( exception { $l->is_custom1 }, qr/Unrecognized log level 'foo'/, 'Cannot use an unrecognized log level in UPTO', ); } done_testing; Log-Contextual-0.009001/t/eg.t000644 000766 000024 00000003616 14625531523 016131 0ustar00gknopstaff000000 000000 use strict; use warnings; use Log::Contextual::SimpleLogger; use Test::More; use Log::Contextual qw(:log set_logger); my ($var1, $var2, $var3); my $complex_dispatcher = do { my $l1 = Log::Contextual::SimpleLogger->new({ levels => [qw(trace debug info warn error fatal)], coderef => sub { $var1 = shift }, }); my $l2 = Log::Contextual::SimpleLogger->new({ levels => [qw(trace debug info warn error fatal)], coderef => sub { $var2 = shift }, }); my $l3 = Log::Contextual::SimpleLogger->new({ levels => [qw(trace debug info warn error fatal)], coderef => sub { $var3 = shift }, }); my %registry = ( -logger => $l3, A1 => { -logger => $l1, lol => $l2, }, A2 => {-logger => $l2}, ); sub { my ($package, $info) = @_; my $logger = $registry{'-logger'}; if (my $r = $registry{$package}) { $logger = $r->{'-logger'} if $r->{'-logger'}; my (undef, undef, undef, $sub) = caller($info->{caller_level} + 1); $sub =~ s/^\Q$package\E:://g; $logger = $r->{$sub} if $r->{$sub}; } return $logger; }; }; set_logger $complex_dispatcher; log_debug { '1.var3' }; is($var3, "[debug] 1.var3\n", "default logger works"); $var3 = ''; A1::lol(); A1::rofl(); is($var2, "[debug] 1.var2\n", "default package logger works"); is($var1, "[debug] 1.var1\n", "package::sub logger works"); $var1 = ''; $var2 = ''; A2::foo(); is($var2, "[debug] 2.var2\n", "only default package logger works"); $var2 = ''; A3::squint(); is($var3, "[debug] 2.var3\n", "global default logger works"); BEGIN { package A1; use Log::Contextual ':log'; sub lol { log_debug { '1.var2' } } sub rofl { log_debug { '1.var1' } } package A2; use Log::Contextual ':log'; sub foo { log_debug { '2.var2' } } package A3; use Log::Contextual ':log'; sub squint { log_debug { '2.var3' } } } done_testing; Log-Contextual-0.009001/t/easy.t000644 000766 000024 00000003137 14625531523 016475 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use lib 't/lib'; use My::Module; # makes use of Log::Contextual::Easy::Default; use My::Module2; # makes use of Log::Contextual::Easy::Package; # capture logging messages of My::Module, mapping "[...] xxx" to "...$sep" sub logshort($$) { my ($cap, $sep) = @_; sub { local $_ = shift; s/^\[(.+)\] (xxx|"xxx")\n$/$1$sep/; $$cap .= $_; } } # capture warnings my ($cap_warn, $cap_with, $cap_set); local $SIG{__WARN__} = logshort \$cap_warn, '!'; { My::Module::log(); My::Module2::log(); is($cap_warn, undef, 'no logging by default'); } { local $ENV{MY_MODULE_UPTO} = 'info'; local $ENV{MY_MODULE2_UPTO} = 'info'; My::Module::log(); My::Module2::log(); is( $cap_warn, "info!warn!error!fatal!info!warn!error!fatal!", 'WarnLogger enabled via ENV' ); $cap_warn = ''; } { use Log::Contextual::SimpleLogger; use Log::Contextual qw(with_logger set_logger); set_logger( Log::Contextual::SimpleLogger->new({ levels => [qw(info warn error)], coderef => logshort(\$cap_set, '/'), }) ); my $with_logger = Log::Contextual::SimpleLogger->new({ levels => [qw(trace info fatal)], coderef => logshort(\$cap_with, '|'), }); with_logger $with_logger => sub { My::Module::log(); My::Module2::log(); # will not be overridden }; is($cap_with, 'trace|info|fatal|', 'with_logger'); My::Module::log(); My::Module2::log(); # will not be overridden is($cap_set, 'info/warn/error/', 'set_logger'); is($cap_warn, '', 'no warnings if with_logger or set_logger'); } done_testing; Log-Contextual-0.009001/t/log-with-levels.t000644 000766 000024 00000003343 14625531523 020555 0ustar00gknopstaff000000 000000 use strict; use warnings; use Log::Contextual qw{:dlog :log with_logger set_logger}, -levels => ['custom']; use Log::Contextual::SimpleLogger; use Test::More; my $logger = DumbLogger->new; set_logger(sub { $logger }); log_custom { 'fiSMBoC' }; is($DumbLogger::var, "fiSMBoC", "custom works"); my @vars = log_custom { 'fiSMBoC: ' . $_[1] } qw{foo bar baz}; is($DumbLogger::var, "fiSMBoC: bar", "log_custom works with input"); ok( eq_array(\@vars, [qw{foo bar baz}]), "log_custom passes data through correctly" ); my $val = logS_custom { 'fiSMBoC: ' . $_[0] } 'foo'; is($DumbLogger::var, "fiSMBoC: foo", "logS_custom works with input"); is($val, 'foo', "logS_custom passes data through correctly"); my @foo = Dlog_custom { "Look ma, data: $_" } qw{frew bar baz}; ok( eq_array(\@foo, [qw{frew bar baz}]), "Dlog_custom passes data through correctly" ); is( $DumbLogger::var, qq(Look ma, data: "frew"\n"bar"\n"baz"\n), "Output for Dlog_custom is correct" ); my $bar = DlogS_custom { "Look ma, data: $_" }[qw{frew bar baz}]; ok(eq_array($bar, [qw{frew bar baz}]), 'DlogS_custom passes data through correctly'); like( $DumbLogger::var, qr(Look ma, data: \[), "Output for DlogS_custom is correct" ); @foo = Dlog_custom { "nothing: $_" } (); ok(eq_array(\@foo, []), "Dlog_custom passes nothing through correctly"); is($DumbLogger::var, "nothing: ()", "Output for Dlog_custom is correct"); ok(!main->can($_), "$_ not imported") for map +("log_$_", "logS_$_"), qw(debug trace warn info error fatal); ok(!eval { Log::Contextual->import; 1 }, 'Blank Log::Contextual import dies'); BEGIN { package DumbLogger; our $var; sub new { bless {}, 'DumbLogger' } sub is_custom { 1 } sub custom { $var = $_[1] } 1; } done_testing; Log-Contextual-0.009001/t/00-report-prereqs.t000644 000766 000024 00000013601 14625531523 020740 0ustar00gknopstaff000000 000000 #!perl use strict; use warnings; # This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.029 use Test::More tests => 1; use ExtUtils::MakeMaker; use File::Spec; # from $version::LAX my $lax_version_re = qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )? | (?:\.[0-9]+) (?:_[0-9]+)? ) | (?: v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )? | (?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)? ) )/x; # hide optional CPAN::Meta modules from prereq scanner # and check if they are available my $cpan_meta = "CPAN::Meta"; my $cpan_meta_pre = "CPAN::Meta::Prereqs"; my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic # Verify requirements? my $DO_VERIFY_PREREQS = 1; sub _max { my $max = shift; $max = ( $_ > $max ) ? $_ : $max for @_; return $max; } sub _merge_prereqs { my ($collector, $prereqs) = @_; # CPAN::Meta::Prereqs object if (ref $collector eq $cpan_meta_pre) { return $collector->with_merged_prereqs( CPAN::Meta::Prereqs->new( $prereqs ) ); } # Raw hashrefs for my $phase ( keys %$prereqs ) { for my $type ( keys %{ $prereqs->{$phase} } ) { for my $module ( keys %{ $prereqs->{$phase}{$type} } ) { $collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module}; } } } return $collector; } my @include = qw( ); my @exclude = qw( ); # Add static prereqs to the included modules list my $static_prereqs = do './t/00-report-prereqs.dd'; # Merge all prereqs (either with ::Prereqs or a hashref) my $full_prereqs = _merge_prereqs( ( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ), $static_prereqs ); # Add dynamic prereqs to the included modules list (if we can) my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; my $cpan_meta_error; if ( $source && $HAS_CPAN_META && (my $meta = eval { CPAN::Meta->load_file($source) } ) ) { $full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs); } else { $cpan_meta_error = $@; # capture error from CPAN::Meta->load_file($source) $source = 'static metadata'; } my @full_reports; my @dep_errors; my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs; # Add static includes into a fake section for my $mod (@include) { $req_hash->{other}{modules}{$mod} = 0; } for my $phase ( qw(configure build test runtime develop other) ) { next unless $req_hash->{$phase}; next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING}); for my $type ( qw(requires recommends suggests conflicts modules) ) { next unless $req_hash->{$phase}{$type}; my $title = ucfirst($phase).' '.ucfirst($type); my @reports = [qw/Module Want Have/]; for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) { next if grep { $_ eq $mod } @exclude; my $want = $req_hash->{$phase}{$type}{$mod}; $want = "undef" unless defined $want; $want = "any" if !$want && $want == 0; if ($mod eq 'perl') { push @reports, ['perl', $want, $]]; next; } my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required"; my $file = $mod; $file =~ s{::}{/}g; $file .= ".pm"; my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC; if ($prefix) { my $have = MM->parse_version( File::Spec->catfile($prefix, $file) ); $have = "undef" unless defined $have; push @reports, [$mod, $want, $have]; if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) { if ( $have !~ /\A$lax_version_re\z/ ) { push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)"; } elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) { push @dep_errors, "$mod version '$have' is not in required range '$want'"; } } } else { push @reports, [$mod, $want, "missing"]; if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) { push @dep_errors, "$mod is not installed ($req_string)"; } } } if ( @reports ) { push @full_reports, "=== $title ===\n\n"; my $ml = _max( map { length $_->[0] } @reports ); my $wl = _max( map { length $_->[1] } @reports ); my $hl = _max( map { length $_->[2] } @reports ); if ($type eq 'modules') { splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports; } else { splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports; } push @full_reports, "\n"; } } } if ( @full_reports ) { diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports; } if ( $cpan_meta_error || @dep_errors ) { diag "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n"; } if ( $cpan_meta_error ) { my ($orig_source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; diag "\nCPAN::Meta->load_file('$orig_source') failed with: $cpan_meta_error\n"; } if ( @dep_errors ) { diag join("\n", "\nThe following REQUIRED prerequisites were not satisfied:\n", @dep_errors, "\n" ); } pass('Reported prereqs'); # vim: ts=4 sts=4 sw=4 et: Log-Contextual-0.009001/t/log4perl.t000644 000766 000024 00000002054 14625531523 017261 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use Test::Needs { 'Log::Log4perl' => 1.29, }; use File::Temp qw(); Log::Log4perl->init(\<<'END_CONFIG'); log4perl.rootLogger = ERROR, LOGFILE log4perl.appender.LOGFILE = Log::Log4perl::Appender::String log4perl.appender.LOGFILE.layout = PatternLayout log4perl.appender.LOGFILE.layout.ConversionPattern = file:%F line:%L method:%M - %m%n END_CONFIG use Log::Contextual qw( :log set_logger ); set_logger(Log::Log4perl->get_logger); my $appender = Log::Log4perl->appender_by_name('LOGFILE'); my @elines; my @datas; push @elines, __LINE__; log_error { 'err FIRST' }; push @datas, $appender->string; $appender->string(''); sub foo { push @elines, __LINE__; log_error { 'err SECOND' }; } foo(); push @datas, $appender->string; $appender->string(''); is $datas[0], "file:".__FILE__." line:$elines[0] method:main:: - err FIRST\n", 'file and line work with Log4perl'; is $datas[1], "file:".__FILE__." line:$elines[1] method:main::foo - err SECOND\n", 'file and line work with Log4perl in a sub'; done_testing; Log-Contextual-0.009001/t/lib/000755 000766 000024 00000000000 14625531523 016111 5ustar00gknopstaff000000 000000 Log-Contextual-0.009001/t/dlog.t000644 000766 000024 00000003440 14625531523 016456 0ustar00gknopstaff000000 000000 use strict; use warnings; use Log::Contextual::SimpleLogger; use Test::More; my $var_log; my $var; my @levels = qw(debug trace warn info error fatal); BEGIN { $var_log = Log::Contextual::SimpleLogger->new({ levels => [qw(trace debug info warn error fatal)], coderef => sub { $var = shift } }) } use Log::Contextual qw{:dlog}, -logger => $var_log; for my $level (@levels) { my @foo = main->can("Dlog_$level")->(sub { "Look ma, data: $_" }, qw{frew bar baz}); ok( eq_array(\@foo, [qw{frew bar baz}]), "Dlog_$level passes data through correctly" ); is( $var, qq([$level] Look ma, data: "frew"\n"bar"\n"baz"\n), "Output for Dlog_$level is correct" ); my @sfoo = main->can("Dslog_$level")->("Look ma, data: ", qw{frew bar baz}); ok( eq_array(\@sfoo, [qw{frew bar baz}]), "Dslog_$level passes data through correctly" ); is( $var, qq([$level] Look ma, data: "frew"\n"bar"\n"baz"\n), "Output for Dslog_$level is correct" ); my $bar = main->can("DlogS_$level") ->(sub { "Look ma, data: $_" }, [qw{frew bar baz}]); ok( eq_array($bar, [qw{frew bar baz}]), 'DlogS_trace passes data through correctly' ); like( $var, qr(\[$level\] Look ma, data: \[), "Output for DlogS_$level is correct" ); @foo = main->can("Dlog_$level")->(sub { "nothing: $_" }, ()); ok(eq_array(\@foo, []), "Dlog_$level passes nothing through correctly"); is($var, "[$level] nothing: ()\n", "Output for Dlog_$level is correct"); my $sbar = main->can("DslogS_$level")->("Look ma, data: ", [qw{frew bar baz}]); ok( eq_array($sbar, [qw{frew bar baz}]), 'DslogS_trace passes data through correctly' ); like( $var, qr(\[$level\] Look ma, data: \[), "Output for DslogS_$level is correct" ); } done_testing; Log-Contextual-0.009001/t/00-report-prereqs.dd000644 000766 000024 00000004554 14625531523 021073 0ustar00gknopstaff000000 000000 do { my $x = { 'configure' => { 'requires' => { 'ExtUtils::MakeMaker' => '0' } }, 'develop' => { 'requires' => { 'Test::CPAN::Changes' => '0.19', 'Test::CPAN::Meta' => '0', 'Test::CPAN::Meta::JSON' => '0.16', 'Test::EOL' => '0', 'Test::MinimumVersion' => '0', 'Test::Mojibake' => '0', 'Test::More' => '0.88', 'Test::NoTabs' => '0', 'Test::Perl::Critic' => '0', 'Test::Pod' => '1.41', 'Test::Pod::Coverage::TrustMe' => '0', 'Test::Portability::Files' => '0', 'Test::Spelling' => '0.12', 'Test::Vars' => '0', 'Test::Version' => '1' } }, 'runtime' => { 'requires' => { 'Carp' => '0', 'Data::Dumper::Concise' => '0', 'Moo' => '1.003000', 'Scalar::Util' => '0', 'perl' => '5.008001' } }, 'test' => { 'recommends' => { 'CPAN::Meta' => '2.120900' }, 'requires' => { 'ExtUtils::MakeMaker' => '0', 'File::Spec' => '0', 'IO::Handle' => '0', 'IPC::Open3' => '0', 'Test::Fatal' => '0', 'Test::More' => '0.88', 'Test::Needs' => '0' } } }; $x; }Log-Contextual-0.009001/t/rt83267-begin.t000644 000766 000024 00000000662 14625531523 017655 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; BEGIN { eval { package NotMain; use Log::Contextual::SimpleLogger; use Log::Contextual qw(:log), -default_logger => Log::Contextual::SimpleLogger->new({levels => [qw( )]}); eval { log_info { "Yep" } }; ::is($@, '', 'Invoked log function in package other than main'); }; is($@, '', 'non-main package subtest did not die'); } done_testing; Log-Contextual-0.009001/t/warnlogger.t000644 000766 000024 00000006155 14625531523 017706 0ustar00gknopstaff000000 000000 use strict; use warnings; use Log::Contextual::WarnLogger; use Log::Contextual qw{:log set_logger} => -logger => Log::Contextual::WarnLogger->new({env_prefix => 'FOO'}); use Test::More; my $l = Log::Contextual::WarnLogger->new({env_prefix => 'BAR'}); { local $ENV{BAR_TRACE} = 0; local $ENV{BAR_DEBUG} = 1; local $ENV{BAR_INFO} = 0; local $ENV{BAR_WARN} = 0; local $ENV{BAR_ERROR} = 0; local $ENV{BAR_FATAL} = 0; ok(!$l->is_trace, 'is_trace is false on WarnLogger'); ok($l->is_debug, 'is_debug is true on WarnLogger'); ok(!$l->is_info, 'is_info is false on WarnLogger'); ok(!$l->is_warn, 'is_warn is false on WarnLogger'); ok(!$l->is_error, 'is_error is false on WarnLogger'); ok(!$l->is_fatal, 'is_fatal is false on WarnLogger'); } { local $ENV{BAR_UPTO} = 'TRACE'; ok($l->is_trace, 'is_trace is true on WarnLogger'); ok($l->is_debug, 'is_debug is true on WarnLogger'); ok($l->is_info, 'is_info is true on WarnLogger'); ok($l->is_warn, 'is_warn is true on WarnLogger'); ok($l->is_error, 'is_error is true on WarnLogger'); ok($l->is_fatal, 'is_fatal is true on WarnLogger'); } { local $ENV{BAR_UPTO} = 'warn'; ok(!$l->is_trace, 'is_trace is false on WarnLogger'); ok(!$l->is_debug, 'is_debug is false on WarnLogger'); ok(!$l->is_info, 'is_info is false on WarnLogger'); ok($l->is_warn, 'is_warn is true on WarnLogger'); ok($l->is_error, 'is_error is true on WarnLogger'); ok($l->is_fatal, 'is_fatal is true on WarnLogger'); } { local $ENV{FOO_TRACE} = 0; local $ENV{FOO_DEBUG} = 1; local $ENV{FOO_INFO} = 0; local $ENV{FOO_WARN} = 0; local $ENV{FOO_ERROR} = 0; local $ENV{FOO_FATAL} = 0; ok( eval { log_trace { die 'this should live' }; 1 }, 'trace does not get called' ); ok( !eval { log_debug { die 'this should die' }; 1 }, 'debug gets called' ); ok( eval { log_info { die 'this should live' }; 1 }, 'info does not get called' ); ok( eval { log_warn { die 'this should live' }; 1 }, 'warn does not get called' ); ok( eval { log_error { die 'this should live' }; 1 }, 'error does not get called' ); ok( eval { log_fatal { die 'this should live' }; 1 }, 'fatal does not get called' ); } { local $ENV{FOO_TRACE} = 1; local $ENV{FOO_DEBUG} = 1; local $ENV{FOO_INFO} = 1; local $ENV{FOO_WARN} = 1; local $ENV{FOO_ERROR} = 1; local $ENV{FOO_FATAL} = 1; my $cap; local $SIG{__WARN__} = sub { $cap = shift }; log_debug { 'frew' }; is($cap, "[debug] frew\n", 'WarnLogger outputs to STDERR correctly'); log_trace { 'trace' }; is($cap, "[trace] trace\n", 'trace renders correctly'); log_debug { 'debug' }; is($cap, "[debug] debug\n", 'debug renders correctly'); log_info { 'info' }; is($cap, "[info] info\n", 'info renders correctly'); log_warn { 'warn' }; is($cap, "[warn] warn\n", 'warn renders correctly'); log_error { 'error' }; is($cap, "[error] error\n", 'error renders correctly'); log_fatal { 'fatal' }; is($cap, "[fatal] fatal\n", 'fatal renders correctly'); } done_testing; Log-Contextual-0.009001/t/simplelogger.t000644 000766 000024 00000005322 14625531523 020223 0ustar00gknopstaff000000 000000 use strict; use warnings; use File::Temp; use Log::Contextual::SimpleLogger; use Log::Contextual qw{:log set_logger} => -logger => Log::Contextual::SimpleLogger->new({levels => [qw{debug}]}); use Test::More; my $l = Log::Contextual::SimpleLogger->new({levels => [qw{debug}]}); ok(!$l->is_trace, 'is_trace is false on SimpleLogger'); ok($l->is_debug, 'is_debug is true on SimpleLogger'); ok(!$l->is_info, 'is_info is false on SimpleLogger'); ok(!$l->is_warn, 'is_warn is false on SimpleLogger'); ok(!$l->is_error, 'is_error is false on SimpleLogger'); ok(!$l->is_fatal, 'is_fatal is false on SimpleLogger'); ok( eval { log_trace { die 'this should live' }; 1 }, 'trace does not get called' ); ok( !eval { log_debug { die 'this should die' }; 1 }, 'debug gets called' ); ok( eval { log_info { die 'this should live' }; 1 }, 'info does not get called' ); ok( eval { log_warn { die 'this should live' }; 1 }, 'warn does not get called' ); ok( eval { log_error { die 'this should live' }; 1 }, 'error does not get called' ); ok( eval { log_fatal { die 'this should live' }; 1 }, 'fatal does not get called' ); { my $tempfile = File::Temp->new(UNLINK => 1, TEMPLATE => 'stderrXXXXXX'); my $fn = fileno($tempfile); open(STDERR, ">&$fn") or die $!; log_debug { 'frew' }; my $out = do { local @ARGV = $tempfile; <> }; is($out, "[debug] frew\n", 'SimpleLogger outputs to STDERR correctly'); } my $response; my $l2 = Log::Contextual::SimpleLogger->new({ levels => [qw{trace debug info warn error fatal}], coderef => sub { $response = $_[0] }, }); { local $SIG{__WARN__} = sub { }; # do this just to hide warning for tests set_logger($l2); } log_trace { 'trace' }; is($response, "[trace] trace\n", 'trace renders correctly'); log_debug { 'debug' }; is($response, "[debug] debug\n", 'debug renders correctly'); log_info { 'info' }; is($response, "[info] info\n", 'info renders correctly'); log_warn { 'warn' }; is($response, "[warn] warn\n", 'warn renders correctly'); log_error { 'error' }; is($response, "[error] error\n", 'error renders correctly'); log_fatal { 'fatal' }; is($response, "[fatal] fatal\n", 'fatal renders correctly'); log_debug {'line 1', 'line 2'}; is($response, "[debug] line 1\nline 2\n", 'multiline log renders correctly'); my $u = Log::Contextual::SimpleLogger->new({levels_upto => 'debug'}); ok(!$u->is_trace, 'is_trace is false on SimpleLogger'); ok($u->is_debug, 'is_debug is true on SimpleLogger'); ok($u->is_info, 'is_info is true on SimpleLogger'); ok($u->is_warn, 'is_warn is true on SimpleLogger'); ok($u->is_error, 'is_error is true on SimpleLogger'); ok($u->is_fatal, 'is_fatal is true on SimpleLogger'); done_testing; Log-Contextual-0.009001/t/base.t000644 000766 000024 00000002734 14625531523 016450 0ustar00gknopstaff000000 000000 use strict; use warnings; use lib 't/lib'; use BaseLogger qw{:log with_logger set_logger}; use Test::More; my @levels = qw(lol wut zomg); VANILLA: { for (@levels) { main->can("log_$_")->(sub { 'fiSMBoC' }); is($DumbLogger2::var, "[$_] fiSMBoC\n", "$_ works"); main->can("slog_$_")->('fiSMBoC'); is($DumbLogger2::var, "[$_] fiSMBoC\n", "string $_ works"); main->can("slog_$_")->('0'); is($DumbLogger2::var, "[$_] 0\n", "false string $_ works"); my @vars = main->can("log_$_")->(sub { 'fiSMBoC: ' . $_[1] }, qw{foo bar baz}); is($DumbLogger2::var, "[$_] fiSMBoC: bar\n", "log_$_ works with input"); ok( eq_array(\@vars, [qw{foo bar baz}]), "log_$_ passes data through correctly" ); my @svars = main->can("slog_$_")->('fiSMBoC', qw{foo bar baz}); is($DumbLogger2::var, "[$_] fiSMBoC\n", "slog_$_ ignores input"); ok( eq_array(\@svars, [qw{foo bar baz}]), "slog_$_ passes data through correctly" ); my $val = main->can("logS_$_")->(sub { 'fiSMBoC: ' . $_[0] }, 'foo'); is($DumbLogger2::var, "[$_] fiSMBoC: foo\n", "logS_$_ works with input"); is($val, 'foo', "logS_$_ passes data through correctly"); my $sval = main->can("slogS_$_")->('fiSMBoC', 'foo'); is($DumbLogger2::var, "[$_] fiSMBoC\n", "slogS_$_ ignores input"); is($val, 'foo', "slogS_$_ passes data through correctly"); } } ok(!eval { Log::Contextual->import; 1 }, 'Blank Log::Contextual import dies'); done_testing; Log-Contextual-0.009001/t/package_logger.t000644 000766 000024 00000002724 14625531523 020467 0ustar00gknopstaff000000 000000 use strict; use warnings; use Log::Contextual qw{:log with_logger set_logger}; use Log::Contextual::SimpleLogger; use Test::More; my $var1; my $var2; my $var3; my $var_logger1 = Log::Contextual::SimpleLogger->new({ levels => [qw(trace debug info warn error fatal)], coderef => sub { $var1 = shift }, }); my $var_logger2; BEGIN { $var_logger2 = Log::Contextual::SimpleLogger->new({ levels => [qw(trace debug info warn error fatal)], coderef => sub { $var2 = shift }, }) } my $var_logger3; BEGIN { $var_logger3 = Log::Contextual::SimpleLogger->new({ levels => [qw(trace debug info warn error fatal)], coderef => sub { $var3 = shift }, }) } { package J; use Log::Contextual qw{:dlog :log with_logger set_logger}, -package_logger => $var_logger3; sub foo { log_debug { 'bar' }; } sub bar { Dlog_debug { "bar: $_" } 'frew'; } } { package K; use Log::Contextual qw{:log with_logger set_logger}, -package_logger => $var_logger2; sub foo { log_debug { 'foo' }; } } J::foo; K::foo; is($var2, "[debug] foo\n", 'package_logger works for one package'); is($var3, "[debug] bar\n", 'package_logger works for both packages'); J::bar; is($var3, qq([debug] bar: "frew"\n), 'package_logger works for one package'); $var2 = ''; $var1 = ''; set_logger($var_logger1); K::foo; is($var1, q(), '... and set_logger does not win'); is($var2, "[debug] foo\n", '... and package_logger still gets the value'); done_testing; Log-Contextual-0.009001/t/rt83267.t000644 000766 000024 00000000655 14625531523 016575 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; #bug report does not include a case where Log::Contextual is #brought in via 'use' #try to import a single log function but do not include any tags BEGIN { require Log::Contextual; Log::Contextual->import('log_info'); } eval { log_info { "test" }; }; like( $@, qr/^ no logger set! you can't try to log something without a logger!/, 'Got correct error' ); done_testing; Log-Contextual-0.009001/t/lib/TestRouter.pm000644 000766 000024 00000000745 14625531523 020575 0ustar00gknopstaff000000 000000 package TestRouter; use Moo; use Log::Contextual::SimpleLogger; with 'Log::Contextual::Role::Router'; has captured => (is => 'ro', default => sub { {} }); sub before_import { my ($self, %export_info) = @_; $self->captured->{before_import} = \%export_info; } sub after_import { my ($self, %export_info) = @_; $self->captured->{after_import} = \%export_info; } sub handle_log_request { my ($self, %message_info) = @_; $self->captured->{message} = \%message_info; } 1; Log-Contextual-0.009001/t/lib/DefaultImportLogger.pm000644 000766 000024 00000001022 14625531523 022361 0ustar00gknopstaff000000 000000 package DefaultImportLogger; use Log::Contextual (); BEGIN { our @ISA = qw(Log::Contextual); } use Log::Contextual::SimpleLogger; my $logger = DumbLogger2->new; sub default_import { ':log' } sub arg_levels { $_[1] || [qw(lol wut zomg)] } sub arg_logger { $_[1] || $logger } package DumbLogger2; our $var; sub new { bless {}, 'DumbLogger2' } sub is_wut { 1 } sub wut { $var = "[wut] $_[1]\n" } sub is_lol { 1 } sub lol { $var = "[lol] $_[1]\n" } sub is_zomg { 1 } sub zomg { $var = "[zomg] $_[1]\n" } 1; Log-Contextual-0.009001/t/lib/TestExporter.pm000644 000766 000024 00000000202 14625531523 021111 0ustar00gknopstaff000000 000000 package TestExporter; use Moo; use TestRouter; extends 'Log::Contextual'; sub router { our $Router ||= TestRouter->new } 1; Log-Contextual-0.009001/t/lib/My/000755 000766 000024 00000000000 14625531523 016476 5ustar00gknopstaff000000 000000 Log-Contextual-0.009001/t/lib/BaseLogger.pm000644 000766 000024 00000001136 14625531523 020462 0ustar00gknopstaff000000 000000 package BaseLogger; use Log::Contextual (); BEGIN { our @ISA = qw(Log::Contextual); } use Log::Contextual::SimpleLogger; my $logger = DumbLogger2->new; sub arg_levels { $_[1] || [qw(lol wut zomg)] } sub arg_logger { $_[1] || $logger } sub router { our $Router_Instance ||= do { require Log::Contextual::Router; Log::Contextual::Router->new }; } package DumbLogger2; our $var; sub new { bless {}, 'DumbLogger2' } sub is_wut { 1 } sub wut { $var = "[wut] $_[1]\n" } sub is_lol { 1 } sub lol { $var = "[lol] $_[1]\n" } sub is_zomg { 1 } sub zomg { $var = "[zomg] $_[1]\n" } 1; Log-Contextual-0.009001/t/lib/My/Module2.pm000644 000766 000024 00000000316 14625531523 020343 0ustar00gknopstaff000000 000000 package My::Module2; use Log::Contextual::Easy::Package; sub log { Dlog_fatal { $_ } DlogS_error { $_ } logS_warn { $_[0] } logS_info { $_[0] } log_debug { $_[0] } log_trace { $_[0] } 'xxx'; } 1; Log-Contextual-0.009001/t/lib/My/Module.pm000644 000766 000024 00000000315 14625531523 020260 0ustar00gknopstaff000000 000000 package My::Module; use Log::Contextual::Easy::Default; sub log { Dlog_fatal { $_ } DlogS_error { $_ } logS_warn { $_[0] } logS_info { $_[0] } log_debug { $_[0] } log_trace { $_[0] } 'xxx'; } 1;